fcl-passrc: resolver: fixed call generic function with anonymous specialize function type

packages/fcl-passrc/src/pasresolver.pp

@@ -24180,8 +24180,8 @@ function TPasResolver.CheckProcTypeCompatibility(Proc1,
 var
   ProcArgs1, ProcArgs2: TFPList;
   i: Integer;
-  Result1Resolved, Result2Resolved: TPasResolverResult;
   ExpectedArg, ActualArg: TPasArgument;
+  ResultType1, ResultType2: TPasType;
 begin
   Result:=false;
   if Proc1.ClassType<>Proc2.ClassType then
@@ -24276,16 +24276,16 @@ begin
     end;
   if Proc1 is TPasFunctionType then
     begin
-    ComputeResultElement(TPasFunctionType(Proc1).ResultEl,Result1Resolved,[]);
-    ComputeResultElement(TPasFunctionType(Proc2).ResultEl,Result2Resolved,[]);
-    if (Result1Resolved.BaseType<>Result2Resolved.BaseType)
-        or not IsSameType(Result1Resolved.HiTypeEl,Result2Resolved.HiTypeEl,prraSimple) then
+    ResultType1:=TPasFunctionType(Proc1).ResultEl.ResultType;
+    ResultType2:=TPasFunctionType(Proc2).ResultEl.ResultType;
+    if CheckElTypeCompatibility(ResultType1,ResultType2,prraSimple)>cGenericExact then
       begin
       if RaiseOnIncompatible then
-        RaiseIncompatibleTypeRes(20170402112648,nResultTypeMismatchExpectedButFound,
-          [],Result1Resolved,Result2Resolved,ErrorEl);
+        RaiseIncompatibleType(20170402112648,nResultTypeMismatchExpectedButFound,
+          [],ResultType1,ResultType2,ErrorEl);
       exit;
       end;
+
     if Proc1.IsAsync<>Proc2.IsAsync then
       RaiseMsg(20200524112519,nXModifierMismatchY,sXModifierMismatchY,['procedure type','async'],ErrorEl);
     end;
@@ -24719,6 +24719,7 @@ begin
   Result:=-1;
 
   Handled:=false;
+  // let descendant check first
   Result:=CheckAssignCompatibilityCustom(LHS,RHS,ErrorEl,RaiseOnIncompatible,Handled);
   if Handled and (Result>=cExact) and (Result<cIncompatible) then
     exit;

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -158,6 +158,7 @@ type
     procedure TestGenProc_TypeParamWithDefaultParamDelphiFail;
     procedure TestGenProc_ParamSpecWithT;
     procedure TestGenProc_ParamSpecWithTNestedType;
+    procedure TestGenProc_ProcType_Anonymous;
     // ToDo: NestedResultAssign
 
     // generic function infer types
@@ -173,7 +174,8 @@ type
     procedure TestGenProc_Infer_ArrayOfT;
     procedure TestGenProc_Infer_PassAsArgDelphi;
     procedure TestGenProc_Infer_PassAsArgObjFPC;
-    // ToDo procedure TestGenProc_Infer_ProcType;
+    procedure TestGenProc_Infer_ProcType; // ToDo
+    // ToDo procedure TestGenProc_Infer_TArray;
 
     // generic methods
     procedure TestGenMethod_VirtualFail;
@@ -2581,6 +2583,32 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGenProc_ProcType_Anonymous;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$ModeSwitch implicitfunctionspecialization}',
+  'type generic TFunc<T> = function(Arg: T): T;',
+  'generic function Fly<T>(aFunc: specialize TFunc<T>; Ant: T): T;',
+  'begin',
+  '  Result:=aFunc(Ant);',
+  'end;',
+  'function Jump(Arg: word): word;',
+  'begin',
+  'end;',
+  'procedure Test;',
+  'var StrFunc: specialize TFunc<string>;',
+  'begin',
+  '  specialize Fly<string>(StrFunc,''foo'');',
+  '  specialize Fly<word>(@Jump,3);',
+  'end;',
+  'begin',
+  '  specialize Fly<word>(@Jump,5);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGenProc_Infer_NeedExplicitFail;
 begin
   StartProgram(false);
@@ -2813,6 +2841,32 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGenProc_Infer_ProcType;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$ModeSwitch implicitfunctionspecialization}',
+  'type generic TFunc<T> = function(Arg: T): T;',
+  'function Jump(w: word): word;',
+  'begin',
+  'end;',
+  'generic function Fly<T>(aFunc: specialize TFunc<T>; Ant: T): T;',
+  'begin',
+  '  Result:=aFunc(Ant);',
+  'end;',
+  'procedure Test;',
+  'var StrFunc: specialize TFunc<string>;',
+  'begin',
+//  '  Fly(StrFunc,''foo'');',
+//  '  Fly(@Jump,4);',
+  'end;',
+  'begin',
+//  '  Fly(@Jump,6);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGenMethod_VirtualFail;
 begin
   StartProgram(false);