fcl-passrc: started anonymous methods

git-svn-id: trunk@40475 -

packages/fcl-passrc/src/pasresolver.pp

@@ -1824,6 +1824,7 @@ type
     function GetPasPropertyStoredExpr(El: TPasProperty): TPasExpr;
     function GetPasPropertyDefaultExpr(El: TPasProperty): TPasExpr;
     function GetPasClassAncestor(ClassEl: TPasClassType; SkipAlias: boolean): TPasType;
+    function GetParentProcBody(El: TPasElement): TProcedureBody;
     function ProcHasImplElements(Proc: TPasProcedure): boolean; virtual;
     function IndexOfImplementedInterface(ClassEl: TPasClassType; aType: TPasType): integer;
     function GetLoop(El: TPasElement): TPasImplElement;
@@ -2072,8 +2073,8 @@ begin
       dec(Indent,2);
       end;
     Result:=Result+')';
-    if El is TPasFunction then
-      Result:=Result+':'+GetTreeDbg(TPasFunctionType(TPasFunction(El).ProcType).ResultEl,Indent);
+    if (El is TPasProcedure) and (TPasProcedure(El).ProcType is TPasFunctionType) then
+      Result:=Result+':'+GetTreeDbg(TPasFunctionType(TPasProcedure(El).ProcType).ResultEl,Indent);
     if TPasProcedureType(El).IsOfObject then
       Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
     if TPasProcedureType(El).IsNested then
@@ -2273,6 +2274,10 @@ begin
     Result:='class procedure'
   else if C=TPasClassFunction then
     Result:='class function'
+  else if C=TPasAnonymousProcedure then
+    Result:='anonymous procedure'
+  else if C=TPasAnonymousFunction then
+    Result:='anonymous function'
   else if C=TPasMethodResolution then
     Result:='method resolution'
   else if C=TInterfaceSection then
@@ -5310,13 +5315,17 @@ var
   pm: TProcedureModifier;
   ptm: TProcTypeModifier;
   ObjKind: TPasObjKind;
+  ParentBody: TProcedureBody;
 begin
-  if (El.Parent is TPasProcedure) and (TPasProcedure(El.Parent).ProcType=El) then
+  if El.Parent is TPasProcedure then
+    Proc:=TPasProcedure(El.Parent)
+  else
+    Proc:=nil;
+  if (Proc<>nil) and (Proc.ProcType=El) then
     begin
     // finished header of a procedure declaration
     // -> search the best fitting proc
     CheckTopScope(FScopeClass_Proc);
-    Proc:=TPasProcedure(El.Parent);
     {$IFDEF VerbosePasResolver}
     writeln('TPasResolver.FinishProcedureHeader El=',GetTreeDbg(El),' ',GetElementSourcePosStr(El),' IsForward=',Proc.IsForward,' Parent=',GetObjName(El.Parent));
     {$ENDIF}
@@ -5325,13 +5334,14 @@ begin
     if (proProcTypeWithoutIsNested in Options) and El.IsNested then
       RaiseInvalidProcTypeModifier(20170402120811,El,ptmIsNested,El);
 
-    if (Proc.Parent.ClassType=TProcedureBody) then
+    ParentBody:=GetParentProcBody(Proc.Parent);
+    if (ParentBody<>nil) then
       begin
       // nested sub proc
       if not (proProcTypeWithoutIsNested in Options) then
         El.IsNested:=true;
       // inherit 'of Object'
-      ParentProc:=Proc.Parent.Parent as TPasProcedure;
+      ParentProc:=ParentBody.Parent as TPasProcedure;
       if ParentProc.ProcType.IsOfObject then
         El.IsOfObject:=true;
       end;
@@ -5393,7 +5403,7 @@ begin
       end
     else
       begin
-      // intf proc, forward proc, proc body, method body
+      // intf proc, forward proc, proc body, method body, anonymous proc
       if Proc.IsAbstract then
         RaiseInvalidProcModifier(20170216151634,Proc,pmAbstract,Proc);
       if Proc.IsVirtual then
@@ -5405,8 +5415,12 @@ begin
       if Proc.IsStatic then
         RaiseInvalidProcTypeModifier(20170216151640,El,ptmStatic,El);
       if (not HasDots)
-          and (Proc.ClassType<>TPasProcedure)
-          and (Proc.ClassType<>TPasFunction) then
+          and (Proc.GetProcTypeEnum in [
+               ptClassOperator,
+               ptConstructor, ptDestructor,
+               ptClassProcedure, ptClassFunction,
+               ptClassConstructor, ptClassDestructor
+               ]) then
         RaiseXExpectedButYFound(20170419232724,'full method name','short name',El);
       end;
 
@@ -5418,7 +5432,8 @@ begin
 
     // finish interface/implementation/nested procedure/method declaration
 
-    if not IsValidIdent(ProcName) then
+    if not (Proc.GetProcTypeEnum in [ptAnonymousProcedure,ptAnonymousFunction])
+        and not IsValidIdent(ProcName) then
       RaiseNotYetImplemented(20160922163407,El);
 
     if El is TPasFunctionType then
@@ -5436,7 +5451,7 @@ begin
       end;
 
     // finish interface/implementation/nested procedure
-    if ProcNeedsBody(Proc) then
+    if (ProcName<>'') and ProcNeedsBody(Proc) then
       begin
       // check if there is a forward declaration
       ParentScope:=Scopes[ScopeCount-2];
@@ -5483,13 +5498,16 @@ begin
       StoreScannerFlagsInProc(ProcScope);
       end;
 
-    // check for invalid overloads
-    FindData:=Default(TFindOverloadProcData);
-    FindData.Proc:=Proc;
-    FindData.Args:=Proc.ProcType.Args;
-    FindData.Kind:=fopkProc;
-    Abort:=false;
-    IterateElements(ProcName,@OnFindOverloadProc,@FindData,Abort);
+    if ProcName<>'' then
+      begin
+      // check for invalid overloads
+      FindData:=Default(TFindOverloadProcData);
+      FindData.Proc:=Proc;
+      FindData.Args:=Proc.ProcType.Args;
+      FindData.Kind:=fopkProc;
+      Abort:=false;
+      IterateElements(ProcName,@OnFindOverloadProc,@FindData,Abort);
+      end;
     end
   else if El.Name<>'' then
     begin
@@ -6836,12 +6854,12 @@ begin
     else
       RaiseNotYetImplemented(20170203161826,ImplProc);
     end;
-  if DeclProc is TPasFunction then
+  if DeclProc.ProcType is TPasFunctionType then
     begin
     // redirect implementation 'Result' to declaration FuncType.ResultEl
     Identifier:=ImplProcScope.FindLocalIdentifier(ResolverResultVar);
     if Identifier.Element is TPasResultElement then
-      Identifier.Element:=TPasFunction(DeclProc).FuncType.ResultEl;
+      Identifier.Element:=TPasFunctionType(DeclProc.ProcType).ResultEl;
     end;
 end;
 
@@ -6899,11 +6917,11 @@ begin
     RaiseXExpectedButYFound(20170216151729,DeclProc.TypeName,ImplProc.TypeName,ImplProc);
   if ImplProc.CallingConvention<>DeclProc.CallingConvention then
     RaiseMsg(20170216151731,nCallingConventionMismatch,sCallingConventionMismatch,[],ImplProc);
-  if ImplProc is TPasFunction then
+  if ImplProc.ProcType is TPasFunctionType then
     begin
     // check result type
