Pārlūkot izejas kodu

fcl-passrc: implicit function specialization: array of t

git-svn-id: trunk@43160 -
Mattias Gaertner 5 gadi atpakaļ
vecāks
revīzija
1b5cb03778

+ 256 - 183
packages/fcl-passrc/src/pasresolver.pp

@@ -1535,7 +1535,7 @@ type
       PFindCallElData = ^TFindCallElData;
 
       TFindProcKind = (
-        fpkSameSignature, // search method declaration for a body
+        fpkProcDeclaration, // search declaration for a body
         fpkProc,   // check overloads for a proc
         fpkMethod  // check overloads for a method
         );
@@ -1561,6 +1561,8 @@ type
       FindCallElData: Pointer; var Abort: boolean); virtual; // find candidates for Name(params)
     procedure OnFindProc(El: TPasElement; ElScope, StartScope: TPasScope;
       FindProcData: Pointer; var Abort: boolean); virtual;
+    procedure OnFindProcDeclaration(El: TPasElement; ElScope, StartScope: TPasScope;
+      FindProcData: Pointer; var Abort: boolean); virtual;
     function IsSameProcContext(ProcParentA, ProcParentB: TPasElement): boolean;
     function FindProcSameSignature(const ProcName: string; Proc: TPasProcedure;
       Scope: TPasIdentifierScope; OnlyLocal: boolean): TPasProcedure;
@@ -2206,11 +2208,12 @@ type
     function CheckClassIsClass(SrcType, DestType: TPasType): integer; virtual;
     function CheckClassesAreRelated(TypeA, TypeB: TPasType): integer;
     function GetClassImplementsIntf(ClassEl, Intf: TPasClassType): TPasClassType;
-    function CheckOverloadProcCompatibility(Proc1, Proc2: TPasProcedure): boolean;
+    function CheckProcOverloadCompatibility(Proc1, Proc2: TPasProcedure): boolean;
     function CheckProcTypeCompatibility(Proc1, Proc2: TPasProcedureType;
       IsAssign: boolean; ErrorEl: TPasElement; RaiseOnIncompatible: boolean): boolean;
