fcl-passrc: fixed parsing generic function after type section

git-svn-id: trunk@42468 -

packages/fcl-passrc/src/pasresolver.pp

@@ -5822,6 +5822,9 @@ var
   Expr: TPasExpr;
   Value: String;
 begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.FinishGenericTemplateType ',GetObjName(El),' El.Parent=',GetObjName(El.Parent),' Constraints=',length(El.Constraints));
+  {$ENDIF}
   for i:=0 to length(El.Constraints)-1 do
     begin
     Expr:=El.Constraints[i];
@@ -15898,6 +15901,7 @@ begin
     else if AClass=TPasImplCommand then
     else if AClass=TPasAttributes then
     else if AClass=TPasGenericTemplateType then
+      AddType(TPasType(El))
     else if AClass=TPasUnresolvedUnitRef then
       RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
     else
@@ -22153,6 +22157,9 @@ begin
   else if ElClass=TPasResString then
     SetResolverIdentifier(ResolvedEl,btString,El,
                         FBaseTypes[btString],FBaseTypes[btString],[rrfReadable])
+  else if ElClass=TPasGenericTemplateType then
+    SetResolverIdentifier(ResolvedEl,btContext,El,TPasGenericTemplateType(El),
+      TPasGenericTemplateType(El),[])
   else
     RaiseNotYetImplemented(20160922163705,El);
   {$IF defined(nodejs) and defined(VerbosePasResolver)}

packages/fcl-passrc/src/pparser.pp

@@ -3630,9 +3630,17 @@ begin
         end;
       end;
     tkGeneric:
+      begin
+      NextToken;
+      if (CurToken in [tkprocedure,tkfunction]) then
+        begin
+        SetBlock(declNone);
+        UngetToken;
+        end;
       if CurBlock = declType then
         begin
-        TypeName := ExpectIdentifier;
+        CheckToken(tkIdentifier);
+        TypeName := CurTokenString;
         NamePos:=CurSourcePos;
         List:=TFPList.Create;
         try
@@ -3727,6 +3735,7 @@ begin
         begin
         ParseExcSyntaxError;
         end;
+      end;
     tkbegin:
       begin
       if Declarations is TProcedureBody then

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -14,6 +14,7 @@ type
   TTestResolveGenerics = Class(TCustomTestResolver)
   Published
     procedure TestGen_GenericFunction; // ToDo
+    procedure TestGen_ConstraintMultiClassFail;
   end;
 
 implementation
@@ -22,16 +23,37 @@ implementation
 
 procedure TTestResolveGenerics.TestGen_GenericFunction;
 begin
-  exit;
   StartProgram(false);
   Add([
   'generic function DoIt<T>(a: T): T;',
+  'var i: T;',
   'begin',
+  '  a:=i;',
   '  Result:=a;',
   'end;',
   'var w: word;',
   'begin',
-  '  w:=DoIt<word>(3);',
+  //'  w:=DoIt<word>(3);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintMultiClassFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  TBird = class end;',
+  '  TBear = class end;',
+  'generic function DoIt<T: TBird, TBear>(a: T): T;',
+  'begin',
+  '  Result:=a;',
+  'end;',
+  'var b: TBird;',
+  'begin',
+  //'  b:=DoIt<TBird>(3);',
   '']);
   ParseProgram;
 end;