-    ImplResult:=TPasFunction(ImplProc).FuncType.ResultEl.ResultType;
-    DeclResult:=TPasFunction(DeclProc).FuncType.ResultEl.ResultType;
+    ImplResult:=TPasFunctionType(ImplProc.ProcType).ResultEl.ResultType;
+    DeclResult:=TPasFunctionType(DeclProc.ProcType).ResultEl.ResultType;
 
     if not CheckElTypeCompatibility(ImplResult,DeclResult,prraSimple) then
       RaiseIncompatibleType(20170216151734,nResultTypeMismatchExpectedButFound,
@@ -7827,6 +7845,7 @@ begin
         [],El);
     ResolveRecordValues(TRecordValues(El));
     end
+  else if ElClass=TProcedureExpr then
   else
     RaiseNotYetImplemented(20170222184329,El);
 
@@ -7882,7 +7901,7 @@ begin
       begin
       // examples: funca or @proca or a.funca or @a.funca ...
       Proc:=TPasProcedure(DeclEl);
-      if (Access=rraAssign) and (Proc is TPasFunction)
+      if (Access=rraAssign) and (Proc.ProcType is TPasFunctionType)
           and (El.ClassType=TPrimitiveExpr)
           and (El.Parent.ClassType=TPasImplAssign)
           and (TPasImplAssign(El.Parent).left=El) then
@@ -7895,7 +7914,7 @@ begin
         if El.HasParent(ImplProc) then
           begin
           // "FuncA:=" within FuncA  -> redirect to ResultEl
-          Ref.Declaration:=(Proc as TPasFunction).FuncType.ResultEl;
+          Ref.Declaration:=TPasFunctionType(Proc.ProcType).ResultEl;
           exit;
           end;
         end;
@@ -8499,7 +8518,7 @@ var
     if DeclEl is TPasProcedure then
       begin
       Proc:=TPasProcedure(DeclEl);
-      if (Access=rraAssign) and (Proc is TPasFunction)
+      if (Access=rraAssign) and (Proc.ProcType is TPasFunctionType)
           and (Value.ClassType=TPrimitiveExpr)
           and (Params.Parent.ClassType=TPasImplAssign)
           and (TPasImplAssign(Params.Parent).left=Params) then
@@ -8512,7 +8531,7 @@ var
         if Params.HasParent(ImplProc) then
           begin
           // "FuncA[]:=" within FuncA -> redirect to ResultEl
-          Ref.Declaration:=(Proc as TPasFunction).FuncType.ResultEl;
+          Ref.Declaration:=TPasFunctionType(Proc.ProcType).ResultEl;
           end;
         end;
       end;
@@ -8930,7 +8949,8 @@ begin
   else if (Access in [rraRead,rraParamToUnknownProc])
       and ((C=TPrimitiveExpr)
         or (C=TNilExpr)
-        or (C=TBoolConstExpr)) then
+        or (C=TBoolConstExpr)
+        or (C=TProcedureExpr)) then
     // ok
   else if C=TUnaryExpr then
     AccessExpr(TUnaryExpr(Expr).Operand,Access)
@@ -9350,10 +9370,10 @@ begin
   {$ENDIF}
   if not (TopScope is TPasIdentifierScope) then
     RaiseInvalidScopeForElement(20160922163522,El);
-  // Note: El.ProcType is nil !
+  // Note: El.ProcType is nil !  It is parsed later.
   ProcName:=El.Name;
   HasDot:=Pos('.',ProcName)>1;
-  if not HasDot then
+  if (not HasDot) and (ProcName<>'') then
     AddIdentifier(TPasIdentifierScope(TopScope),ProcName,El,pikProc);
   ProcScope:=TPasProcedureScope(PushScope(El,FScopeClass_Proc));
   ProcScope.ModeSwitches:=CurrentParser.CurrentModeswitches;
@@ -9420,7 +9440,7 @@ begin
 
     ProcScope.VisibilityContext:=CurClassType;
     ProcScope.ClassScope:=NoNil(CurClassType.CustomData) as TPasClassScope;
-    end;
+    end;// HasDot=true
 end;
 
 procedure TPasResolver.AddArgument(El: TPasArgument);
@@ -10500,9 +10520,9 @@ begin
         Proc:=TPasProcedure(ResolvedEl.IdentEl);
         if rcConstant in Flags then
           RaiseConstantExprExp(20170216152637,Params);
-        if Proc is TPasFunction then
+        if Proc.ProcType is TPasFunctionType then
           // function call => return result
-          ComputeElement(TPasFunction(Proc).FuncType.ResultEl,ResolvedEl,
+          ComputeElement(TPasFunctionType(Proc.ProcType).ResultEl,ResolvedEl,
             Flags+[rcNoImplicitProc],StartEl)
         else if (Proc.ClassType=TPasConstructor)
             and (rrfNewInstance in Ref.Flags) then
@@ -12498,6 +12518,7 @@ var
   ProcScope: TPasProcedureScope;
   ResultEl: TPasResultElement;
   Flags: TPasResolverComputeFlags;
+  CtxProc: TPasProcedure;
 begin
   if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
     exit(cExact);
@@ -12515,14 +12536,15 @@ begin
     begin
     // first param is function result
     ProcScope:=TPasProcedureScope(Scopes[i]);
-    if not (ProcScope.Element is TPasFunction) then
+    CtxProc:=TPasProcedure(ProcScope.Element);
+    if not (CtxProc.ProcType is TPasFunctionType) then
       begin
       if RaiseOnError then
         RaiseMsg(20170216152312,nWrongNumberOfParametersForCallTo,
           sWrongNumberOfParametersForCallTo,['procedure exit'],Params.Params[0]);
       exit(cIncompatible);
       end;
-    ResultEl:=(ProcScope.Element as TPasFunction).FuncType.ResultEl;
+    ResultEl:=TPasFunctionType(CtxProc.ProcType).ResultEl;
     ComputeElement(ResultEl,ResultResolved,[rcType]);
     end
   else
@@ -12937,9 +12959,9 @@ begin
           begin
           Expr:=TPasVariable(ParamResolved.IdentEl).Expr;
           if Expr is TArrayValues then
-            Evaluated:=TResEvalInt.CreateValue(length(TArrayValues(Expr).Values)-1)
+            Evaluated:=TResEvalInt.CreateValue(TMaxPrecInt(length(TArrayValues(Expr).Values))-1)
           else if (Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
-            Evaluated:=TResEvalInt.CreateValue(length(TParamsExpr(Expr).Params)-1);
+            Evaluated:=TResEvalInt.CreateValue(TMaxPrecInt(length(TParamsExpr(Expr).Params))-1);
           if Evaluated=nil then
             RaiseXExpectedButYFound(20170601191003,'array constant','expression',Params);
           end
@@ -13635,8 +13657,9 @@ begin
       aType:=TPasArgument(Decl).ArgType
     else if Decl.ClassType=TPasResultElement then
       aType:=TPasResultElement(Decl).ResultType
-    else if Decl is TPasFunction then
-      aType:=TPasFunction(Decl).FuncType.ResultEl.ResultType;
+    else if (Decl is TPasProcedure)
+        and (TPasProcedure(Decl).ProcType is TPasFunctionType) then
+      aType:=TPasFunctionType(TPasProcedure(Decl).ProcType).ResultEl.ResultType;
     {$IFDEF VerbosePasResolver}
     {AllowWriteln}
     if aType=nil then
@@ -16446,7 +16469,7 @@ begin
         begin
         EnumType:=TPasEnumType(LTypeEl);
         LRangeValue:=TResEvalRangeInt.CreateValue(revskEnum,EnumType,
-          0,EnumType.Values.Count-1);
+          0,TMaxPrecInt(EnumType.Values.Count)-1);
         end
       else if C=TPasUnresolvedSymbolRef then
         begin
@@ -17047,7 +17070,15 @@ begin
         if CheckProcTypeCompatibility(TPasProcedureType(LHS.LoTypeEl),
             TPasProcedure(RHS.IdentEl).ProcType,true,ErrorEl,RaiseOnIncompatible) then
           exit(cExact);
-        end;
+        end
+      else if (LHS.LoTypeEl is TPasProcedureType)
+          and (RHS.ExprEl is TProcedureExpr) then
+        begin
+        // for example  ProcVar:=anonymous-procedure...
+        if CheckProcTypeCompatibility(TPasProcedureType(LHS.LoTypeEl),
+            TProcedureExpr(RHS.ExprEl).Proc.ProcType,true,ErrorEl,RaiseOnIncompatible) then
+          exit(cExact);
+        end
       end
     else if LBT=btPointer then
       begin
@@ -19846,7 +19877,7 @@ begin
     begin
     TypeEl:=TPasProcedure(El).ProcType;
     SetResolverIdentifier(ResolvedEl,btProc,El,TypeEl,TypeEl,[rrfCanBeStatement]);
-    if El is TPasFunction then
+    if TPasProcedure(El).ProcType is TPasFunctionType then
       Include(ResolvedEl.Flags,rrfReadable);
     // Note: the readability of TPasConstructor depends on the context
     // Note: implicit calls are handled in TPrimitiveExpr
@@ -19857,6 +19888,11 @@ begin
                TPasProcedureType(El),TPasProcedureType(El),[rrfCanBeStatement]);
     // Note: implicit calls are handled in TPrimitiveExpr
     end
