fcl-passrc: made async a procedure type modifier, distinguish function result when called and when referred

git-svn-id: trunk@45505 -

packages/fcl-passrc/src/pasresolver.pp

@@ -246,6 +246,9 @@ Works:
   - visibility
   - property
   - helper method, Self as var argument
+- generics
+- array of const
+- attributes
 
 ToDo:
 - operator overload
@@ -263,10 +266,6 @@ ToDo:
   - CharSet:=[#13]
 - proc: check if forward and impl default values match
 - call array of proc without ()
-- attributes
-- type helpers
-- record/class helpers
-- array of const
 - generics, nested param lists
 - object
 - futures
@@ -1352,7 +1351,8 @@ type
     rcNoImplicitProc,    // do not call a function without params, includes rcNoImplicitProcType
     rcNoImplicitProcType, // do not call a proc type without params
     rcConstant,  // resolve a constant expression, error if not computable
-    rcType       // resolve a type expression
+    rcType,      // resolve a type expression
+    rcCall       // resolve result type of a function call
     );
   TPasResolverComputeFlags = set of TPasResolverComputeFlag;
 
@@ -1760,7 +1760,9 @@ type
     function FindUsedUnit(const aName: string; aMod: TPasModule): TPasModule;
     procedure FinishAssertCall(Proc: TResElDataBuiltInProc;
       Params: TParamsExpr); virtual;
-    function FindClassTypeAndConstructor(const aUnitName, aClassName: string;
+    function FindSystemClassType(const aUnitName, aClassName: string;
+      ErrorEl: TPasElement): TPasClassType; virtual;
+    function FindSystemClassTypeAndConstructor(const aUnitName, aClassName: string;
       out aClass: TPasClassType; out aConstructor: TPasConstructor;
       ErrorEl: TPasElement): boolean; virtual;
     procedure FindAssertExceptionConstructors(ErrorEl: TPasElement); virtual;
@@ -2187,6 +2189,8 @@ type
     // find value and type of an element
     procedure ComputeElement(El: TPasElement; out ResolvedEl: TPasResolverResult;
       Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil);
+    procedure ComputeResultElement(El: TPasResultElement; out ResolvedEl: TPasResolverResult;
+      Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil); virtual;
     function Eval(Expr: TPasExpr; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue; overload;
     function Eval(const Value: TPasResolverResult; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue; overload;
     // checking compatibilility
@@ -2293,6 +2297,7 @@ type
     function GetInlineSpecOfNameExpr(El: TPasExpr): TInlineSpecializeExpr;
     function GetUsesUnitInFilename(InFileExpr: TPasExpr): string;
     function GetPathStart(El: TPasExpr): TPasExpr;
+    function GetPathEndIdent(El: TPasExpr; AllowCall: boolean): TPasExpr;
     function GetNewInstanceExpr(El: TPasExpr): TPasExpr;
     function ParentNeedsExprResult(El: TPasExpr): boolean;
     function GetReference_ConstructorType(Ref: TResolvedReference; Expr: TPasExpr): TPasResolverResult;
@@ -4703,6 +4708,29 @@ begin
     end;
 end;
 
+function TPasResolver.GetPathEndIdent(El: TPasExpr; AllowCall: boolean
+  ): TPasExpr;
+// a -> a
+// a.b  -> b
+// a.b() -> b
+// a()() -> nil
+// a[] -> nil
+var
+  Bin: TBinaryExpr;
+begin
+  Result:=nil;
+  if AllowCall and (El is TParamsExpr) then
+    El:=TParamsExpr(El).Value;
+  while El is TBinaryExpr do
+    begin
+    Bin:=TBinaryExpr(El);
+    if Bin.OpCode=eopSubIdent then
+      El:=Bin.right;
+    end;
+  if (El is TPrimitiveExpr) and (TPrimitiveExpr(El).Kind=pekIdent) then
+    Result:=El;
+end;
+
 function TPasResolver.GetNewInstanceExpr(El: TPasExpr): TPasExpr;
 // if the expression is a constructor newinstance call,
 // return the element referring the constructor
@@ -5636,7 +5664,7 @@ begin
   if bsRangeChecks in CurrentParser.Scanner.CurrentBoolSwitches then
     begin
     Include(ModScope.Flags,pmsfRangeErrorNeeded);
-    FindRangeErrorConstructors(CurModule);
+    FindRangeErrorConstructors(nil);
     end;
 
   if (CurModuleClass=TPasProgram) then
@@ -6732,6 +6760,7 @@ var
   Args, TemplTypes: TFPList;
   Arg: TPasArgument;
   ProcTypeScope: TPasProcTypeScope;
+  C: TClass;
 begin
   if TopScope.Element=El then
     begin
@@ -6815,6 +6844,19 @@ begin
             sInvalidXModifierY,[GetElementTypeName(Proc),'external, '+ProcTypeModifiers[ptm]],Proc);
       end;
 
+    if El.IsAsync then
+      begin
+      // async procedure
+      C:=Proc.ClassType;
+      if (C<>TPasProcedure)
+          and (C<>TPasFunction)
+          and (C<>TPasClassProcedure)
+          and (C<>TPasClassFunction)
+          and (C<>TPasAnonymousProcedure)
+          and (C<>TPasAnonymousFunction) then
+        RaiseMsg(20200524105449,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'async'],Proc);
+      end;
+
     IsClassConDestructor:=(Proc.ClassType=TPasClassConstructor)
                        or (Proc.ClassType=TPasClassDestructor);
     if IsClassConDestructor then
@@ -7976,6 +8018,8 @@ var
       if not IsBaseType(ResultType,btBoolean,true) then
         RaiseXExpectedButYFound(20170923200836,'function: boolean',
           'function:'+GetTypeDescription(ResultType),PropEl.StoredAccessor);
+      if Proc.IsAsync then
+        RaiseInvalidProcTypeModifier(20200524104719,Proc.ProcType,ptmAsync,Expr);
       // check arg count
       ExpArgCnt:=0;
       if IndexVal<>nil then
@@ -8041,7 +8085,7 @@ var
     AncIndexResolved: TPasResolverResult;
   m: TVariableModifier;
   IndexVal: TResEvalValue;
-  AncIndexExpr: TPasExpr;
+  AncIndexExpr, ErrorEl: TPasExpr;
   CurClass: TPasClassType;
 begin
   CheckTopScope(TPasPropertyScope);
@@ -8135,19 +8179,20 @@ begin
     if PropEl.ReadAccessor<>nil then
       begin
       // check compatibility
+      ErrorEl:=PropEl.ReadAccessor;
       AccEl:=ResolveAccessor(PropEl.ReadAccessor);
       if (AccEl.ClassType=TPasVariable) or (AccEl.ClassType=TPasConst) then
         begin
         if (PropEl.Args.Count>0) then
-          RaiseXExpectedButYFound(20170216151823,'function',GetElementTypeName(AccEl),PropEl.ReadAccessor);
+          RaiseXExpectedButYFound(20170216151823,'function',GetElementTypeName(AccEl),ErrorEl);
         if not IsSameType(TPasVariable(AccEl).VarType,PropType,prraAlias) then
           RaiseIncompatibleType(20170216151826,nIncompatibleTypesGotExpected,
-            [],PropType,TPasVariable(AccEl).VarType,PropEl.ReadAccessor);
+            [],PropType,TPasVariable(AccEl).VarType,ErrorEl);
         if (vmClass in PropEl.VarModifiers)<>(vmClass in TPasVariable(AccEl).VarModifiers) then
           if vmClass in PropEl.VarModifiers then