-    function CheckProcArgCompatibility(Arg1, Arg2: TPasArgument): boolean;
-    function CheckElTypeCompatibility(Arg1, Arg2: TPasType; ResolveAlias: TPRResolveAlias): boolean;
+    function CheckProcArgCompatibility(Arg1, Arg2: TPasArgument): integer;
+    function CheckElTypeCompatibility(Arg1, Arg2: TPasType;
+      ResolveAlias: TPRResolveAlias): integer;
     function CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
       ErrorOnFalse: boolean; ErrorEl: TPasElement): boolean;
     function CheckAssignCompatibility(const LHS, RHS: TPasElement;
@@ -5106,7 +5109,7 @@ var
   Store, SameScope: Boolean;
   ProcScope: TPasProcedureScope;
 
-  procedure CountProcInSameModule;
+  procedure CountProcInSameScope;
   begin
     inc(Data^.FoundInSameScope);
     if Proc.IsOverload then
@@ -5135,28 +5138,28 @@ begin
         exit; // no hint
       end;
     case Data^.Kind of
-      fpkProc:
-        // proc hides a non proc
-        if (Data^.Proc.GetModule=El.GetModule) then
-          // forbidden within same module
-          RaiseMsg(20170216151649,nDuplicateIdentifier,sDuplicateIdentifier,
-            [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType)
-        else
+    fpkProc:
+      // proc hides a non proc
+      if (Data^.Proc.GetModule=El.GetModule) then
+        // forbidden within same module
+        RaiseMsg(20170216151649,nDuplicateIdentifier,sDuplicateIdentifier,
+          [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType)
+      else
+        begin
+        // give a hint
+        if Data^.Proc.Parent is TPasMembersType then
           begin
-          // give a hint
-          if Data^.Proc.Parent is TPasMembersType then
-            begin
-            if El.Visibility=visStrictPrivate then
-            else if (El.Visibility=visPrivate) and (El.GetModule<>Data^.Proc.GetModule) then
-            else
-              LogMsg(20171118205344,mtHint,nFunctionHidesIdentifier_NonProc,sFunctionHidesIdentifier,
-                [GetElementSourcePosStr(El)],Data^.Proc.ProcType);
-            end;
+          if El.Visibility=visStrictPrivate then
+          else if (El.Visibility=visPrivate) and (El.GetModule<>Data^.Proc.GetModule) then
+          else
+            LogMsg(20171118205344,mtHint,nFunctionHidesIdentifier_NonProc,sFunctionHidesIdentifier,
+              [GetElementSourcePosStr(El)],Data^.Proc.ProcType);
           end;
-      fpkMethod:
-        // method hides a non proc
-        RaiseMsg(20171118232543,nDuplicateIdentifier,sDuplicateIdentifier,
-          [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType);
+        end;
+    fpkMethod:
+      // method hides a non proc
+      RaiseMsg(20171118232543,nDuplicateIdentifier,sDuplicateIdentifier,
+        [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType);
     end;
     exit;
     end;
@@ -5166,112 +5169,112 @@ begin
   if El=Data^.Proc then
     begin
     // found itself -> this is normal when searching for overloads
-    CountProcInSameModule;
+    CountProcInSameScope;
     exit;
     end;
 
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.OnFindProc ',GetTreeDbg(El,2));
   {$ENDIF}
-  Store:=CheckOverloadProcCompatibility(Data^.Proc,Proc);
-  if Data^.Kind=fpkSameSignature then
-    // finding a proc with same signature is enough, see above Data^.OnlyScope
+  Store:=CheckProcOverloadCompatibility(Data^.Proc,Proc);
+  case Data^.Kind of
+  fpkProc:
+    SameScope:=Data^.Proc.GetModule=Proc.GetModule;
+  fpkMethod:
+    SameScope:=Data^.Proc.Parent=Proc.Parent;
   else
+    // use OnFindProcDeclaration instead
+    RaiseNotYetImplemented(20191010123525,Data^.Proc);
+  end;
+  if SameScope then
     begin
-    if Data^.Kind=fpkProc then
-      SameScope:=Data^.Proc.GetModule=Proc.GetModule
+    // same scope
+    if (msObjfpc in CurrentParser.CurrentModeswitches) then
+      begin
+        if ProcHasGroupOverload(Data^.Proc) then
+          Include(TPasProcedureScope(Proc.CustomData).Flags,ppsfIsGroupOverload)
+        else if ProcHasGroupOverload(Proc) then
+          Include(TPasProcedureScope(Data^.Proc.CustomData).Flags,ppsfIsGroupOverload);
+      end;
+    if Store then
+      begin
+      // same scope, same signature
+      // Note: forward declaration was already handled in FinishProcedureHeader
+      RaiseMsg(20171118221821,nDuplicateIdentifier,sDuplicateIdentifier,
+                [Proc.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
+      end
     else
-      SameScope:=Data^.Proc.Parent=Proc.Parent;
-    if SameScope then
       begin
-      // same scope
-      if (msObjfpc in CurrentParser.CurrentModeswitches) then
-        begin
-          if ProcHasGroupOverload(Data^.Proc) then
-            Include(TPasProcedureScope(Proc.CustomData).Flags,ppsfIsGroupOverload)
-          else if ProcHasGroupOverload(Proc) then
-            Include(TPasProcedureScope(Data^.Proc.CustomData).Flags,ppsfIsGroupOverload);
-        end;
-      if Store then
+      // same scope, different signature
+      if (msDelphi in CurrentParser.CurrentModeswitches) then
         begin
-        // same scope, same signature
-        // Note: forward declaration was already handled in FinishProcedureHeader
-        RaiseMsg(20171118221821,nDuplicateIdentifier,sDuplicateIdentifier,
-                  [Proc.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
+        // Delphi does not allow different procs without 'overload' in a scope
+        if not Proc.IsOverload then
+          RaiseMsg(20171118222112,nPreviousDeclMissesOverload,sPreviousDeclMissesOverload,
+            [Proc.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType)
+        else if not Data^.Proc.IsOverload then
+          RaiseMsg(20171118222147,nOverloadedProcMissesOverload,sOverloadedProcMissesOverload,
+            [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
         end
       else
         begin
-        // same scope, different signature
-        if (msDelphi in CurrentParser.CurrentModeswitches) then
-          begin
-          // Delphi does not allow different procs without 'overload' in a scope
-          if not Proc.IsOverload then
-            RaiseMsg(20171118222112,nPreviousDeclMissesOverload,sPreviousDeclMissesOverload,
-              [Proc.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType)
-          else if not Data^.Proc.IsOverload then
-            RaiseMsg(20171118222147,nOverloadedProcMissesOverload,sOverloadedProcMissesOverload,
-              [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
-          end
-        else
-          begin
-          // ObjFPC allows different procs without 'overload' modifier
-          end;
-        CountProcInSameModule;
+        // ObjFPC allows different procs without 'overload' modifier
         end;
-      end
+      CountProcInSameScope;
+      end;
+    end
+  else
+    begin
+    // different scopes
+    if Data^.Proc.IsOverride then
+    else if Data^.Proc.IsReintroduced then
     else
       begin
-      // different scopes
-      if Data^.Proc.IsOverride then
-      else if Data^.Proc.IsReintroduced then
-      else
+      if Store
+          or ((Data^.FoundInSameScope=1) // missing 'overload' hints only for the first proc in a scope
+             and not ProcHasGroupOverload(Data^.Proc)) then
         begin
-        if Store
-            or ((Data^.FoundInSameScope=1) // missing 'overload' hints only for the first proc in a scope
-               and not ProcHasGroupOverload(Data^.Proc)) then
+        if (Data^.Kind=fpkMethod) and (Proc.IsVirtual or Proc.IsOverride) then
+          // give a hint, that method hides a virtual method in ancestor
+          LogMsg(20170216151712,mtWarning,nMethodHidesMethodOfBaseType,
+            sMethodHidesMethodOfBaseType,
+            [Data^.Proc.Name,Proc.Parent.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType)
+        else
           begin
-          if (Data^.Kind=fpkMethod) and (Proc.IsVirtual or Proc.IsOverride) then
-            // give a hint, that method hides a virtual method in ancestor
-            LogMsg(20170216151712,mtWarning,nMethodHidesMethodOfBaseType,
-              sMethodHidesMethodOfBaseType,
-              [Data^.Proc.Name,Proc.Parent.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType)
-          else
+          // Delphi/FPC do not give a message when hiding a non virtual method
+          // -> emit Hint with other message id
+          if (Data^.Proc.Parent is TPasMembersType) then
             begin
-            // Delphi/FPC do not give a message when hiding a non virtual method
-            // -> emit Hint with other message id
-            if (Data^.Proc.Parent is TPasMembersType) then
+            ProcScope:=Proc.CustomData as TPasProcedureScope;
+            if (Proc.Visibility=visStrictPrivate)
+                or ((Proc.Visibility=visPrivate)
+                  and (Proc.GetModule<>Data^.Proc.GetModule)) then
+              // a private private is hidden by definition -> no hint
+            else if (ProcScope.ImplProc<>nil)  // not abstract, external
+                and (not ProcHasImplElements(ProcScope.ImplProc)) then
+              // hidden method has implementation, but no statements -> useless
+              // -> do not give a hint for hiding this useless method
+              // Note: if this happens in the same unit, the body was not yet parsed
+            else if (Proc is TPasConstructor)
+                and (Data^.Proc.ClassType=Proc.ClassType) then
+              // do not give a hint for hiding a constructor
+            else if Store then
               begin
-              ProcScope:=Proc.CustomData as TPasProcedureScope;
-              if (Proc.Visibility=visStrictPrivate)
-                  or ((Proc.Visibility=visPrivate)
-                    and (Proc.GetModule<>Data^.Proc.GetModule)) then
-                // a private private is hidden by definition -> no hint
-              else if (ProcScope.ImplProc<>nil)  // not abstract, external
-                  and (not ProcHasImplElements(ProcScope.ImplProc)) then
-                // hidden method has implementation, but no statements -> useless
-                // -> do not give a hint for hiding this useless method
-                // Note: if this happens in the same unit, the body was not yet parsed
-              else if (Proc is TPasConstructor)
-                  and (Data^.Proc.ClassType=Proc.ClassType) then
-                // do not give a hint for hiding a constructor
-              else if Store then
-                begin
-                // method hides ancestor method with same signature
-                LogMsg(20190316152656,mtHint,
-                  nMethodHidesNonVirtualMethodExactly,sMethodHidesNonVirtualMethodExactly,
-                  [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
-                end
-              else
-                begin
-                //writeln('TPasResolver.OnFindProc Proc=',Proc.PathName,' Data^.Proc=',Data^.Proc.PathName,' ',Proc.Visibility);
-                LogMsg(20171118214523,mtHint,
-                  nFunctionHidesIdentifier_NonVirtualMethod,sFunctionHidesIdentifier,
-                  [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
-                end;
+              // method hides ancestor method with same signature
+              LogMsg(20190316152656,mtHint,
+                nMethodHidesNonVirtualMethodExactly,sMethodHidesNonVirtualMethodExactly,
+                [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
+              end
+            else
+              begin
+              //writeln('TPasResolver.OnFindProc Proc=',Proc.PathName,' Data^.Proc=',Data^.Proc.PathName,' ',Proc.Visibility);
+              LogMsg(20171118214523,mtHint,
+                nFunctionHidesIdentifier_NonVirtualMethod,sFunctionHidesIdentifier,
+                [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
               end;
             end;
-          Abort:=true;
           end;
+        Abort:=true;
         end;
       end;
     end;
@@ -5285,6 +5288,42 @@ begin
     end;
 end;
 
+procedure TPasResolver.OnFindProcDeclaration(El: TPasElement; ElScope,
+  StartScope: TPasScope; FindProcData: Pointer; var Abort: boolean);
+var
+  Data: PFindProcData absolute FindProcData;
+  Proc: TPasProcedure;
+  Store: Boolean;
+begin
+  //writeln('TPasResolver.OnFindProcDeclaration START ',El.Name,':',GetElementTypeName(El),' itself=',El=Data^.Proc);
+  if not (El is TPasProcedure) then
+    begin
+    // identifier is not a proc
+    Data^.FoundNonProc:=El;
+    Abort:=true;
+    exit;
+    end;
+  if El=Data^.Proc then
+    // found itself -> this is normal when searching for overloads
+    exit;
+
+  // identifier is a proc
+  Proc:=TPasProcedure(El);
+
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.OnFindProcDeclaration ',GetTreeDbg(El,2));
+  {$ENDIF}
+  Store:=CheckProcOverloadCompatibility(Data^.Proc,Proc);
+
+  if Store then
+    begin
+    Data^.Found:=Proc;
+    Data^.ElScope:=ElScope;
+    Data^.StartScope:=StartScope;
+    Abort:=true;
+    end;
+end;
+
 function TPasResolver.IsSameProcContext(ProcParentA, ProcParentB: TPasElement
   ): boolean;
 begin
@@ -5314,13 +5353,13 @@ begin
   FindData:=Default(TFindProcData);
   FindData.Proc:=Proc;
   FindData.Args:=Proc.ProcType.Args;
-  FindData.Kind:=fpkSameSignature;
+  FindData.Kind:=fpkProcDeclaration;
   Abort:=false;
   //writeln('TPasResolver.FindProcSameSignature ',ProcName,' OnlyLocal=',OnlyLocal);
   if OnlyLocal then
-    Scope.IterateLocalElements(ProcName,Scope,@OnFindProc,@FindData,Abort)
+    Scope.IterateLocalElements(ProcName,Scope,@OnFindProcDeclaration,@FindData,Abort)
   else
-    Scope.IterateElements(ProcName,Scope,@OnFindProc,@FindData,Abort);
+    Scope.IterateElements(ProcName,Scope,@OnFindProcDeclaration,@FindData,Abort);
   Result:=FindData.Found;
 end;
 
@@ -6180,9 +6219,9 @@ begin
             FindData:=Default(TFindProcData);
             FindData.Proc:=IntfProc;
             FindData.Args:=IntfProc.ProcType.Args;
-            FindData.Kind:=fpkSameSignature;
+            FindData.Kind:=fpkProcDeclaration;
             Abort:=false;
-            IterateElements(ProcName,@OnFindProc,@FindData,Abort);
+            IterateElements(ProcName,@OnFindProcDeclaration,@FindData,Abort);
             if FindData.Found=nil then
               RaiseMsg(20180322143202,nNoMatchingImplForIntfMethodXFound,
                 sNoMatchingImplForIntfMethodXFound,
@@ -7177,7 +7216,7 @@ begin
     else
       DeclProc:=FindProcSameSignature(ProcName,ImplProc,ClassOrRecScope,false);
     if DeclProc=nil then
-      RaiseIdentifierNotFound(20170216151720,ImplProc.Name,ImplProc.ProcType);
+      RaiseIdentifierNotFound(20170216151720,GetProcName(ImplProc),ImplProc.ProcType);
     DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
     ImplProc.ProcType.IsOfObject:=DeclProc.ProcType.IsOfObject;
 
@@ -9197,7 +9236,7 @@ begin
     ImplResult:=TPasFunctionType(ImplProc.ProcType).ResultEl.ResultType;
     DeclResult:=TPasFunctionType(DeclProc.ProcType).ResultEl.ResultType;
 
-    if not CheckElTypeCompatibility(ImplResult,DeclResult,prraSimple) then
+    if CheckElTypeCompatibility(ImplResult,DeclResult,prraSimple)>cGenericExact then
       RaiseIncompatibleType(20170216151734,nResultTypeMismatchExpectedButFound,
         [],DeclResult,ImplResult,ImplProc);
     end;
@@ -10670,7 +10709,8 @@ begin
     end
   else if (GenTemplates<>nil) and (GenTemplates.Count>0) then
     begin
-    if FoundEl is TPasProcedure then
+    if (FoundEl is TPasProcedure)
+        and (msImplicitFunctionSpec in CurrentParser.CurrentModeswitches) then
       begin
       // GenericProc()  -> create template types by inference
       InferenceParams:=CreateInferenceTypesForCall(Params,TPasProcedure(FoundEl));
@@ -11811,7 +11851,8 @@ begin
             begin
             ComputeElement(ForwConstraint,ForwConstraintResolved,[rcType]);
             ComputeElement(ActConstraint,ActConstraintResolved,[rcType]);
-            if not CheckElTypeCompatibility(ForwConstraintResolved.LoTypeEl,ActConstraintResolved.LoTypeEl,prraNone) then
+            if CheckElTypeCompatibility(ForwConstraintResolved.LoTypeEl,
+                ActConstraintResolved.LoTypeEl,prraNone)<>cExact then
               RaiseMsg(20190814121509,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
                 [GetTypeDescription(ActGenTempl),
                 GetElementSourcePosStr(GetGenericConstraintErrorEl(ForwConstraint,ForwGenTempl))],
@@ -15434,16 +15475,18 @@ type
       [ArgType.Name,TargetProc.Name],ErrorPos);
   end;
 
-  procedure Infer(ParamType, ArgType: TPasType; NeedVar, IsSubType: boolean;
-    InferenceParams: TInferredTypes; TemplTypes: TFPList; IsDelphi: boolean;
+  procedure Infer(ArgParent: TPasElement; ArgType, ParamLoType, ParamHiType: TPasType;
+    NeedVar, IsSubType, IsDelphi: boolean;
+    InferenceParams: TInferredTypes; TemplTypes: TFPList;
     ErrorPos: TPasElement);
   var
     C: TClass;
     i: Integer;
-    OldInferType: TPasType;
+    OldInferType, ParamElType: TPasType;
     ResolveAlias: TPRResolveAlias;
+    Arr: TPasArrayType;
   begin
-    if (ArgType=nil) or (ParamType=nil) then exit;
+    if (ArgType=nil) or (ParamLoType=nil) then exit;
     C:=ArgType.ClassType;
     if C=TPasGenericTemplateType then
       begin
@@ -15455,26 +15498,24 @@ type
         if OldInferType=nil then
           begin
           // template type inferred first time
-          InferenceParams[i].InferType:=ParamType;
+          InferenceParams[i].InferType:=ParamHiType;
           InferenceParams[i].IsVarOut:=NeedVar;
-          ParamType.AddRef{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
+          ParamHiType.AddRef{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
           exit;
           end;
 
-        // already inferred -> check if it fits
-        if IsDelphi then
+        // already inferred -> check compatibility
+        ResolveAlias:=prraAlias;
+        if IsDelphi and (NeedVar or InferenceParams[i].IsVarOut) then
           // Delphi allows passing alias, but not type alias to a var arg
-          ResolveAlias:=prraSimple
-        else
-          // ObjFPC allows passing type alias to a var arg
-          ResolveAlias:=prraAlias;
-        if IsSameType(OldInferType,ParamType,ResolveAlias) then
-          exit; // fits exactly
+          ResolveAlias:=prraSimple;
+        if IsSameType(OldInferType,ParamHiType,ResolveAlias) then
+          exit; // same types -> ok
 
-        // does not fit exactly
         if IsSubType then
           begin
-          if CheckElTypeCompatibility(OldInferType,InferenceParams[i].InferType,ResolveAlias) then
+          if CheckElTypeCompatibility(OldInferType,InferenceParams[i].InferType,
+              ResolveAlias)<=cGenericExact then
             exit;
           // e.g. "array of TA" and "array of TB"
           RaiseInferTypeMismatch(20191006215539,ArgType,ErrorPos);
@@ -15487,21 +15528,21 @@ type
           if InferenceParams[i].IsVarOut then
             // two var/out arguments mismatch
             RaiseInferTypeMismatch(20191006220355,ArgType,ErrorPos);
-          if CheckAssignCompatibility(ParamType,OldInferType,
+          if CheckAssignCompatibility(ParamHiType,OldInferType,
               false,ErrorPos)=cIncompatible then
             // second is var/out, and do not match
             RaiseInferTypeMismatch(20191006220402,ArgType,ErrorPos);
           // first can be widened to fit
           InferenceParams[i].InferType.Release{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
-          InferenceParams[i].InferType:=ParamType;
+          InferenceParams[i].InferType:=ParamHiType;
           InferenceParams[i].IsVarOut:=NeedVar;
-          ParamType.AddRef{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
+          ParamHiType.AddRef{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
           exit;
           end
         else if InferenceParams[i].IsVarOut then
           begin
           // first was var/out
-          if CheckAssignCompatibility(OldInferType,ParamType,
+          if CheckAssignCompatibility(OldInferType,ParamHiType,
               false,ErrorPos)=cIncompatible then
             // first was var/out, and do not match
             RaiseInferTypeMismatch(20191006220750,ArgType,ErrorPos);
@@ -15512,6 +15553,18 @@ type
         // ToDo
         RaiseInferTypeMismatch(20191006220406,ArgType,ErrorPos);
         end;
+      end
+    else if ArgParent<>ArgType.Parent then
+      // ArgType is a reference
+    else if C=TPasArrayType then
+      begin
+      // e.g. Proc(a: array...)
+      Arr:=TPasArrayType(ArgType);
+      if ParamLoType.ClassType<>TPasArrayType then
+        exit;
+      ParamElType:=TPasArrayType(ParamLoType).ElType;
+      Infer(Arr,Arr.ElType,ParamElType,ResolveAliasType(ParamElType),
+            NeedVar,true,IsDelphi,InferenceParams,TemplTypes,ErrorPos);
       end;
   end;
 
@@ -15547,12 +15600,18 @@ type
     {$ENDIF}
 
     if ExprResolved.BaseType in btAllWithSubType then
-      // ToDo
+      begin
+      // passing a literal set or array or custom range
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.CreateInferenceTypesForCall.InferParam ToDo: ',GetResolverResultDbg(ExprResolved));
+      {$ENDIF}
+      end
     else if (ExprResolved.SubType<>btNone) then
       RaiseNotYetImplemented(20191006203622,Expr)
     else
-      Infer(ExprResolved.HiTypeEl,ArgType,NeedVar,false,
-            InferenceParams,TemplTypes,IsDelphi,Expr);
+      Infer(Arg,ArgType,ExprResolved.LoTypeEl,ExprResolved.HiTypeEl,
+            NeedVar,false,IsDelphi,
+            InferenceParams,TemplTypes,Expr);
   end;
 
 var
@@ -15706,7 +15765,7 @@ begin
     while j>=0 do
       begin
       if not IsSameType(Item.Params[j],ParamsResolved[j],prraNone)
-          and not CheckElTypeCompatibility(Item.Params[j],ParamsResolved[j],prraNone) then
+          and (CheckElTypeCompatibility(Item.Params[j],ParamsResolved[j],prraNone)>cExact) then
         break;
       dec(j);
       end;
@@ -22713,13 +22772,12 @@ begin
   Result:=cIncompatible;
 end;
 
-function TPasResolver.CheckOverloadProcCompatibility(Proc1, Proc2: TPasProcedure
-  ): boolean;
+function TPasResolver.CheckProcOverloadCompatibility(Proc1, Proc2: TPasProcedure): boolean;
 // returns if number and type of arguments fit
 // does not check calling convention
 var
   ProcArgs1, ProcArgs2, TemplTypes1, TemplTypes2: TFPList;
-  i: Integer;
+  i, Comp: Integer;
 begin
   Result:=false;
 
@@ -22741,7 +22799,7 @@ begin
   ProcArgs1:=Proc1.ProcType.Args;
   ProcArgs2:=Proc2.ProcType.Args;
   {$IFDEF VerbosePasResolver}
-  writeln('TPasResolver.CheckOverloadProcCompatibility START Count=',ProcArgs1.Count,' ',ProcArgs2.Count);
+  writeln('TPasResolver.CheckProcOverloadCompatibility START Count=',ProcArgs1.Count,' ',ProcArgs2.Count);
   {$ENDIF}
   // check args
   if ProcArgs1.Count<>ProcArgs2.Count then
@@ -22749,10 +22807,10 @@ begin
   for i:=0 to ProcArgs1.Count-1 do
     begin
     {$IFDEF VerbosePasResolver}
-    writeln('TPasResolver.CheckOverloadProcCompatibility ',i,'/',ProcArgs1.Count);
+    writeln('TPasResolver.CheckProcOverloadCompatibility ',i,'/',ProcArgs1.Count);
     {$ENDIF}
-    if not CheckProcArgCompatibility(TPasArgument(ProcArgs1[i]),
-                                     TPasArgument(ProcArgs2[i])) then
+    Comp:=CheckProcArgCompatibility(TPasArgument(ProcArgs1[i]),TPasArgument(ProcArgs2[i]));
+    if Comp>cExact then
       exit;
     end;
   Result:=true;
@@ -22846,7 +22904,7 @@ begin
     {$ENDIF}
     ExpectedArg:=TPasArgument(ProcArgs1[i]);
     ActualArg:=TPasArgument(ProcArgs2[i]);
-    if not CheckProcArgCompatibility(ExpectedArg,ActualArg) then
+    if CheckProcArgCompatibility(ExpectedArg,ActualArg)>cGenericExact then
       begin
       if RaiseOnIncompatible then
         begin
@@ -22877,72 +22935,85 @@ begin
   Result:=true;
 end;
 
-function TPasResolver.CheckProcArgCompatibility(Arg1, Arg2: TPasArgument): boolean;
+function TPasResolver.CheckProcArgCompatibility(Arg1, Arg2: TPasArgument
+  ): integer;
 begin
-  Result:=false;
-
   // check access: var, const, ...
-  if Arg1.Access<>Arg2.Access then exit;
-
-  // check untyped
-  if Arg1.ArgType=nil then
-    exit(Arg2.ArgType=nil);
-  if Arg2.ArgType=nil then exit;
+  if Arg1.Access<>Arg2.Access then exit(cIncompatible);
 
   Result:=CheckElTypeCompatibility(Arg1.ArgType,Arg2.ArgType,prraSimple);
 end;
 
 function TPasResolver.CheckElTypeCompatibility(Arg1, Arg2: TPasType;
-  ResolveAlias: TPRResolveAlias): boolean;
+  ResolveAlias: TPRResolveAlias): integer;
 var
   Arg1Resolved, Arg2Resolved: TPasResolverResult;
   C: TClass;
   Arr1, Arr2: TPasArrayType;
+  TemplType1, TemplType2: TPasGenericTemplateType;
 begin
-  if Arg1=Arg2 then exit(true);
+  if Arg1=Arg2 then exit(cExact);
   ComputeElement(Arg1,Arg1Resolved,[rcType]);
   ComputeElement(Arg2,Arg2Resolved,[rcType]);
   {$IFDEF VerbosePasResolver}
-  //writeln('TPasResolver.CheckElTypeCompatibility Arg1=',GetResolverResultDbg(Arg1Resolved),' Arg2=',GetResolverResultDbg(Arg2Resolved));
+  writeln('TPasResolver.CheckElTypeCompatibility Arg1=',GetResolverResultDbg(Arg1Resolved),' Arg2=',GetResolverResultDbg(Arg2Resolved));
   {$ENDIF}
 
+  if IsGenericTemplType(Arg1Resolved) then
+    begin
+    if Arg1Resolved.LoTypeEl=Arg2Resolved.LoTypeEl then
+      exit(cExact)
+    else if IsGenericTemplType(Arg2Resolved) then
+      begin
+      TemplType1:=TPasGenericTemplateType(Arg1Resolved.LoTypeEl);
+      TemplType2:=TPasGenericTemplateType(Arg2Resolved.LoTypeEl);
+      if SameText(TemplType1.Name,TemplType2.Name)
+          and (TemplType1.Parent is TPasProcedure)
+          and (TemplType2.Parent is TPasProcedure) then
+        exit(cExact)
+      else
+        exit(cGenericExact);
+      end
+    else
+      exit(cGenericExact);
+    end
+  else if IsGenericTemplType(Arg2Resolved) then
+    exit(cGenericExact);
+
   if (Arg1Resolved.BaseType<>Arg2Resolved.BaseType)
       or (Arg1Resolved.LoTypeEl=nil)
       or (Arg2Resolved.LoTypeEl=nil) then
-    exit(false);
-  if Arg1Resolved.BaseType<>Arg2Resolved.BaseType then
-    exit(false);
+    exit(cIncompatible);
+
   if ResolveAlias=prraSimple then
     begin
     if IsSameType(Arg1Resolved.HiTypeEl,Arg2Resolved.HiTypeEl,prraSimple) then
-      exit(true);
+      exit(cExact);
     end
   else
     begin
     if IsSameType(Arg1Resolved.LoTypeEl,Arg2Resolved.LoTypeEl,prraNone) then
-      exit(true);
+      exit(cExact);
     end;
   if Arg1Resolved.BaseType=btContext then
     begin
     C:=Arg1Resolved.LoTypeEl.ClassType;
     if C<>Arg2Resolved.LoTypeEl.ClassType then
-      exit(false);
+      exit(cIncompatible);
     if C=TPasArrayType then
       begin
       Arr1:=TPasArrayType(Arg1Resolved.LoTypeEl);
       Arr2:=TPasArrayType(Arg2Resolved.LoTypeEl);
       if length(Arr1.Ranges)<>length(Arr2.Ranges) then
-        exit(false);
+        exit(cIncompatible);
       if length(Arr1.Ranges)>0 then
         RaiseNotYetImplemented(20170328093733,Arr1.Ranges[0],'anonymous static array');
       Result:=CheckElTypeCompatibility(GetArrayElType(Arr1),GetArrayElType(Arr2),ResolveAlias);
       exit;
-      end
-    else if C=TPasGenericTemplateType then
-      exit(true);
+      end;
     end;
 
-  Result:=false;
+  Result:=cIncompatible;
 end;
 
 function TPasResolver.CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
@@ -24859,8 +24930,7 @@ begin
         if Result<>cIncompatible then exit;
         end;
       end;
-    if (ParamResolved.BaseType=btContext)
-        and (ParamResolved.LoTypeEl.ClassType=TPasGenericTemplateType) then
+    if IsGenericTemplType(ParamResolved) then
       exit(cGenericExact);
 
     //writeln('TPasResolver.CheckParamCompatibility NeedVar ParamResolved=',GetResolverResultDbg(ParamResolved),' ExprResolved=',GetResolverResultDbg(ExprResolved));
@@ -25082,17 +25152,20 @@ begin
       else if RArray.ElType=nil then
         // ArrayOfNonConst:=ArrayOfConst
         exit(RaiseIncompatType(20190215112907))
-      else if CheckElTypeCompatibility(LArray.ElType,RArray.ElType,prraAlias) then
-        Result:=cExact
-      else if RaiseOnIncompatible then
-        begin
-        GetIncompatibleTypeDesc(LArray.ElType,RArray.ElType,GotDesc,ExpDesc);
-        RaiseMsg(20170328110050,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
-          ['array of '+GotDesc,
-           'array of '+ExpDesc],ErrorEl)
-        end
       else
-        exit(cIncompatible);
+        begin
+        Result:=CheckElTypeCompatibility(LArray.ElType,RArray.ElType,prraAlias);
+        if Result=cIncompatible then
+          if RaiseOnIncompatible then
+            begin
+            GetIncompatibleTypeDesc(LArray.ElType,RArray.ElType,GotDesc,ExpDesc);
+            RaiseMsg(20170328110050,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+              ['array of '+GotDesc,
+               'array of '+ExpDesc],ErrorEl)
+            end
+          else
+            exit(cIncompatible);
+        end;
       end;
     end
   else if LTypeEl.ClassType=TPasRecordType then

+ 1 - 1
packages/fcl-passrc/src/pastree.pp

@@ -645,7 +645,7 @@ type
     IndexRange : string; // only valid if Parser po_arrayrangeexpr disabled
     Ranges: TPasExprArray; // only valid if Parser po_arrayrangeexpr enabled
     PackMode : TPackMode;
-    ElType: TPasType;
+    ElType: TPasType; // nil means array-of-const
     function IsGenericArray : Boolean;
     function IsPacked : Boolean;
     procedure AddRange(Range: TPasExpr);

+ 6 - 4
packages/fcl-passrc/src/pscanner.pp

@@ -298,7 +298,8 @@ type
     msExternalClass,       { Allow external class definitions }
     msPrefixedAttributes,  { Allow attributes, disable proc modifier [] }
     msOmitRTTI,            { treat class section 'published' as 'public' and typeinfo does not work on symbols declared with this switch }
-    msMultiHelpers         { off=only one helper per type, on=all }
+    msMultiHelpers,        { off=only one helper per type, on=all }
+    msImplicitFunctionSpec { implicit function specialization }
     );
   TModeSwitches = Set of TModeSwitch;
 
@@ -1001,7 +1002,7 @@ const
     'Tab'
   );
 
-  SModeSwitchNames : array[TModeSwitch] of string{$ifdef fpc}[20]{$endif} =
+  SModeSwitchNames : array[TModeSwitch] of string =
   ( '', // msNone
     '', // Fpc,
     '', // Objfpc,
@@ -1051,7 +1052,8 @@ const
     'EXTERNALCLASS',
     'PREFIXEDATTRIBUTES',
     'OMITRTTI',
-    'MULTIHELPERS'
+    'MULTIHELPERS',
+    'IMPLICITFUNCTIONSPECIALIZATION'
     );
 
   LetterSwitchNames: array['A'..'Z'] of string=(
@@ -1140,7 +1142,7 @@ const
      msPointer2Procedure,msAutoDeref,msTPProcVar,msInitFinal,msDefaultAnsistring,
      msOut,msDefaultPara,msDuplicateNames,msHintDirective,
      msProperty,msDefaultInline,msExcept,msAdvancedRecords,msTypeHelpers,
-     msPrefixedAttributes,msArrayOperators
+     msPrefixedAttributes,msArrayOperators,msImplicitFunctionSpec
      ];
 
   DelphiUnicodeModeSwitches = delphimodeswitches + [msSystemCodePage,msDefaultUnicodestring];

+ 26 - 6
packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -141,13 +141,14 @@ type
     procedure TestGenProc_TypeParamWithDefaultParamDelphiFail;
     procedure TestGenProc_Inference_NeedExplicitFail;
     procedure TestGenProc_Inference_Overload;
+    // ToDo procedure TestGenProc_Inference_OverloadForward;
     procedure TestGenProc_Inference_Var_Overload;
     //procedure TestGenProc_Inference_Widen;
     procedure TestGenProc_Inference_DefaultValue;
     procedure TestGenProc_Inference_DefaultValueMismatch;
-    procedure TestGenProc_Inference_ProcT;
+    procedure TestGenProc_Inference_ProcT; // ToDo
     procedure TestGenProc_Inference_Mismatch;
-    // ToDo procedure TestGenProc_Inference_ArrayOfT;
+    procedure TestGenProc_Inference_ArrayOfT;
     // ToDo procedure TestGenProc_Inference_ProcType;
 
     // generic methods
@@ -1963,8 +1964,8 @@ begin
   'end;',
   'begin',
   '']);
-  CheckResolverException('Declaration of "Fly<B>" differs from previous declaration at afile.pp(2,23)',
-    nDeclOfXDiffersFromPrevAtY);
+  CheckResolverException('Forward function not resolved "Fly"',
+    nForwardProcNotResolved);
 end;
 
 procedure TTestResolveGenerics.TestGenProc_ForwardOverload;
@@ -2129,6 +2130,7 @@ begin
   StartProgram(false);
   Add([
   '{$mode objfpc}',
+  '{$modeswitch implicitfunctionspecialization}',
   'generic procedure {#A}Run<S>(a: S = 2; b: S = 10); overload;',
   'begin',
   'end;',
@@ -2145,6 +2147,7 @@ begin
   StartProgram(false);
   Add([
   '{$mode objfpc}',
+  '{$modeswitch implicitfunctionspecialization}',
   'generic procedure {#A}Run<S>(a: S; b: S = 10); overload;',
   'begin',
   'end;',
@@ -2194,6 +2197,23 @@ begin
     nInferredTypeXFromDiffArgsMismatchFromMethodY);
 end;
 
+procedure TTestResolveGenerics.TestGenProc_Inference_ArrayOfT;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'procedure Run<T>(a: array of T);',
+  'var b: T;',
+  'begin',
+  '  b:=3;',
+  'end;',
+  'var Arr: array of byte;',
+  'begin',
+  '  Run(Arr);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGenMethod_VirtualFail;
 begin
   StartProgram(false);
@@ -2250,8 +2270,8 @@ begin
   'end;',
   'begin',
   '']);
-  CheckResolverException('Declaration of "TObject.Run<S>" differs from previous declaration at afile.pp(4,28)',
-    nDeclOfXDiffersFromPrevAtY);
+  CheckResolverException('identifier not found "TObject.Run<S>"',
+    nIdentifierNotFound);
 end;
 
 procedure TTestResolveGenerics.TestGenMethod_ImplConstraintFail;

+ 3 - 1
packages/pastojs/src/pas2jsfiler.pp

@@ -172,7 +172,8 @@ const
     'ExternalClass',
     'PrefixedAttributes',
     'OmitRTTI',
-    'MultiHelpers'
+    'MultiHelpers',
+    'ImplicitFunctionSpecialization'
     ); // Dont forget to update ModeSwitchToInt !
 
   PCUDefaultBoolSwitches: TBoolSwitches = [
@@ -1424,6 +1425,7 @@ begin
     // msIgnoreAttributes: Result:=47;
     msOmitRTTI: Result:=48;
     msMultiHelpers: Result:=49;
+    msImplicitFunctionSpec: Result:=50;
   end;
 end;