+  else if ElClass=TProcedureExpr then
+    begin
+    TypeEl:=TProcedureExpr(El).Proc.ProcType;
+    SetResolverValueExpr(ResolvedEl,btProc,TypeEl,TypeEl,TProcedureExpr(El),[rrfReadable]);
+    end
   else if ElClass=TPasArrayType then
     SetResolverIdentifier(ResolvedEl,btContext,El,TPasArrayType(El),TPasArrayType(El),[])
   else if ElClass=TArrayValues then
@@ -20001,6 +20037,17 @@ begin
     end;
 end;
 
+function TPasResolver.GetParentProcBody(El: TPasElement): TProcedureBody;
+begin
+  while El<>nil do
+    begin
+    if El is TProcedureBody then
+      exit(TProcedureBody(El));
+    El:=El.Parent;
+    end;
+  Result:=nil;
+end;
+
 function TPasResolver.ProcHasImplElements(Proc: TPasProcedure): boolean;
 begin
   Result:=GetProcFirstImplEl(Proc)<>nil;
@@ -20558,7 +20605,7 @@ begin
   else if C=TPasEnumType then
     begin
     Result:=TResEvalRangeInt.CreateValue(revskEnum,TPasEnumType(Decl),
-                                         0,TPasEnumType(Decl).Values.Count-1);
+                              0,TMaxPrecInt(TPasEnumType(Decl).Values.Count)-1);
     Result.IdentEl:=Decl;
     exit;
     end

packages/fcl-passrc/src/pastree.pp

@@ -82,6 +82,8 @@ resourcestring
   SPasTreeClassDestructor = 'class destructor';
   SPasTreeConstructor = 'constructor';
   SPasTreeDestructor = 'destructor';
+  SPasTreeAnonymousProcedure = 'anonymous procedure';
+  SPasTreeAnonymousFunction = 'anonymous function';
   SPasTreeProcedureImpl = 'procedure/function implementation';
   SPasTreeConstructorImpl = 'constructor implementation';
   SPasTreeDestructorImpl = 'destructor implementation';
@@ -192,7 +194,7 @@ type
 
   TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekNil, pekBoolConst,
      pekRange, pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp,
-     pekInherited, pekSelf, pekSpecialize);
+     pekInherited, pekSelf, pekSpecialize, pekProcedure);
 
   TExprOpCode = (eopNone,
                  eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
@@ -969,7 +971,8 @@ type
                ptOperator, ptClassOperator,
                ptConstructor, ptDestructor,
                ptClassProcedure, ptClassFunction,
-               ptClassConstructor, ptClassDestructor);
+               ptClassConstructor, ptClassDestructor,
+               ptAnonymousProcedure, ptAnonymousFunction);
 
   { TPasProcedureBase }
 
@@ -1004,6 +1007,8 @@ type
                         
   TProcedureBody = class;
 
+  { TPasProcedure - named procedure, not anonymous }
+
   TPasProcedure = class(TPasProcedureBase)
   Private
     FModifiers : TProcedureModifiers;
@@ -1020,13 +1025,13 @@ type
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
   public
-    ProcType : TPasProcedureType;
-    Body : TProcedureBody;
     PublicName, // e.g. public PublicName;
     LibrarySymbolName,
     LibraryExpr : TPasExpr; // e.g. external LibraryExpr name LibrarySymbolName;
     DispIDExpr :  TPasExpr;
     AliasName : String;
+    ProcType : TPasProcedureType;
+    Body : TProcedureBody;
     Procedure AddModifier(AModifier : TProcedureModifier);
     Function IsVirtual : Boolean;
     Function IsDynamic : Boolean;
@@ -1039,6 +1044,7 @@ type
     Function IsReintroduced : Boolean;
     Function IsStatic : Boolean;
     Function IsForward: Boolean;
+    Function GetProcTypeEnum: TProcType; virtual;
     Property Modifiers : TProcedureModifiers Read FModifiers Write FModifiers;
     Property CallingConvention : TCallingConvention Read GetCallingConvention Write SetCallingConvention;
     Property MessageName : String Read FMessageName Write FMessageName;
@@ -1048,14 +1054,16 @@ type
 
   TArrayOfPasProcedure = array of TPasProcedure;
 
+  { TPasFunction - named function, not anonymous function}
+
   TPasFunction = class(TPasProcedure)
   private
     function GetFT: TPasFunctionType; inline;
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
-    function GetDeclaration (full : boolean) : string; override;
     Property FuncType : TPasFunctionType Read GetFT;
+    function GetProcTypeEnum: TProcType; override;
   end;
 
   { TPasOperator }
@@ -1082,17 +1090,18 @@ type
     Function OldName(WithPath : Boolean) : String;
     function ElementTypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
     function GetDeclaration (full : boolean) : string; override;
     Property OperatorType : TOperatorType Read FOperatorType Write FOperatorType;
     // True if the declaration was using a token instead of an identifier
     Property TokenBased : Boolean Read FTokenBased Write FTokenBased;
   end;
 
-Type
   { TPasClassOperator }
 
   TPasClassOperator = class(TPasOperator)
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
 
 
@@ -1102,6 +1111,7 @@ Type
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
 
   { TPasClassConstructor }
@@ -1110,6 +1120,7 @@ Type
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
 
   { TPasDestructor }
@@ -1118,6 +1129,7 @@ Type
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
 
   { TPasClassDestructor }