-            RaiseXExpectedButYFound(20170216151828,'class var','var',PropEl.ReadAccessor)
+            RaiseXExpectedButYFound(20170216151828,'class var','var',ErrorEl)
           else
-            RaiseXExpectedButYFound(20170216151831,'var','class var',PropEl.ReadAccessor);
+            RaiseXExpectedButYFound(20170216151831,'var','class var',ErrorEl);
         end
       else if AccEl is TPasProcedure then
         begin
@@ -8156,23 +8201,26 @@ begin
         if (vmClass in PropEl.VarModifiers) then
           begin
           if Proc.ClassType<>TPasClassFunction then
-            RaiseXExpectedButYFound(20170216151834,'class function',GetElementTypeName(Proc),PropEl.ReadAccessor);
+            RaiseXExpectedButYFound(20170216151834,'class function',GetElementTypeName(Proc),ErrorEl);
           if not CheckClassAccessorStatic(Proc.IsStatic) then
             if Proc.IsStatic then
-              RaiseMsg(20170216151837,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.ReadAccessor)
+              RaiseMsg(20170216151837,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],ErrorEl)
             else
-              RaiseMsg(20170216151839,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.ReadAccessor);
+              RaiseMsg(20170216151839,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],ErrorEl);
           end
         else
           begin
           if Proc.ClassType<>TPasFunction then
-            RaiseXExpectedButYFound(20170216151842,'function',GetElementTypeName(Proc),PropEl.ReadAccessor);
+            RaiseXExpectedButYFound(20170216151842,'function',GetElementTypeName(Proc),ErrorEl);
           end;
         // check function result type
         ResultType:=TPasFunction(Proc).FuncType.ResultEl.ResultType;
         if not IsSameType(ResultType,PropType,prraAlias) then
           RaiseXExpectedButYFound(20170216151844,'function result '+GetTypeDescription(PropType,true),
-            GetTypeDescription(ResultType,true),PropEl.ReadAccessor);
+            GetTypeDescription(ResultType,true),ErrorEl);
+        if Proc.IsAsync then
+          RaiseMsg(20200526101546,nInvalidXModifierY,sInvalidXModifierY,['property getter',
+            ProcTypeModifiers[ptmAsync]],ErrorEl);
         // check args
         CheckArgs(Proc,IndexVal,IndexResolved,PropEl.ReadAccessor);
         NeedArgCnt:=PropEl.Args.Count;
