fcl-passrc: parser: position of generic function is in front of type params

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@43056 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 159 insertions, 6 deletions

diff --git a/packages/fcl-passrc/tests/tcresolvegenerics.pas b/packages/fcl-passrc/tests/tcresolvegenerics.pas
index ad8538b923..eb8343be9c 100644
--- a/packages/fcl-passrc/tests/tcresolvegenerics.pas
+++ b/packages/fcl-passrc/tests/tcresolvegenerics.pas
@@ -125,17 +125,21 @@ type
     procedure TestGenProc_MissingTemplatesFail;
     procedure TestGenProc_Forward;
     procedure TestGenProc_External;
-    //procedure TestGenProc_UnitIntf;
+    procedure TestGenProc_UnitIntf;
     procedure TestGenProc_BackRef1Fail;
     procedure TestGenProc_BackRef2Fail;
     procedure TestGenProc_BackRef3Fail;
     //procedure TestGenProc_Inference;
-    // ToDo: forward parametrized impl must not repeat constraints
-    // ToDo: forward parametrized impl overloads
-    // ToDo: parametrized nested proc fail
+    procedure TestGenProc_CallSelf;
+    procedure TestGenProc_ForwardConstraints;
+    procedure TestGenProc_ForwardConstraintsRepeatFail;
+    procedure TestGenProc_ForwardTempNameMismatch;
+    procedure TestGenProc_ForwardOverload;
+    procedure TestGenProc_NestedFail;
+    procedure TestGenMethod_VirtualFail;
     // ToDo: virtual method cannot have type parameters
     // ToDo: message method cannot have type parameters
-    // ToDo: interface method cannot have type parameters
+    // ToDo: class interface method cannot have type parameters
     // ToDo: parametrized method mismatch interface method
     // ToDo: generic class method overload <T> <S,T>
     // ToDo: generic class method overload <T>(bool) <T>(word)
@@ -1747,7 +1751,7 @@ begin
   'end;',
   'begin',
   '']);
-  CheckResolverException('Duplicate identifier "Fly" at afile.pp(2,25)',nDuplicateIdentifier);
+  CheckResolverException('Duplicate identifier "Fly" at afile.pp(2,22)',nDuplicateIdentifier);
 end;
 
 procedure TTestResolveGenerics.TestGenProc_MissingTemplatesFail;
@@ -1797,6 +1801,30 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGenProc_UnitIntf;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    'generic function Fly<T>(a: T): T;',
+    '']),
+    LinesToStr([
+    'generic function Fly<T>(a: T): T;',
+    'var i: T;',
+    'begin',
+    '  i:=a;',
+    'end;',
+    '']));
+  StartProgram(true);
+  Add([
+  'uses unit2;',
+  'var w: word;',
+  'begin',
+  '  w:=specialize Fly<word>(3);',
+  '  if specialize Fly<boolean>(false) then ;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGenProc_BackRef1Fail;
 begin
   StartProgram(false);
@@ -1833,6 +1861,131 @@ begin
   CheckResolverException('Wrong number of parameters specified for call to "function Fly<>(untyped)"',nWrongNumberOfParametersForCallTo);
 end;
 
+procedure TTestResolveGenerics.TestGenProc_CallSelf;
+begin
+  StartProgram(false);
+  Add([
+  'generic function Fly<T>(a: T): T;',
+  '  procedure Run;',
+  '  begin',
+  '    specialize Fly<T>(a);',
+  '    specialize Fly<word>(3);',
+  '  end;',
+  'begin',
+  '  specialize Fly<T>(a);',
+  '  specialize Fly<boolean>(true);',
+  'end;',
+  'begin',
+  '  specialize Fly<string>(''fast'');',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_ForwardConstraints;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  TBird = class end;',
+  'var b: TBird;',
+  'generic function Fly<T: class>(a: T): T; forward;',
+  'procedure Run;',
+  'begin',
+  '  specialize Fly<TBird>(b);',
+  'end;',
+  'generic function Fly<T>(a: T): T;',
+  'begin',
+  'end;',
+  'begin',
+  '  specialize Fly<TBird>(b);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_ForwardConstraintsRepeatFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  'generic function Fly<T: class>(a: T): T; forward;',
+  'generic function Fly<T: class>(a: T): T;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException(sImplMustNotRepeatConstraints,nImplMustNotRepeatConstraints);
+end;
+
+procedure TTestResolveGenerics.TestGenProc_ForwardTempNameMismatch;
+begin
+  StartProgram(false);
+  Add([
+  'generic function Fly<T>(a: T): T; forward;',
+  'generic function Fly<B>(a: B): B;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('Declaration of "Fly<B>" differs from previous declaration at afile.pp(2,23)',
+    nDeclOfXDiffersFromPrevAtY);
+end;
+
+procedure TTestResolveGenerics.TestGenProc_ForwardOverload;
+begin
+  StartProgram(false);
+  Add([
+  'generic function {#FlyA}Fly<T>(a: T; b: boolean): T; forward; overload;',
+  'generic function {#FlyB}Fly<T>(a: T; w: word): T; forward; overload;',
+  'procedure {#FlyC}Fly; overload;',
+  'begin',
+  '  specialize {@FlyA}Fly<longint>(1,true);',
+  '  specialize {@FlyB}Fly<string>(''ABC'',3);',
+  'end;',
+  'generic function Fly<T>(a: T; b: boolean): T;',
+  'begin',
+  'end;',
+  'generic function Fly<T>(a: T; w: word): T;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_NestedFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure Fly;',
+  '  generic procedure Run<T>(a: T);',
+  '  begin',
+  '  end;',
+  'begin',
+  '  Run<boolean>(true);',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('Type parameters not allowed on nested procedure',nTypeParamsNotAllowedOnX);
+end;
+
+procedure TTestResolveGenerics.TestGenMethod_VirtualFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure Fly;',
+  '  generic procedure Run<T>(a: T);',
+  '  begin',
+  '  end;',
+  'begin',
+  '  Run<boolean>(true);',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('Type parameters not allowed on nested procedure',nTypeParamsNotAllowedOnX);
+end;
+
 initialization
   RegisterTests([TTestResolveGenerics]);