@@ -1126,6 +1138,7 @@ Type
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
 
   { TPasClassProcedure }
@@ -1134,6 +1147,7 @@ Type
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
 
   { TPasClassFunction }
@@ -1142,8 +1156,43 @@ Type
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
+  end;
+
+  { TPasAnonymousProcedure - parent is TProcedureExpr }
+
+  TPasAnonymousProcedure = class(TPasProcedure)
+  public
+    function ElementTypeName: string; override;
+    function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
+  end;
+
+  { TPasAnonymousFunction - parent is TProcedureExpr and ProcType is TPasFunctionType}
+
+  TPasAnonymousFunction = class(TPasAnonymousProcedure)
+  private
+    function GetFT: TPasFunctionType; inline;
+  public
+    function ElementTypeName: string; override;
+    function TypeName: string; override;
+    Property FuncType : TPasFunctionType Read GetFT;
+    function GetProcTypeEnum: TProcType; override;
   end;
 
+  { TProcedureExpr }
+
+  TProcedureExpr = class(TPasExpr)
+  public
+    Proc: TPasAnonymousProcedure;
+    constructor Create(AParent: TPasElement); overload;
+    destructor Destroy; override;
+    function GetDeclaration(full: Boolean): string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
+  end;
+
+
   TPasImplBlock = class;
 
   { TProcedureBody - the var+type+const+begin, without the header, child of TPasProcedure }
@@ -1577,7 +1626,8 @@ const
       'ListOfExp',
       'Inherited',
       'Self',
-      'Specialize');
+      'Specialize',
+      'Procedure');
 
   OpcodeStrings : Array[TExprOpCode] of string = (
         '','+','-','*','/','div','mod','**',
@@ -1643,6 +1693,26 @@ begin
   El:=nil;
 end;
 
+Function IndentStrings(S : TStrings; indent : Integer) : string;
+Var
+  I,CurrLen,CurrPos : Integer;
+begin
+  Result:='';
+  CurrLen:=0;
+  CurrPos:=0;
+  For I:=0 to S.Count-1 do
+    begin
+    CurrLen:=Length(S[i]);
+    If (CurrLen+CurrPos)>72 then
+      begin
+      Result:=Result+LineEnding+StringOfChar(' ',Indent);
+      CurrPos:=Indent;
+      end;
+    Result:=Result+S[i];
+    CurrPos:=CurrPos+CurrLen;
+    end;
+end;
+
 {$IFDEF HasPTDumpStack}
 procedure PTDumpStack;
 begin
@@ -1843,6 +1913,11 @@ begin
   Result:='class operator';
 end;
 
+function TPasClassOperator.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptClassOperator;
+end;
+
 { TPasImplAsmStatement }
 
 constructor TPasImplAsmStatement.Create(const AName: string;
@@ -1865,6 +1940,79 @@ begin
   Result:='class '+ inherited TypeName;
 end;
 
+function TPasClassConstructor.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptClassConstructor;
+end;
+
+{ TPasAnonymousProcedure }
+
+function TPasAnonymousProcedure.ElementTypeName: string;
+begin
+  Result:=SPasTreeAnonymousProcedure;
+end;
+
+function TPasAnonymousProcedure.TypeName: string;
+begin
+  Result:='anonymous procedure';
+end;
+
+function TPasAnonymousProcedure.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptAnonymousProcedure;
+end;
+
+{ TPasAnonymousFunction }
+
+function TPasAnonymousFunction.GetFT: TPasFunctionType;
+begin
+  Result:=ProcType as TPasFunctionType;
+end;
+
+function TPasAnonymousFunction.ElementTypeName: string;
+begin
+  Result := SPasTreeAnonymousFunction;
+end;
+
+function TPasAnonymousFunction.TypeName: string;
+begin
+  Result:='anonymous function';
+end;
+
+function TPasAnonymousFunction.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptAnonymousFunction;
+end;
+
+{ TProcedureExpr }
+
+constructor TProcedureExpr.Create(AParent: TPasElement);
+begin
+  inherited Create(AParent,pekProcedure, eopNone);
+end;
+
+destructor TProcedureExpr.Destroy;
+begin
+  ReleaseAndNil(TPasElement(Proc){$IFDEF CheckPasTreeRefCount},'TProcedureExpr.Proc'{$ENDIF});
+  inherited Destroy;
+end;
+
+function TProcedureExpr.GetDeclaration(full: Boolean): string;
+begin
+  if Proc<>nil then
+    Result:=Proc.GetDeclaration(full)
+  else
+    Result:='procedure-expr';
+end;
+
+procedure TProcedureExpr.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  if Proc<>nil then
+    Proc.ForEachCall(aMethodCall,Arg);
+end;
+
 { TPasImplRaise }
 
 destructor TPasImplRaise.Destroy;
@@ -2157,7 +2305,7 @@ begin
   Result:=ProcType as TPasFunctionType;
 end;
 
-function TPasFunction.ElementTypeName: string; begin Result := SPasTreeFunction end;
+function TPasFunction.ElementTypeName: string; begin Result := SPasTreeFunction; end;
 function TPasClassProcedure.ElementTypeName: string; begin Result := SPasTreeClassProcedure; end;
 function TPasClassConstructor.ElementTypeName: string; begin Result := SPasTreeClassConstructor; end;
 function TPasClassDestructor.ElementTypeName: string; begin Result := SPasTreeClassDestructor; end;
@@ -2167,6 +2315,11 @@ begin
   Result:='destructor';
 end;
 
+function TPasClassDestructor.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptClassDestructor;
+end;
+
 function TPasClassFunction.ElementTypeName: string; begin Result := SPasTreeClassFunction; end;
 
 class function TPasOperator.OperatorTypeToToken(T: TOperatorType): String;
@@ -3229,12 +3382,12 @@ end;
 
 destructor TPasProcedure.Destroy;
 begin
-  ReleaseAndNil(TPasElement(ProcType){$IFDEF CheckPasTreeRefCount},'TPasProcedure.ProcType'{$ENDIF});
-  ReleaseAndNil(TPasElement(Body){$IFDEF CheckPasTreeRefCount},'TPasProcedure.Body'{$ENDIF});
   ReleaseAndNil(TPasElement(PublicName){$IFDEF CheckPasTreeRefCount},'TPasProcedure.PublicName'{$ENDIF});
   ReleaseAndNil(TPasElement(LibraryExpr){$IFDEF CheckPasTreeRefCount},'TPasProcedure.LibraryExpr'{$ENDIF});
   ReleaseAndNil(TPasElement(LibrarySymbolName){$IFDEF CheckPasTreeRefCount},'TPasProcedure.LibrarySymbolName'{$ENDIF});
   ReleaseAndNil(TPasElement(DispIDExpr){$IFDEF CheckPasTreeRefCount},'TPasProcedure.DispIDExpr'{$ENDIF});
+  ReleaseAndNil(TPasElement(ProcType){$IFDEF CheckPasTreeRefCount},'TPasProcedure.ProcType'{$ENDIF});
+  ReleaseAndNil(TPasElement(Body){$IFDEF CheckPasTreeRefCount},'TPasProcedure.Body'{$ENDIF});
   inherited Destroy;
 end;
 
@@ -3764,29 +3917,6 @@ begin
   ForEachChildCall(aMethodCall,Arg,ElType,true);
 end;
 
-Function IndentStrings(S : TStrings; indent : Integer) : string;
-
-Var
-  I,CurrLen,CurrPos : Integer;
-
-
-begin
-  Result:='';
-  CurrLen:=0;
-  CurrPos:=0;
-  For I:=0 to S.Count-1 do
-    begin
-    CurrLen:=Length(S[i]);
-    If (CurrLen+CurrPos)>72 then
-      begin
-      Result:=Result+LineEnding+StringOfChar(' ',Indent);
-      CurrPos:=Indent;
-      end;
-    Result:=Result+S[i];
-    CurrPos:=CurrPos+CurrLen;
-    end;
-end;
-
 function TPasEnumType.GetDeclaration (full : boolean) : string;
 
 Var
@@ -4278,8 +4408,8 @@ procedure TPasProcedure.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
 begin
   inherited ForEachCall(aMethodCall, Arg);
-  ForEachChildCall(aMethodCall,Arg,PublicName,false);
   ForEachChildCall(aMethodCall,Arg,ProcType,false);
+  ForEachChildCall(aMethodCall,Arg,PublicName,false);
   ForEachChildCall(aMethodCall,Arg,LibraryExpr,false);
   ForEachChildCall(aMethodCall,Arg,LibrarySymbolName,false);
   ForEachChildCall(aMethodCall,Arg,Body,false);
@@ -4347,36 +4477,28 @@ begin
   Result:=pmForward in FModifiers;
 end;
 
-function TPasProcedure.GetDeclaration(full: Boolean): string;
-
-Var
-  S : TStringList;
+function TPasProcedure.GetProcTypeEnum: TProcType;
 begin
-  S:=TStringList.Create;
-  try
-    If Full then
-      S.Add(TypeName+' '+Name);
-    ProcType.GetArguments(S);
-    GetModifiers(S);
-    Result:=IndentStrings(S,Length(S[0]));
-  finally
-    S.Free;
-  end;
+  Result:=ptProcedure;
 end;
 
-function TPasFunction.GetDeclaration (full : boolean) : string;
-
+function TPasProcedure.GetDeclaration(full: Boolean): string;
 Var
   S : TStringList;
-  T : string;
-
+  T: String;
 begin
   S:=TStringList.Create;
   try
     If Full then
-      S.Add(TypeName+' '+Name);
+      begin
+      T:=TypeName;
+      if Name<>'' then
+        T:=T+' '+Name;
+      S.Add(T);
+      end;
     ProcType.GetArguments(S);
-    If Assigned((Proctype as TPasFunctionType).ResultEl) then
+    If ProcType is TPasFunctionType
+        and Assigned(TPasFunctionType(Proctype).ResultEl) then
       With TPasFunctionType(ProcType).ResultEl.ResultType do
         begin
         T:=' : ';
@@ -4398,6 +4520,11 @@ begin
   Result:='function';
 end;
 
+function TPasFunction.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptFunction;
+end;
+
 function TPasOperator.GetOperatorDeclaration(Full : Boolean) : string;
 
 begin
@@ -4450,26 +4577,51 @@ begin
   Result:='operator';
 end;
 
+function TPasOperator.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptOperator;
+end;
+
 function TPasClassProcedure.TypeName: string;
 begin
   Result:='class procedure';
 end;
 
+function TPasClassProcedure.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptClassProcedure;
+end;
+
 function TPasClassFunction.TypeName: string;
 begin
   Result:='class function';
 end;
 
+function TPasClassFunction.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptClassFunction;
+end;
+
 function TPasConstructor.TypeName: string;
 begin
   Result:='constructor';
 end;
 
+function TPasConstructor.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptConstructor;
+end;
+
 function TPasDestructor.TypeName: string;
 begin
   Result:='destructor';
 end;
 
+function TPasDestructor.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptDestructor;
+end;
+
 function TPasArgument.GetDeclaration (full : boolean) : string;
 begin
   If Assigned(ArgType) then

packages/fcl-passrc/src/pparser.pp

@@ -314,7 +314,7 @@ type
     function ReadDottedIdentifier(Parent: TPasElement; out Expr: TPasExpr; NeedAsString: boolean): String;
     function CheckProcedureArgs(Parent: TPasElement;
       Args: TFPList; // list of TPasArgument
-      Mandatory: Boolean): boolean;
+      ProcType: TProcType): boolean;
     function CheckVisibility(S: String; var AVisibility: TPasMemberVisibility): Boolean;
     procedure ParseExc(MsgNumber: integer; const Msg: String);
     procedure ParseExc(MsgNumber: integer; const Fmt: String; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif});