@@ -8180,29 +8228,30 @@ begin
           inc(NeedArgCnt);
         if Proc.ProcType.Args.Count<>NeedArgCnt then
           RaiseMsg(20170216151847,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
-            [Proc.Name],PropEl.ReadAccessor);
+            [Proc.Name],ErrorEl);
         end
       else
-        RaiseXExpectedButYFound(20170216151850,'variable',GetElementTypeName(AccEl),PropEl.ReadAccessor);
+        RaiseXExpectedButYFound(20170216151850,'variable',GetElementTypeName(AccEl),ErrorEl);
       end;
 
     if PropEl.WriteAccessor<>nil then
       begin
       // check compatibility
+      ErrorEl:=PropEl.WriteAccessor;
       AccEl:=ResolveAccessor(PropEl.WriteAccessor);
       if (AccEl.ClassType=TPasVariable)
           or ((AccEl.ClassType=TPasConst) and (not TPasConst(AccEl).IsConst)) then
         begin
         if (PropEl.Args.Count>0) then
-          RaiseXExpectedButYFound(20170216151852,'procedure',GetElementTypeName(AccEl),PropEl.WriteAccessor);
+          RaiseXExpectedButYFound(20170216151852,'procedure',GetElementTypeName(AccEl),ErrorEl);
         if not IsSameType(TPasVariable(AccEl).VarType,PropType,prraAlias) then
           RaiseIncompatibleType(20170216151855,nIncompatibleTypesGotExpected,
-            [],PropType,TPasVariable(AccEl).VarType,PropEl.WriteAccessor);
+            [],PropType,TPasVariable(AccEl).VarType,ErrorEl);
         if (vmClass in PropEl.VarModifiers)<>(vmClass in TPasVariable(AccEl).VarModifiers) then
           if vmClass in PropEl.VarModifiers then
-            RaiseXExpectedButYFound(20170216151858,'class var','var',PropEl.WriteAccessor)
+            RaiseXExpectedButYFound(20170216151858,'class var','var',ErrorEl)
           else
-            RaiseXExpectedButYFound(20170216151900,'var','class var',PropEl.WriteAccessor);
+            RaiseXExpectedButYFound(20170216151900,'var','class var',ErrorEl);
         end
       else if AccEl is TPasProcedure then
         begin
@@ -8211,38 +8260,41 @@ begin
         if (vmClass in PropEl.VarModifiers) then
           begin
           if Proc.ClassType<>TPasClassProcedure then
-            RaiseXExpectedButYFound(20170216151903,'class procedure',GetElementTypeName(Proc),PropEl.WriteAccessor);
+            RaiseXExpectedButYFound(20170216151903,'class procedure',GetElementTypeName(Proc),ErrorEl);
           if not CheckClassAccessorStatic(Proc.IsStatic) then
             if Proc.IsStatic then
-              RaiseMsg(20170216151905,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.WriteAccessor)
+              RaiseMsg(20170216151905,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],ErrorEl)
             else
-              RaiseMsg(20170216151906,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.WriteAccessor);
+              RaiseMsg(20170216151906,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],ErrorEl);
           end
         else
           begin
           if Proc.ClassType<>TPasProcedure then
-            RaiseXExpectedButYFound(20170216151910,'procedure',GetElementTypeName(Proc),PropEl.WriteAccessor);
+            RaiseXExpectedButYFound(20170216151910,'procedure',GetElementTypeName(Proc),ErrorEl);
           end;
+        if Proc.IsAsync then
+          RaiseMsg(20200526101635,nInvalidXModifierY,sInvalidXModifierY,['property setter',
+            ProcTypeModifiers[ptmAsync]],ErrorEl);
         // check args
-        CheckArgs(Proc,IndexVal,IndexResolved,PropEl.ReadAccessor);
+        CheckArgs(Proc,IndexVal,IndexResolved,PropEl.WriteAccessor);
         // check write arg
         PropArgCount:=PropEl.Args.Count;
         if IndexVal<>nil then
           inc(PropArgCount);
         if Proc.ProcType.Args.Count<>PropArgCount+1 then
           RaiseMsg(20170216151913,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
-            [Proc.Name],PropEl.WriteAccessor);
+            [Proc.Name],ErrorEl);
         Arg:=TPasArgument(Proc.ProcType.Args[PropArgCount]);
         if not (Arg.Access in [argDefault,argConst]) then
           RaiseMsg(20170216151917,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
             [IntToStr(PropArgCount+1),AccessDescriptions[Arg.Access],
-             AccessDescriptions[argConst]],PropEl.WriteAccessor);
+             AccessDescriptions[argConst]],ErrorEl);
         if not IsSameType(Arg.ArgType,PropType,prraAlias) then
           RaiseIncompatibleType(20170216151919,nIncompatibleTypeArgNo,
-            [IntToStr(PropArgCount+1)],Arg.ArgType,PropType,PropEl.WriteAccessor);
+            [IntToStr(PropArgCount+1)],Arg.ArgType,PropType,ErrorEl);
         end
       else
