fcl-passrc: check objfpc generic procedure has templates

git-svn-id: trunk@43053 -

packages/fcl-passrc/src/pparser.pp

@@ -458,7 +458,8 @@ type
     procedure ParseProcAsmBlock(Parent: TProcedureBody);
     // Function/Procedure declaration
     function ParseProcedureOrFunctionDecl(Parent: TPasElement;
-      ProcType: TProcType; MustBeGeneric: boolean; AVisibility: TPasMemberVisibility = VisDefault): TPasProcedure;
+      ProcType: TProcType; MustBeGeneric: boolean;
+      AVisibility: TPasMemberVisibility = VisDefault): TPasProcedure;
     procedure ParseArgList(Parent: TPasElement;
       Args: TFPList; // list of TPasArgument
       EndToken: TToken);
@@ -3441,7 +3442,7 @@ var
   ExpEl: TPasExportSymbol;
   PropEl : TPasProperty;
   PT : TProcType;
-  ok: Boolean;
+  ok, MustBeGeneric: Boolean;
   Proc: TPasProcedure;
   Attr: TPasAttributes;
   CurEl: TPasElement;
@@ -3524,23 +3525,25 @@ begin
       SetBlock(declProperty);
     tkProcedure, tkFunction, tkConstructor, tkDestructor, tkOperator:
       begin
+      MustBeGeneric:=(not (msDelphi in CurrentModeswitches)) and (GetPrevToken=tkgeneric);
       SetBlock(declNone);
       SaveComments;
       pt:=GetProcTypeFromToken(CurToken);
-      AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt, false));
+      AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt, MustBeGeneric));
       end;
     tkClass:
       begin
-        SetBlock(declNone);
-        SaveComments;
-        NextToken;
-        If CurToken in [tkprocedure,tkFunction,tkConstructor,tkDestructor] then
-          begin
-          pt:=GetProcTypeFromToken(CurToken,True);
-          AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt, false));
-          end
-        else
-          CheckToken(tkprocedure);
+      MustBeGeneric:=(not (msDelphi in CurrentModeswitches)) and (GetPrevToken=tkgeneric);
+      SetBlock(declNone);
+      SaveComments;
+      NextToken;
+      If CurToken in [tkprocedure,tkFunction,tkConstructor,tkDestructor] then
+        begin
+        pt:=GetProcTypeFromToken(CurToken,True);
+        AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt, MustBeGeneric));
+        end
+      else
+        CheckToken(tkprocedure);
       end;
     tkIdentifier:
       begin
@@ -3657,6 +3660,8 @@ begin
       NextToken;
       if (CurToken in [tkprocedure,tkfunction]) then
         begin
+        if msDelphi in CurrentModeswitches then
+          ParseExcSyntaxError; // inconsistency, tkGeneric should be in Scanner.NonTokens
         SetBlock(declNone);
         UngetToken;
         end;
@@ -6441,6 +6446,8 @@ var
       else
         break;
     until false;
+    if (NameParts=nil) and MustBeGeneric then
+      CheckToken(tkLessThan);
     UngetToken;
   end;
 

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -122,8 +122,9 @@ type
     procedure TestGenProc_Function;
     procedure TestGenProc_FunctionDelphi;
     procedure TestGenProc_OverloadDuplicate;
+    procedure TestGenProc_MissingTemplatesFail;
     procedure TestGenProc_Forward;
-    //procedure TestGenProc_External;
+    procedure TestGenProc_External;
     //procedure TestGenProc_UnitIntf;
     procedure TestGenProc_BackRef1Fail;
     procedure TestGenProc_BackRef2Fail;
@@ -1749,12 +1750,24 @@ begin
   CheckResolverException('Duplicate identifier "Fly" at afile.pp(2,25)',nDuplicateIdentifier);
 end;
 
+procedure TTestResolveGenerics.TestGenProc_MissingTemplatesFail;
+begin
+  StartProgram(false);
+  Add([
+  'generic procedure Run;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckParserException('Expected "<"',nParserExpectTokenError);
+end;
+
 procedure TTestResolveGenerics.TestGenProc_Forward;
 begin
   StartProgram(false);
   Add([
   'generic procedure Fly<T>(a: T); forward;',
-  'generic procedure Run;',
+  'procedure Run;',
   'begin',
   '  specialize Fly<word>(3);',
   'end;',
@@ -1769,6 +1782,21 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGenProc_External;
+begin
+  StartProgram(false);
+  Add([
+  'generic function Fly<T>(a: T): T; external name ''flap'';',
+  'procedure Run;',
+  'begin',
+  '  specialize Fly<word>(3);',
+  'end;',
+  'begin',
+  '  specialize Fly<boolean>(true);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGenProc_BackRef1Fail;
 begin
   StartProgram(false);