@@ -349,12 +349,15 @@ type
     function CreateRecordValues(AParent : TPasElement): TRecordValues;
     Function IsCurTokenHint(out AHint : TPasMemberHint) : Boolean; overload;
     Function IsCurTokenHint: Boolean; overload;
-    Function TokenIsCallingConvention(const S : String; out CC : TCallingConvention) : Boolean; virtual;
-    Function TokenIsProcedureModifier(Parent : TPasElement; const S : String; Out PM : TProcedureModifier) : Boolean; virtual;
+    Function TokenIsCallingConvention(const S: String; out CC : TCallingConvention) : Boolean; virtual;
+    Function TokenIsProcedureModifier(Parent: TPasElement; const S: String; Out PM : TProcedureModifier): Boolean; virtual;
+    Function TokenIsAnonymousProcedureModifier(Parent: TPasElement; S: String; Out PM: TProcedureModifier): Boolean; virtual;
     Function TokenIsProcedureTypeModifier(Parent : TPasElement; const S : String; Out PTM : TProcTypeModifier) : Boolean; virtual;
     Function CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
+    function IsAnonymousProcAllowed(El: TPasElement): boolean; virtual;
     function ParseParams(AParent : TPasElement; ParamsKind: TPasExprKind; AllowFormatting : Boolean = False): TParamsExpr;
-    function ParseExpIdent(AParent : TPasElement): TPasExpr;
+    function ParseExprOperand(AParent : TPasElement): TPasExpr;
+    function ParseExpIdent(AParent : TPasElement): TPasExpr; deprecated 'use ParseExprOperand instead'; // since fpc 3.3.1
     procedure DoParseClassType(AType: TPasClassType);
     function DoParseExpression(AParent: TPaselement;InitExpr: TPasExpr=nil; AllowEqual : Boolean = True): TPasExpr;
     function DoParseConstValueExpression(AParent: TPasElement): TPasExpr;
@@ -1241,6 +1244,21 @@ begin
     end;
 end;
 
+function TPasParser.TokenIsAnonymousProcedureModifier(Parent: TPasElement;
+  S: String; out PM: TProcedureModifier): Boolean;
+begin
+  S:=LowerCase(S);
+  case S of
+  'assembler':
+    begin
+    PM:=pmAssembler;
+    exit(true);
+    end;
+  end;
+  Result:=false;
+  if Parent=nil then ;
+end;
+
 function TPasParser.TokenIsProcedureTypeModifier(Parent: TPasElement;
   const S: String; out PTM: TProcTypeModifier): Boolean;
 begin
@@ -1291,6 +1309,17 @@ begin
     ExpectToken(tkSemiColon);
 end;
 
+function TPasParser.IsAnonymousProcAllowed(El: TPasElement): boolean;
+begin
+  while El is TPasExpr do
+    El:=El.Parent;
+  if not (El is TPasImplBlock) then
+    exit(false); // only in statements
+  while El is TPasImplBlock do
+    El:=El.Parent;
+  Result:=El is TProcedureBody; // needs a parent procedure
+end;
+
 function TPasParser.CheckPackMode: TPackMode;
 
 begin