-        RaiseXExpectedButYFound(20170216151921,'variable',GetElementTypeName(AccEl),PropEl.WriteAccessor);
+        RaiseXExpectedButYFound(20170216151921,'variable',GetElementTypeName(AccEl),ErrorEl);
       end
     else if (PropEl.ReadAccessor=nil) and (PropEl.VarType<>nil) then
       RaiseMsg(20180519173551,nPropertyMustHaveReadOrWrite,sPropertyMustHaveReadOrWrite,[],PropEl);
@@ -9281,6 +9333,9 @@ begin
     if CheckElTypeCompatibility(ImplResult,DeclResult,prraSimple)>cGenericExact then
       RaiseIncompatibleType(20170216151734,nResultTypeMismatchExpectedButFound,
         [],DeclResult,ImplResult,ImplProc);
+
+    if ImplProc.IsAsync<>DeclProc.IsAsync then
+      RaiseMsg(20200524111856,nXModifierMismatchY,sXModifierMismatchY,['procedure type','async'],ImplProc);
     end;
 
   // calling convention
@@ -10709,6 +10764,7 @@ begin
         begin
         BuiltInProc:=TResElDataBuiltInProc(FoundEl.CustomData);
         BuiltInProc.GetCallCompatibility(BuiltInProc,Params,true);
+        RaiseNotYetImplemented(20200525124749,FoundEl,'missing exception, Found=['+BuiltInProc.Signature+']');
         end
       else if FoundEl.CustomData is TResElDataBaseType then
         CheckTypeCast(TPasUnresolvedSymbolRef(FoundEl),Params,true)
@@ -13712,8 +13768,8 @@ begin
         RaiseConstantExprExp(20170216152637,Params);
       if Proc.ProcType is TPasFunctionType then
         // function call => return result
-        ComputeElement(TPasFunctionType(Proc.ProcType).ResultEl,ResolvedEl,
-          Flags+[rcNoImplicitProc],StartEl)
+        ComputeResultElement(TPasFunctionType(Proc.ProcType).ResultEl,ResolvedEl,
+          Flags+[rcCall],StartEl)
       else if (Proc.ClassType=TPasConstructor) then
         begin
         // constructor -> return value of type class
@@ -13738,8 +13794,8 @@ begin
           RaiseConstantExprExp(20170216152639,Params);
         if ResolvedEl.LoTypeEl is TPasFunctionType then
           // function call => return result