@@ -2007,6 +2036,7 @@ begin
       begin
       repeat
         Expr:=DoParseExpression(Params);
+        writeln('AAA1 TPasParser.ParseParams ',CurTokenString,' ',curtoken);
         if not Assigned(Expr) then
           ParseExcSyntaxError;
         Params.AddParam(Expr);
@@ -2081,7 +2111,7 @@ begin
   end;
 end;
 
-function TPasParser.ParseExpIdent(AParent: TPasElement): TPasExpr;
+function TPasParser.ParseExprOperand(AParent: TPasElement): TPasExpr;
 
   Function IsWriteOrStr(P : TPasExpr) : boolean;
 
@@ -2109,7 +2139,7 @@ function TPasParser.ParseExpIdent(AParent: TPasElement): TPasExpr;
       begin // self.Write(EscapeText(AText));
       optk:=CurToken;
       NextToken;
-      b:=CreateBinaryExpr(AParent,Last, ParseExpIdent(AParent), TokenToExprOp(optk));
+      b:=CreateBinaryExpr(AParent,Last, ParseExprOperand(AParent), TokenToExprOp(optk));
       if not Assigned(b.right) then
         begin
         b.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
@@ -2180,15 +2210,16 @@ var
   ISE: TInlineSpecializeExpr;
   ST: TPasSpecializeType;
   SrcPos, ScrPos: TPasSourcePos;
+  ProcType: TProcType;
 
 begin
   Result:=nil;
   CanSpecialize:=false;
   aName:='';
   case CurToken of
-    tkString:           Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenString);
-    tkChar:             Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenText);
-    tkNumber:           Last:=CreatePrimitiveExpr(AParent,pekNumber,CurTokenString);
+    tkString: Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenString);
+    tkChar:   Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenText);
+    tkNumber: Last:=CreatePrimitiveExpr(AParent,pekNumber,CurTokenString);
     tkIdentifier:
       begin
       CanSpecialize:=true;
@@ -2212,7 +2243,7 @@ begin
       if (CurToken=tkIdentifier) then
         begin
         SrcPos:=CurTokenPos;
-        Bin:=CreateBinaryExpr(AParent,Last,ParseExpIdent(AParent),eopNone,SrcPos);
+        Bin:=CreateBinaryExpr(AParent,Last,ParseExprOperand(AParent),eopNone,SrcPos);
         if not Assigned(Bin.right) then
           begin
           Bin.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
@@ -2230,6 +2261,27 @@ begin
       Last:=CreateSelfExpr(AParent);
       HandleSelf(Last);
       end;
+    tkprocedure,tkfunction:
+      begin
+      if CurToken=tkprocedure then
+        ProcType:=ptAnonymousProcedure
+      else
+        ProcType:=ptAnonymousFunction;
+      if not IsAnonymousProcAllowed(AParent) then
+        ParseExcExpectedIdentifier;
+      ok:=false;
+      try
+        Result:=TProcedureExpr(CreateElement(TProcedureExpr,'',AParent,visPublic));
+        TProcedureExpr(Result).Proc:=TPasAnonymousProcedure(ParseProcedureOrFunctionDecl(Result,ProcType));
+        if CurToken=tkSemicolon then
+          NextToken; // skip optional semicolon
+        ok:=true;
+      finally
+        if not ok then
+          Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+      end;
+      exit; // do not allow postfix operators . ^. [] ()
+      end;
     tkCaret:
       begin
       // is this still needed?
@@ -2329,6 +2381,11 @@ begin
   end;
 end;
 
+function TPasParser.ParseExpIdent(AParent: TPasElement): TPasExpr;
+begin
+  Result:=ParseExprOperand(AParent);
+end;
+
 function TPasParser.OpLevel(t: TToken): Integer;
 begin
   case t of
@@ -2491,12 +2548,12 @@ begin
           if (CurToken=tkDot) then
             begin
             NextToken;
-            x:=CreateBinaryExpr(AParent,x, ParseExpIdent(AParent), TokenToExprOp(tkDot));
+            x:=CreateBinaryExpr(AParent,x, ParseExprOperand(AParent), TokenToExprOp(tkDot));
             end;
           end
         else
           begin
-          x:=ParseExpIdent(AParent);
+          x:=ParseExprOperand(AParent);
           if not Assigned(x) then
             ParseExcSyntaxError;
           end;
@@ -4584,12 +4641,11 @@ end;
 
 
 function TPasParser.CheckProcedureArgs(Parent: TPasElement; Args: TFPList;
-  Mandatory: Boolean): boolean;
+  ProcType: TProcType): boolean;
 
 begin
   NextToken;
-  case CurToken of
-  tkBraceOpen:
+  if CurToken=tkBraceOpen then
     begin
     Result:=true;
     NextToken;
@@ -4598,18 +4654,34 @@ begin
       UngetToken;
       ParseArgList(Parent, Args, tkBraceClose);
       end;
-    end;
-  tkSemicolon,tkColon,tkof,tkis,tkIdentifier:
+    end
+  else
     begin
     Result:=false;
-    if Mandatory then
-      ParseExc(nParserExpectedLBracketColon,SParserExpectedLBracketColon)
+    case ProcType of
+    ptOperator,ptClassOperator:
+      ParseExc(nParserExpectedLBracketColon,SParserExpectedLBracketColon);
+    ptAnonymousProcedure,ptAnonymousFunction:
+      case CurToken of
+      tkIdentifier, // e.g. procedure assembler
+      tkbegin,tkvar,tkconst,tktype,tkprocedure,tkfunction:
+        UngetToken;
+      else
+        ParseExcTokenError('begin');
+      end;
     else
-      UngetToken;
-    end
-  else
-    ParseExcTokenError(';');
-  end;
+      case CurToken of
+        tkSemicolon, // e.g. procedure;
+        tkColon, // e.g. function: id
+        tkof, // e.g. procedure of object
+        tkis, // e.g. procedure is nested
+        tkIdentifier: // e.g. procedure cdecl;
+          UngetToken;
+      else
+        ParseExcTokenError(';');
+      end;
+    end;
+    end;
 end;
 
 procedure TPasParser.HandleProcedureModifier(Parent: TPasElement; pm: TProcedureModifier);
@@ -4800,20 +4872,22 @@ Var
   Tok : String;
   CC : TCallingConvention;
   PM : TProcedureModifier;
-  Done: Boolean;
   ResultEl: TPasResultElement;
-  OK,IsProc : Boolean;
+  OK: Boolean;
+  IsProc: Boolean; // true = procedure, false = procedure type
+  IsAnonymProc: Boolean;
   PTM: TProcTypeModifier;
-  ModCount: Integer;
+  ModTokenCount: Integer;
   LastToken: TToken;
 
 begin
   // Element must be non-nil. Removed all checks for not-nil.
   // If it is nil, the following fails anyway.
-  CheckProcedureArgs(Element,Element.Args,ProcType in [ptOperator,ptClassOperator]);
+  CheckProcedureArgs(Element,Element.Args,ProcType);
   IsProc:=Parent is TPasProcedure;
+  IsAnonymProc:=IsProc and (ProcType in [ptAnonymousProcedure,ptAnonymousFunction]);
   case ProcType of
-    ptFunction,ptClassFunction:
+    ptFunction,ptClassFunction,ptAnonymousFunction:
       begin
       NextToken;
       if CurToken = tkColon then
@@ -4882,13 +4956,13 @@ begin
     else
       UnGetToken;
     end;
-  ModCount:=0;
+  ModTokenCount:=0;
   Repeat
-    inc(ModCount);
-    // Writeln(modcount, curtokentext);
+    inc(ModTokenCount);
+    // Writeln(ModTokenCount, curtokentext);
     LastToken:=CurToken;
     NextToken;
-    if (ModCount<=3) and (CurToken = tkEqual) and not (Parent is TPasProcedure) then
+    if (CurToken = tkEqual) and not IsProc and (ModTokenCount<=3) then
       begin
       // for example: const p: procedure = nil;
       UngetToken;
@@ -4899,6 +4973,7 @@ begin
       begin
       if LastToken=tkSemicolon then
         ParseExcSyntaxError;
+      continue;
       end
     else if TokenIsCallingConvention(CurTokenString,cc) then
       begin
@@ -4917,11 +4992,18 @@ begin
           NextToken; // remove offset
           end;
       end;
-      ExpectTokens([tkSemicolon,tkEqual]);
-      if CurToken=tkEqual then
-        UngetToken;
+      if IsProc then
+        ExpectTokens([tkSemicolon])
+      else
+        begin
+        ExpectTokens([tkSemicolon,tkEqual]);
+        if CurToken=tkEqual then
+          UngetToken;
+        end;
       end
-    else if IsProc and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
+    else if IsAnonymProc and TokenIsAnonymousProcedureModifier(Parent,CurTokenString,PM) then
+      HandleProcedureModifier(Parent,PM)
+    else if IsProc and not IsAnonymProc and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
       HandleProcedureModifier(Parent,PM)
     else if TokenIsProcedureTypeModifier(Parent,CurTokenString,PTM) then
       HandleProcedureTypeModifier(Element,PTM)
@@ -4930,16 +5012,22 @@ begin
       Tok:=UpperCase(CurTokenString);
       NextToken;
       If (tok<>'NAME') then
-        Element.Hints:=Element.Hints+[hLibrary]
+        begin
+        if hLibrary in Element.Hints then
+          ParseExcSyntaxError;
+        Element.Hints:=Element.Hints+[hLibrary];
+        end
       else
         begin
-        NextToken;  // Should be export name string.
+        NextToken;  // Should be "export name astring".
         ExpectToken(tkSemicolon);
         end;
       end
-    else if DoCheckHint(Element) then
+    else if (not IsAnonymProc) and DoCheckHint(Element) then
+      // deprecated,platform,experimental,library, unimplemented etc
       ConsumeSemi
-    else if (CurToken=tkIdentifier) and (CompareText(CurTokenText,'alias')=0) then
+    else if (CurToken=tkIdentifier) and (not IsAnonymProc)
+        and (CompareText(CurTokenText,'alias')=0) then
       begin
       ExpectToken(tkColon);
       ExpectToken(tkString);
@@ -4959,44 +5047,48 @@ begin
         begin
         // ToDo: read FPC's [] modifiers, e.g. [public,alias:'']
         repeat
-          NextToken
+          NextToken;
+          if CurToken in [tkSquaredBraceOpen,tkSemicolon] then
+            CheckToken(tkSquaredBraceClose);
         until CurToken = tkSquaredBraceClose;
         ExpectToken(tkSemicolon);
         end;
       end
     else
-      CheckToken(tkSemicolon);
-    Done:=(CurToken=tkSemiColon);
-    if Done then
       begin
-      NextToken;
-      Done:=Not ((Curtoken=tkSquaredBraceOpen) or
-                  TokenIsProcedureModifier(Parent,CurtokenString,PM) or
-                  TokenIsProcedureTypeModifier(Parent,CurtokenString,PTM) or
-                  IsCurTokenHint() or
-                  TokenIsCallingConvention(CurTokenString,cc) or
-                  (CurToken=tkIdentifier) and (CompareText(CurTokenText,'alias')=0));
-      {$ifdef VerbosePasParser}
-      DumpCurToken('Done '+IntToStr(Ord(Done)));
-      {$endif}
-      UngetToken;
+      // not a modifier/hint/calling convention
+      if LastToken=tkSemicolon then
+        begin
+        UngetToken;
+        if IsAnonymProc and (ModTokenCount<=1) then
+          ParseExcSyntaxError;
+        break;
+        end
+      else if IsAnonymProc then
+        begin
+        UngetToken;
+        break;
+        end
+      else
+        begin
+        CheckToken(tkSemicolon);
+        continue;
+        end;
       end;
-
-//    Writeln('Done: ',TokenInfos[Curtoken],' ',CurtokenString);
-  Until Done;
-  if DoCheckHint(Element) then  // deprecated,platform,experimental,library, unimplemented etc
-    ConsumeSemi;
+    // Writeln('Done: ',TokenInfos[Curtoken],' ',CurtokenString);
+  Until false;
   if (ProcType in [ptOperator,ptClassOperator]) and (Parent is TPasOperator) then
     TPasOperator(Parent).CorrectName;
   Engine.FinishScope(stProcedureHeader,Element);
-  if (Parent is TPasProcedure)
+  if IsProc
   and (not TPasProcedure(Parent).IsForward)
   and (not TPasProcedure(Parent).IsExternal)
   and ((Parent.Parent is TImplementationSection)
-     or (Parent.Parent is TProcedureBody))
+     or (Parent.Parent is TProcedureBody)
+     or IsAnonymProc)
   then
     ParseProcedureBody(Parent);
-  if Parent is TPasProcedure then
+  if IsProc then
     Engine.FinishScope(stProcedure,Parent);
 end;
 
@@ -5257,6 +5349,7 @@ procedure TPasParser.ParseProcBeginBlock(Parent: TProcedureBody);
 var
   BeginBlock: TPasImplBeginBlock;
   SubBlock: TPasImplElement;
+  Proc: TPasProcedure;
 begin
   BeginBlock := TPasImplBeginBlock(CreateElement(TPasImplBeginBlock, '', Parent));
   Parent.Body := BeginBlock;
@@ -5273,7 +5366,11 @@ begin
         ExpectToken(tkend);
     end;
   until false;
-  ExpectToken(tkSemicolon);
+  Proc:=Parent.Parent as TPasProcedure;
+  if Proc.GetProcTypeEnum in [ptAnonymousProcedure,ptAnonymousFunction] then
+    NextToken
+  else
+    ExpectToken(tkSemicolon);
 //  writeln('TPasParser.ParseProcBeginBlock ended ',curtokenstring);
 end;
 
@@ -5974,12 +6071,15 @@ begin
     ptDestructor     : Result:=TPasDestructor;
     ptOperator       : Result:=TPasOperator;
     ptClassOperator  : Result:=TPasClassOperator;
+    ptAnonymousProcedure: Result:=TPasAnonymousProcedure;
+    ptAnonymousFunction: Result:=TPasAnonymousFunction;
   else
     ParseExc(nParserUnknownProcedureType,SParserUnknownProcedureType,[Ord(ProcType)]);
   end;
 end;
 
-function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement; ProcType: TProcType;AVisibility : TPasMemberVisibility = VisDefault): TPasProcedure;
+function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
+  ProcType: TProcType; AVisibility: TPasMemberVisibility): TPasProcedure;
 
   function ExpectProcName: string;
 