-          ComputeElement(TPasFunctionType(ResolvedEl.LoTypeEl).ResultEl,
-            ResolvedEl,Flags+[rcNoImplicitProc],StartEl)
+          ComputeResultElement(TPasFunctionType(ResolvedEl.LoTypeEl).ResultEl,
+            ResolvedEl,Flags+[rcCall],StartEl)
         else
           // procedure call, result is neither readable nor writable
           SetResolverTypeExpr(ResolvedEl,btProc,
@@ -14626,7 +14682,7 @@ begin
     if not (ptm in [ptmOfObject]) then
       RaiseContextXInvalidY(20171221193455,'function GetEnumerator','modifier '+ProcTypeModifiers[ptm],Loop.StartExpr);
   // check result type
-  ComputeElement(GetterFunc.FuncType.ResultEl,ResultResolved,[rcType]);
+  ComputeResultElement(GetterFunc.FuncType.ResultEl,ResultResolved,[rcCall]);
   if (ResultResolved.BaseType<>btContext) then
     RaiseContextXExpectedButYFound(20171221193749,'function GetEnumerator','result class',GetTypeDescription(ResultResolved),Loop.StartExpr);
   LoTypeEl:=ResultResolved.LoTypeEl;
@@ -14656,7 +14712,7 @@ begin
     if not (ptm in [ptmOfObject]) then
       RaiseContextXInvalidY(20171221195732,'function MoveNext','modifier '+ProcTypeModifiers[ptm],Loop.StartExpr);
   // check result type
-  ComputeElement(MoveNextFunc.FuncType.ResultEl,MoveNextResolved,[rcType]);
+  ComputeResultElement(MoveNextFunc.FuncType.ResultEl,MoveNextResolved,[rcCall]);
   if not (MoveNextResolved.BaseType in btAllBooleans) then
     RaiseContextXExpectedButYFound(20171221200337,'function MoveNext','result boolean',GetTypeDescription(MoveNextResolved),Loop.StartExpr);
 
@@ -14780,7 +14836,7 @@ begin
   aMod:=RootElement;
   ModScope:=aMod.CustomData as TPasModuleScope;
   if not (pmsfAssertSearched in ModScope.Flags) then
-    FindAssertExceptionConstructors(Params);
+    FindAssertExceptionConstructors(nil); // no ErrorEl
   if ModScope.AssertClass=nil then exit;
   if length(Params.Params)>1 then
     aConstructor:=ModScope.AssertMsgConstructor
@@ -14790,36 +14846,72 @@ begin
   CreateReference(aConstructor,Params,rraRead);
 end;
 
-function TPasResolver.FindClassTypeAndConstructor(const aUnitName,
-  aClassName: string; out aClass: TPasClassType; out
-  aConstructor: TPasConstructor; ErrorEl: TPasElement): boolean;
+function TPasResolver.FindSystemClassType(const aUnitName, aClassName: string;
+  ErrorEl: TPasElement): TPasClassType;
 var
   aMod, UtilsMod: TPasModule;
   SectionScope: TPasSectionScope;
   Identifier: TPasIdentifier;
   El: TPasElement;
-  ClassScope: TPasClassScope;
 begin
-  Result:=false;
-  aClass:=nil;
-  aConstructor:=nil;
+  Result:=nil;
 
   // find unit in uses clauses
   aMod:=RootElement;
   UtilsMod:=FindUsedUnit(aUnitName,aMod);
-  if UtilsMod=nil then exit;
+  if UtilsMod=nil then
+    if ErrorEl<>nil then
+      RaiseIdentifierNotFound(20200523224738,'unit '+aUnitName,ErrorEl)
+    else
+      exit;
 
   // find class in interface
-  if UtilsMod.InterfaceSection=nil then exit;
+  if UtilsMod.InterfaceSection=nil then
+    if ErrorEl<>nil then
+      RaiseIdentifierNotFound(20200523224831,aUnitName+'.'+aClassName,ErrorEl)
+    else
+      exit;
   SectionScope:=NoNil(UtilsMod.InterfaceSection.CustomData) as TPasSectionScope;
   Identifier:=SectionScope.FindLocalIdentifier(aClassName);
-  if Identifier=nil then exit;
+  if Identifier=nil then
+    if ErrorEl<>nil then
+      RaiseIdentifierNotFound(20200523224841,aUnitName+'.'+aClassName,ErrorEl)
+    else
+      exit;
   El:=Identifier.Element;
   if not (El is TPasClassType) then
-    RaiseXExpectedButYFound(20180119172517,'class '+aClassName,GetElementTypeName(El),ErrorEl);
-  if TPasClassType(El).ObjKind<>okClass then
-    RaiseXExpectedButYFound(20180321163200,'class '+aClassName,GetElementTypeName(El),ErrorEl);
-  aClass:=TPasClassType(El);
+    if ErrorEl<>nil then
+      RaiseXExpectedButYFound(20180119172517,'class '+aClassName,GetElementTypeName(El),ErrorEl)
+    else
+      exit;
+  Result:=TPasClassType(El);
+
+  if Result.IsForward then
+    if ErrorEl<>nil then
+      RaiseXExpectedButYFound(20200523225546,'class '+aClassName,'forward '+GetTypeDescription(Result,true),ErrorEl)
+    else
+      exit;
+
+  if Result.ObjKind<>okClass then
+    if ErrorEl<>nil then
+      RaiseXExpectedButYFound(20180321163200,'class '+aClassName,GetTypeDescription(Result,true),ErrorEl)
+    else
+      exit;
+end;
+
+function TPasResolver.FindSystemClassTypeAndConstructor(const aUnitName,
+  aClassName: string; out aClass: TPasClassType; out
+  aConstructor: TPasConstructor; ErrorEl: TPasElement): boolean;
+var
+  Identifier: TPasIdentifier;
+  ClassScope: TPasClassScope;
+begin
+  Result:=false;
+  aClass:=nil;
+  aConstructor:=nil;
+
+  aClass:=FindSystemClassType(aUnitName,aClassName,ErrorEl);
+  if aClass=nil then exit;
 
   ClassScope:=NoNil(aClass.CustomData) as TPasClassScope;
   repeat
@@ -14837,6 +14929,9 @@ begin
     ClassScope:=ClassScope.AncestorScope;
   until ClassScope=nil;
   aConstructor:=nil;
+
+  if ErrorEl<>nil then
+    RaiseIdentifierNotFound(20200523224856,'constructor '+aClassName,ErrorEl);
 end;
 
 procedure TPasResolver.FindAssertExceptionConstructors(ErrorEl: TPasElement);
@@ -14854,9 +14949,9 @@ begin
   ModScope:=aMod.CustomData as TPasModuleScope;
   if pmsfAssertSearched in ModScope.Flags then exit;
   Include(ModScope.Flags,pmsfAssertSearched);
-
-  FindClassTypeAndConstructor('sysutils','EAssertionFailed',aClass,aConstructor,ErrorEl);
-  if aClass=nil then exit;
+  FindSystemClassTypeAndConstructor('sysutils','EAssertionFailed',aClass,aConstructor,ErrorEl);
+  if aClass=nil then
+    exit;
   ClassScope:=NoNil(aClass.CustomData) as TPasClassScope;
   ModScope.AssertClass:=aClass;
   repeat
@@ -14902,7 +14997,7 @@ begin
   if pmsfRangeErrorSearched in ModScope.Flags then exit;
   Include(ModScope.Flags,pmsfRangeErrorSearched);
 
-  FindClassTypeAndConstructor('sysutils','ERangeError',aClass,aConstructor,ErrorEl);
+  FindSystemClassTypeAndConstructor('sysutils','ERangeError',aClass,aConstructor,ErrorEl);
   ModScope.RangeErrorClass:=aClass;
   ModScope.RangeErrorConstructor:=aConstructor;
 end;
@@ -17428,6 +17523,9 @@ var
   i: Integer;
   GenScope: TPasGenericScope;
 begin
+  if GenEl.VarArgsType<>nil then
+    RaiseNotYetImplemented(20200524214316,GenEl,'specialize varargs of type');
+
   if GenEl.GenericTemplateTypes<>nil then
     begin
     GenScope:=TPasGenericScope(PushScope(SpecEl,TPasProcTypeScope));
@@ -17450,7 +17548,7 @@ begin
   for i:=0 to SpecEl.Args.Count-1 do
     FinishArgument(TPasArgument(SpecEl.Args[i]));
 
-  // properties
+  // calling convention and proc type modifiers
   SpecEl.CallingConvention:=GenEl.CallingConvention;
   SpecEl.Modifiers:=GenEl.Modifiers;
 
@@ -18435,7 +18533,7 @@ begin
       exit(cIncompatible);
       end;
     ResultEl:=TPasFunctionType(CtxProc.ProcType).ResultEl;
-    ComputeElement(ResultEl,ResultResolved,[rcType]);
+    ComputeResultElement(ResultEl,ResultResolved,[],Expr);
     end
   else
     begin
@@ -21961,7 +22059,7 @@ function TPasResolver.PushTemplateDotScope(TemplType: TPasGenericTemplateType;
       if Result<>nil then
         RaiseNotYetImplemented(20190831005217,TemplType);
 
-      if not FindClassTypeAndConstructor('system','tobject',aClass,aConstructor,ErrorEl) then
+      if not FindSystemClassTypeAndConstructor('system','tobject',aClass,aConstructor,ErrorEl) then
         RaiseIdentifierNotFound(20190831002421,'system.TObject.Create()',ErrorEl);
       DotClassScope:=TPasDotClassScope.Create;
       Result:=DotClassScope;
@@ -23250,8 +23348,8 @@ begin
     end;
   if Proc1 is TPasFunctionType then
     begin
-    ComputeElement(TPasFunctionType(Proc1).ResultEl.ResultType,Result1Resolved,[rcType]);
-    ComputeElement(TPasFunctionType(Proc2).ResultEl.ResultType,Result2Resolved,[rcType]);
+    ComputeResultElement(TPasFunctionType(Proc1).ResultEl,Result1Resolved,[]);
+    ComputeResultElement(TPasFunctionType(Proc2).ResultEl,Result2Resolved,[]);
     if (Result1Resolved.BaseType<>Result2Resolved.BaseType)
         or not IsSameType(Result1Resolved.HiTypeEl,Result2Resolved.HiTypeEl,prraSimple) then
       begin
@@ -23260,6 +23358,8 @@ begin
           [],Result1Resolved,Result2Resolved,ErrorEl);
       exit;
       end;
+    if Proc1.IsAsync<>Proc2.IsAsync then
+      RaiseMsg(20200524112519,nXModifierMismatchY,sXModifierMismatchY,['procedure type','async'],ErrorEl);
     end;
   Result:=true;
 end;
@@ -26781,8 +26881,8 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
       // proc
       if rcNoImplicitProc in Flags then
         begin
-         if rcSetReferenceFlags in Flags then
-           Include(Ref.Flags,rrfNoImplicitCallWithoutParams);
+        if rcSetReferenceFlags in Flags then
+          Include(Ref.Flags,rrfNoImplicitCallWithoutParams);
         end
       else if [rcConstant,rcType]*Flags=[] then
         begin
@@ -26794,8 +26894,8 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
           if ResolvedEl.IdentEl is TPasFunction then
             begin
             // function => return result
-            ComputeElement(TPasFunction(ResolvedEl.IdentEl).FuncType.ResultEl,
-              ResolvedEl,Flags+[rcType],StartEl);
+            ComputeResultElement(TPasFunction(ResolvedEl.IdentEl).FuncType.ResultEl,
+              ResolvedEl,Flags+[rcCall],StartEl);
             end
           else if (ResolvedEl.IdentEl.ClassType=TPasConstructor) then
             begin
@@ -26808,7 +26908,10 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
             exit;
             end;
           if rcSetReferenceFlags in Flags then
+            begin
+            Exclude(Ref.Flags,rrfNoImplicitCallWithoutParams);
             Include(Ref.Flags,rrfImplicitCallWithoutParams);
+            end;
           Include(ResolvedEl.Flags,rrfCanBeStatement);
           end;
         end;
@@ -26818,8 +26921,8 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
       // proc type
       if [rcNoImplicitProc,rcNoImplicitProcType]*Flags<>[] then
         begin
-         if rcSetReferenceFlags in Flags then
-           Include(Ref.Flags,rrfNoImplicitCallWithoutParams);
+        if rcSetReferenceFlags in Flags then
+          Include(Ref.Flags,rrfNoImplicitCallWithoutParams);
         end
       else if [rcConstant,rcType]*Flags=[] then
         begin
@@ -26830,15 +26933,18 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
           // parameter less proc type -> implicit call possible
           if ResolvedEl.LoTypeEl is TPasFunctionType then
             // function => return result
-            ComputeElement(TPasFunctionType(ResolvedEl.LoTypeEl).ResultEl,
-              ResolvedEl,Flags+[rcType],StartEl)
+            ComputeResultElement(TPasFunctionType(ResolvedEl.LoTypeEl).ResultEl,
+              ResolvedEl,Flags+[rcCall],StartEl)
           else if ParentNeedsExprResult(Expr) then
             begin
             // a procedure has no result
             exit;
             end;
           if rcSetReferenceFlags in Flags then
+            begin
+            Exclude(Ref.Flags,rrfNoImplicitCallWithoutParams);
             Include(Ref.Flags,rrfImplicitCallWithoutParams);
+            end;
           Include(ResolvedEl.Flags,rrfCanBeStatement);
           end;
         end;
@@ -26867,8 +26973,8 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
     if Proc is TPasFunction then
       begin
       // function => return result
-      ComputeElement(TPasFunction(Proc).FuncType.ResultEl,
-        ResolvedEl,Flags+[rcType],StartEl);
+      ComputeResultElement(TPasFunction(Proc).FuncType.ResultEl,
+        ResolvedEl,Flags+[rcCall],StartEl);
       Exclude(ResolvedEl.Flags,rrfWritable);
       end
     else if (Proc.ClassType=TPasConstructor)
@@ -26883,7 +26989,10 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
       exit;
       end;
     if rcSetReferenceFlags in Flags then
+      begin
+      Exclude(Ref.Flags,rrfNoImplicitCallWithoutParams);
       Include(Ref.Flags,rrfImplicitCallWithoutParams);
+      end;
     Include(ResolvedEl.Flags,rrfCanBeStatement);
   end;
 
@@ -27230,9 +27339,7 @@ begin
     begin
     if rcConstant in Flags then
       RaiseConstantExprExp(20170216152746,StartEl);
-    ComputeElement(TPasResultElement(El).ResultType,ResolvedEl,Flags+[rcType],StartEl);
-    ResolvedEl.IdentEl:=El;
-    ResolvedEl.Flags:=[rrfReadable,rrfWritable];
+    ComputeResultElement(TPasResultElement(El),ResolvedEl,Flags,StartEl);
     end
   else if ElClass=TPasUsesUnit then
     begin
@@ -27304,6 +27411,17 @@ begin
   {$ENDIF}
 end;
 
+procedure TPasResolver.ComputeResultElement(El: TPasResultElement; out
+  ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
+  StartEl: TPasElement);
+begin
+  if El.ResultType=nil then
+    RaiseNotYetImplemented(20200524214458,El);
+  ComputeElement(El.ResultType,ResolvedEl,Flags+[rcType,rcNoImplicitProc],StartEl);
+  ResolvedEl.IdentEl:=El;
+  ResolvedEl.Flags:=[rrfReadable,rrfWritable];
+end;
+
 function TPasResolver.Eval(Expr: TPasExpr; Flags: TResEvalFlags;
   Store: boolean): TResEvalValue;
 // Important: Caller must free result with ReleaseEvalValue(Result)

packages/fcl-passrc/src/pastree.pp

@@ -119,7 +119,8 @@ type
                         ccHardFloat,ccSysV_ABI_Default,ccSysV_ABI_CDecl,
                         ccMS_ABI_Default,ccMS_ABI_CDecl,
                         ccVectorCall);
-  TProcTypeModifier = (ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,ptmReferenceTo);
+  TProcTypeModifier = (ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,
+                       ptmReferenceTo,ptmAsync);
   TProcTypeModifiers = set of TProcTypeModifier;
   TPackMode = (pmNone,pmPacked,pmBitPacked);
 
@@ -832,9 +833,11 @@ type
 
   TPasProcedureType = class(TPasGenericType)
   private
+    function GetIsAsync: Boolean; inline;
     function GetIsNested: Boolean; inline;
     function GetIsOfObject: Boolean; inline;
     function GetIsReference: Boolean; inline;
+    procedure SetIsAsync(const AValue: Boolean);
     procedure SetIsNested(const AValue: Boolean);
     procedure SetIsOfObject(const AValue: Boolean);
     procedure SetIsReference(AValue: Boolean);
@@ -856,10 +859,11 @@ type
     property IsOfObject: Boolean read GetIsOfObject write SetIsOfObject;
     property IsNested : Boolean read GetIsNested write SetIsNested;
     property IsReferenceTo : Boolean Read GetIsReference write SetIsReference;
+    property IsAsync: Boolean read GetIsAsync write SetIsAsync;
   end;
   TPasProcedureTypeClass = class of TPasProcedureType;
 
-  { TPasResultElement }
+  { TPasResultElement - parent is TPasFunctionType }
 
   TPasResultElement = class(TPasElement)
   public