@@ -6023,9 +6123,8 @@ var
   IsTokenBased , ok: Boolean;
 
 begin
-  If (Not (ProcType in [ptOperator,ptClassOperator])) then
-    Name:=ExpectProcName
-  else
+  case ProcType of
+  ptOperator,ptClassOperator:
     begin
     NextToken;
     IsTokenBased:=Curtoken<>tkIdentifier;
@@ -6037,14 +6136,19 @@ begin
       ParseExc(nErrUnknownOperatorType,SErrUnknownOperatorType,[CurTokenString]);
     Name:=OperatorNames[Ot];
     end;
+  ptAnonymousProcedure,ptAnonymousFunction:
+    Name:='';
+  else
+    Name:=ExpectProcName;
+  end;
   PC:=GetProcedureClass(ProcType);
-  Parent:=CheckIfOverLoaded(Parent,Name);
+  if Name<>'' then
+    Parent:=CheckIfOverLoaded(Parent,Name);
   Result:=TPasProcedure(CreateElement(PC,Name,Parent,AVisibility));
   ok:=false;
   try
-    if Not (ProcType in [ptFunction, ptClassFunction, ptOperator, ptClassOperator]) then
-      Result.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '', Result))
-    else
+    case ProcType of
+    ptFunction, ptClassFunction, ptOperator, ptClassOperator, ptAnonymousFunction:
       begin
       Result.ProcType := CreateFunctionType('', 'Result', Result, False, CurTokenPos);
       if (ProcType in [ptOperator, ptClassOperator]) then
@@ -6054,6 +6158,9 @@ begin
         TPasOperator(Result).CorrectName;
         end;
       end;
+    else
+      Result.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '', Result));
+    end;
     ParseProcedureOrFunctionHeader(Result, Result.ProcType, ProcType, False);
     Result.Hints:=Result.ProcType.Hints;
     Result.HintMessage:=Result.ProcType.HintMessage;

packages/fcl-passrc/tests/tcresolver.pas

@@ -32,7 +32,7 @@ type
   TSrcMarker = record
     Kind: TSrcMarkerKind;
     Filename: string;
-    Row: integer;
+    Row: cardinal;
     StartCol, EndCol: integer; // token start, end column
     Identifier: string;
     Next: PSrcMarker;
@@ -447,6 +447,25 @@ type
     Procedure TestProc_ImplicitCalls;
     Procedure TestProc_Absolute;
 
+    // anonymous procs
+    // ToDo: fppas2js: check "is TPasFunction", ".FuncType", "parent is TPasProcedureBody"
+    Procedure TestAnonymousProc_Assign;
+    // ToDo: does Delphi allow/require semicolon in assign?
+    Procedure TestAnonymousProc_Arg;
+    // ToDo: does Delphi allow/require semicolon in arg?
+    // ToDo: does Delphi allow calling directly?: function(i: word):word begin end(3)
+    Procedure TestAnonymousProc_EqualFail;
+    // ToDo: does Delphi allow ano proc in const?
+    Procedure TestAnonymousProc_ConstFail;
+    // ToDo: does Delphi allow assembler or calling conventions?
+    Procedure TestAnonymousProc_Assembler;
+    Procedure TestAnonymousProc_NameFail;
+    Procedure TestAnonymousProc_StatementFail;
+    Procedure TestAnonymousProc_Typecast;// ToDo
+    // ToDo: ano in with
+    // ToDo: ano in nested
+    // ToDo: ano in ano
+
     // record
     Procedure TestRecord;
     Procedure TestRecordVariant;
@@ -1411,7 +1430,7 @@ var
           DeclEl:=TPasAliasType(El).DestType;
           ResolverEngine.UnmangleSourceLineNumber(DeclEl.SourceLinenumber,LabelLine,LabelCol);
           if (aLabel^.Filename=DeclEl.SourceFilename)
-          and (aLabel^.Row=LabelLine)
+          and (integer(aLabel^.Row)=LabelLine)
           and (aLabel^.StartCol<=LabelCol)
           and (aLabel^.EndCol>=LabelCol) then
             exit; // success
@@ -1491,8 +1510,8 @@ begin
     if (Marker<>nil) then
       begin
       if Item.SourcePos.Row<>Marker^.Row then continue;
-      if (Item.SourcePos.Column<Marker^.StartCol)
-          or (Item.SourcePos.Column>Marker^.EndCol) then continue;
+      if (integer(Item.SourcePos.Column)<Marker^.StartCol)
+          or (integer(Item.SourcePos.Column)>Marker^.EndCol) then continue;
       end;
     // found
     FResolverGoodMsgs.Add(Item);
@@ -7135,6 +7154,137 @@ begin
   'begin']);
 end;
 
+procedure TTestResolver.TestAnonymousProc_Assign;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TFunc = reference to function(x: word): word;',
+  'var Func: TFunc;',
+  'procedure DoIt(a: word);',
+  'begin',
+  '  Func:=function(b:word): word',
+  '  begin',
+  '    Result:=a+b;',
+  '    exit(b);',
+  '    exit(Result);',
+  '  end;',
+  '  a:=3;',// test semicolon
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAnonymousProc_Arg;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  '  TFunc = reference to function(x: word): word;',
+  'procedure DoMore(f,g: TProc);',
+  'begin',
+  'end;',
+  'procedure DoIt(f: TFunc);',
+  'begin',
+  '  DoIt(function(b:word): word',
+  '    begin',
+  '      Result:=1+b;',
+  '    end;);',
+  '  DoMore(procedure begin end;, procedure begin end);',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAnonymousProc_EqualFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TFunc = reference to function(x: word): word;',
+  'procedure DoIt(f: TFunc);',
+  'var w: word;',
+  'begin',
+  '  if w=function(b:word): word',
+  '    begin',
+  '      Result:=1+b;',
+  '    end; then ;',
+  'end;',
+  'begin']);
+  CheckResolverException('Incompatible types: got "Procedure/Function" expected "Word"',nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestAnonymousProc_ConstFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  'const',
+  '  p: TProc = procedure begin end;',
+  'begin']);
+  CheckParserException('Identifier expected at token "procedure" in file afile.pp at line 5 column 14',nParserExpectedIdentifier);
+end;
+
+procedure TTestResolver.TestAnonymousProc_Assembler;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  'procedure DoIt(p: TProc);',
+  'begin',
+  '  p:=procedure assembler; asm end;',
+  '  p:=procedure() assembler; asm end;',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAnonymousProc_NameFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  'procedure DoIt(p: TProc);',
+  'begin',
+  '  p:=procedure Bla() begin end;',
+  'end;',
+  'begin']);
+  CheckParserException(SParserSyntaxError,nParserSyntaxError);
+end;
+
+procedure TTestResolver.TestAnonymousProc_StatementFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt;',
+  'begin',
+  '  procedure () begin end;',
+  'end;',
+  'begin']);
+  CheckParserException(SParserSyntaxError,nParserSyntaxError);
+end;
+
+procedure TTestResolver.TestAnonymousProc_Typecast;
+begin
+  exit;
+
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure(w: word);',
+  'procedure DoIt(p: TProc);',
+  'begin',
+  '  p:=TProc(procedure(b: byte) begin end);',
+  '  p:=TProc(procedure(b: byte) begin end;);',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestRecord;
 begin
   StartProgram(false);