@@ -1049,7 +1053,7 @@ type
                         pmExport, pmOverload, pmMessage, pmReintroduce,
                         pmInline, pmAssembler, pmPublic,
                         pmCompilerProc, pmExternal, pmForward, pmDispId,
-                        pmNoReturn, pmFar, pmFinal, pmAsync);
+                        pmNoReturn, pmFar, pmFinal);
   TProcedureModifiers = Set of TProcedureModifier;
   TProcedureMessageType = (pmtNone,pmtInteger,pmtString);
 
@@ -1541,7 +1545,9 @@ type
   TPasImplCaseElse = class(TPasImplBlock)
   end;
 
-  { TPasImplForLoop }
+  { TPasImplForLoop
+    - for VariableName in StartExpr do Body
+    - for VariableName := StartExpr to EndExpr do Body }
 
   TLoopType = (ltNormal,ltDown,ltIn);
   TPasImplForLoop = class(TPasImplStatement)
@@ -1741,14 +1747,14 @@ const
                         'MS_ABI_Default','MS_ABI_CDecl',
                         'VectorCall');
   ProcTypeModifiers : Array[TProcTypeModifier] of string =
-      ('of Object', 'is nested','static','varargs','reference to');
+      ('of Object', 'is nested','static','varargs','reference to','async');
 
   ModifierNames : Array[TProcedureModifier] of string
                 = ('virtual', 'dynamic','abstract', 'override',
                    'export', 'overload', 'message', 'reintroduce',
                    'inline','assembler','public',
                    'compilerproc','external','forward','dispid',
-                   'noreturn','far','final','async');
+                   'noreturn','far','final');
 
   VariableModifierNames : Array[TVariableModifier] of string
      = ('cvar', 'external', 'public', 'export', 'class', 'static');
@@ -1759,6 +1765,8 @@ procedure ReleaseElementList(ElList: TFPList{$IFDEF CheckPasTreeRefCount}; const
 function GenericTemplateTypesAsString(List: TFPList): string;
 procedure ReleaseProcNameParts(var NameParts: TProcedureNameParts);
 
+function dbgs(const s: TProcTypeModifiers): string; overload;
+
 {$IFDEF HasPTDumpStack}
 procedure PTDumpStack;
 function GetPTDumpStack: string;
@@ -1860,6 +1868,19 @@ begin
   NameParts:=nil;
 end;
 
+function dbgs(const s: TProcTypeModifiers): string;
+var
+  m: TProcTypeModifier;
+begin
+  Result:='';
+  for m in s do
+    begin
+    if Result<>'' then Result:=Result+',';
+    Result:=Result+ProcTypeModifiers[m];
+    end;
+  Result:='['+Result+']';
+end;
+
 Function IndentStrings(S : TStrings; indent : Integer) : string;
 Var
   I,CurrLen,CurrPos : Integer;
@@ -3460,21 +3481,38 @@ end;
 
 { TPasProcedureType }
 
+// inline
+function TPasProcedureType.GetIsAsync: Boolean;
+begin
+  Result:=ptmAsync in Modifiers;
+end;
+
+// inline
 function TPasProcedureType.GetIsNested: Boolean;
 begin
   Result:=ptmIsNested in Modifiers;
 end;
 
+// inline
 function TPasProcedureType.GetIsOfObject: Boolean;
 begin
   Result:=ptmOfObject in Modifiers;
 end;
 
+// inline
 function TPasProcedureType.GetIsReference: Boolean;
 begin
   Result:=ptmReferenceTo in Modifiers;
 end;
 
+procedure TPasProcedureType.SetIsAsync(const AValue: Boolean);
+begin
+  if AValue then
+    Include(Modifiers,ptmAsync)
+  else
+    Exclude(Modifiers,ptmAsync);
+end;
+
 procedure TPasProcedureType.SetIsNested(const AValue: Boolean);
 begin
   if AValue then
@@ -4800,7 +4838,7 @@ end;
 
 function TPasProcedure.IsAsync: Boolean;
 begin
-  Result:=pmAsync in FModifiers;
+  Result:=ProcType.IsAsync;
 end;
 
 function TPasProcedure.GetProcTypeEnum: TProcType;

packages/fcl-passrc/src/pparser.pp

@@ -1365,9 +1365,7 @@ begin
       end
     else if Parent is TPasRecordType then
       begin
-      if PM=pmAsync then
-        exit(po_AsyncProcs in Options)
-      else if not (PM in [pmOverload,
+      if not (PM in [pmOverload,
                      pmInline, pmAssembler,
                      pmExternal,
                      pmNoReturn, pmFar, pmFinal]) then exit(false);
@@ -1384,7 +1382,6 @@ begin
   if not Result then exit;
   case PM of
   pmAssembler: Result:=true;
-  pmAsync: Result:=po_AsyncProcs in Options;
   else
     Result:=false;
   end;
@@ -1404,6 +1401,11 @@ begin
     Result:=true;
     PTM:=ptmStatic;
     end
+  else if (CompareText(S,ProcTypeModifiers[ptmAsync])=0) and (po_AsyncProcs in Options) then
+    begin
+    Result:=true;
+    PTM:=ptmAsync;
+    end
   else
    Result:=false;
   if Parent=nil then;