Browse Source

fcl-passrc: changed constraints to TPasElementArray, changed TInlineSpecializeExpr to NameExpr:TPasExpr and Params:TFPList

git-svn-id: trunk@43020 -
Mattias Gaertner 5 years ago
parent
commit
4f64058a9f

+ 14 - 0
packages/fcl-passrc/src/pasresolveeval.pas

@@ -200,6 +200,8 @@ const
   nTypeParamXIsNotCompatibleWithY = 3134;
   nTypeParamXMustSupportIntfY = 3135;
   nTypeParamsNotAllowedOnX = 3136;
+  nXMethodsCannotHaveTypeParams = 3137;
+  nImplMustNotRepeatConstraints = 3138;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -347,6 +349,8 @@ resourcestring
   sTypeParamXIsNotCompatibleWithY = 'Type parameter "%s" is not compatible with type "%s"';
   sTypeParamXMustSupportIntfY = 'Type parameter "%s" must support interface "%s"';
   sTypeParamsNotAllowedOnX = 'Type parameters not allowed on %s';
+  sXMethodsCannotHaveTypeParams = '%s methods cannot have type parameters';
+  sImplMustNotRepeatConstraints = 'Implementations must not repeat constraints';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }
@@ -790,6 +794,7 @@ function GetObjPath(o: TObject): string;
 function GetTypeParamCommas(Cnt: integer): string;
 function dbgs(const Flags: TResEvalFlags): string; overload;
 function dbgs(v: TResEvalValue): string; overload;
+function LastPos(c: char; const s: string): sizeint;
 
 implementation
 
@@ -1094,6 +1099,15 @@ begin
     Result:=v.AsDebugString;
 end;
 
+function LastPos(c: char; const s: string): sizeint;
+var
+  i: SizeInt;
+begin
+  for i:=length(s) downto 1 do
+    if s[i]=c then exit(i);
+  Result:=-1;
+end;
+
 { TResEvalExternal }
 
 constructor TResEvalExternal.Create;

File diff suppressed because it is too large
+ 381 - 178
packages/fcl-passrc/src/pasresolver.pp


+ 33 - 19
packages/fcl-passrc/src/pastree.pp

@@ -192,6 +192,7 @@ type
     class property GlobalRefCount: NativeInt read FGlobalRefCount write FGlobalRefCount;
     {$endif}
   end;
+  TPasElementArray = array of TPasElement;
 
   TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekNil, pekBoolConst,
      pekRange, pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp,
@@ -558,10 +559,10 @@ type
     function GetDeclaration(full : boolean) : string; override;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
-    procedure AddConstraint(Expr: TPasExpr);
+    procedure AddConstraint(El: TPasElement);
   Public
     TypeConstraint: String deprecated; // deprecated in fpc 3.3.1
-    Constraints: TPasExprArray;
+    Constraints: TPasElementArray; // list of TPasExpr or TPasType, can be nil!
   end;
 
   { TPasGenericType - abstract base class for all types which can be generics }
@@ -589,7 +590,6 @@ type
     function GetDeclaration(full: boolean) : string; override;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
-    procedure AddParam(El: TPasElement);
   public
     Params: TFPList; // list of TPasType or TPasExpr
   end;
@@ -605,7 +605,8 @@ type
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
   public
-    DestType: TPasSpecializeType;
+    NameExpr: TPasExpr;
+    Params: TFPList; // list of TPasType
   end;
 
   { TPasClassOfType }
@@ -1053,7 +1054,7 @@ type
     Name: string;
     Templates: TFPList; // optional list of TPasGenericTemplateType, can be nil!
   end;
-  TProcedureNameParts = TFPList;
+  TProcedureNameParts = TFPList; // list of TProcedureNamePart
                         
   TProcedureBody = class;
 
@@ -1083,7 +1084,7 @@ type
     AliasName : String;
     ProcType : TPasProcedureType;
     Body : TProcedureBody;
-    NameParts: TProcedureNameParts; // only used for generic functions
+    NameParts: TProcedureNameParts; // only used for generic aka parametrized functions
     Procedure AddModifier(AModifier : TProcedureModifier);
     Function IsVirtual : Boolean;
     Function IsDynamic : Boolean;
@@ -1744,14 +1745,13 @@ const
 procedure ReleaseAndNil(var El: TPasElement {$IFDEF CheckPasTreeRefCount}; const Id: string{$ENDIF}); overload;
 procedure ReleaseGenericTemplateTypes(var GenericTemplateTypes: TFPList{$IFDEF CheckPasTreeRefCount}; const Id: string{$ENDIF});
 function GenericTemplateTypesAsString(List: TFPList): string;
+procedure ReleaseProcNameParts(var NameParts: TProcedureNameParts);
 
 {$IFDEF HasPTDumpStack}
 procedure PTDumpStack;
 function GetPTDumpStack: string;
 {$ENDIF}
 
-procedure ReleaseProcNameParts(var NameParts: TProcedureNameParts);
-
 implementation
 
 uses SysUtils;
@@ -1944,14 +1944,13 @@ begin
     ForEachChildCall(aMethodCall,Arg,Constraints[i],false);
 end;
 
-procedure TPasGenericTemplateType.AddConstraint(Expr: TPasExpr);
+procedure TPasGenericTemplateType.AddConstraint(El: TPasElement);
 var
   l: Integer;
 begin
   l:=Length(Constraints);
   SetLength(Constraints,l+1);
-  Constraints[l]:=Expr;
-  Expr.Parent:=Self;
+  Constraints[l]:=El;
 end;
 
 {$IFDEF HasPTDumpStack}
@@ -2039,11 +2038,17 @@ constructor TInlineSpecializeExpr.Create(const AName: string;
 begin
   if AName='' then ;
   inherited Create(AParent, pekSpecialize, eopNone);
+  Params:=TFPList.Create;
 end;
 
 destructor TInlineSpecializeExpr.Destroy;
+var
+  i: Integer;
 begin
-  ReleaseAndNil(TPasElement(DestType){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF});
+  TPasElement(NameExpr).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+  for i:=0 to Params.Count-1 do
+    TPasElement(Params[i]).Release{$IFDEF CheckPasTreeRefCount}('TInlineSpecializeExpr.Params'){$ENDIF};
+  FreeAndNil(Params);
   inherited Destroy;
 end;
 
@@ -2053,15 +2058,29 @@ begin
 end;
 
 function TInlineSpecializeExpr.GetDeclaration(full: Boolean): string;
+var
+  i: Integer;
 begin
-  Result:=DestType.GetDeclaration(full);
+  Result:='specialize '+NameExpr.GetDeclaration(false)+'<';
+  for i:=0 to Params.Count-1 do
+    begin
+    if i>0 then
+      Result:=Result+',';
+    Result:=Result+TPasElement(Params[i]).GetDeclaration(false);
+    end;
+  Result:=Result+'>';
+  if full then ;
 end;
 
 procedure TInlineSpecializeExpr.ForEachCall(
   const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
+var
+  i: Integer;
 begin
   inherited ForEachCall(aMethodCall, Arg);
-  ForEachChildCall(aMethodCall,Arg,DestType,false);
+  ForEachChildCall(aMethodCall,Arg,NameExpr,false);
+  for i:=0 to Params.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Params[i]),true);
 end;
 
 { TPasSpecializeType }
@@ -2116,11 +2135,6 @@ begin
     ForEachChildCall(aMethodCall,Arg,TPasElement(Params[i]),true);
 end;
 
-procedure TPasSpecializeType.AddParam(El: TPasElement);
-begin
-  Params.Add(El);
-end;
-
 { TInterfaceSection }
 
 function TInterfaceSection.ElementTypeName: string;

+ 54 - 34
packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -265,6 +265,7 @@ type
     procedure UseExprRef(El: TPasElement; Expr: TPasExpr;
       Access: TResolvedRefAccess; UseFull: boolean); virtual;
     procedure UseInheritedExpr(El: TInheritedExpr); virtual;
+    procedure UseInlineSpecializeExpr(El: TInlineSpecializeExpr); virtual;
     procedure UseScopeReferences(Refs: TPasScopeReferences); virtual;
     procedure UseProcedure(Proc: TPasProcedure); virtual;
     procedure UseProcedureType(ProcType: TPasProcedureType); virtual;
@@ -1526,15 +1527,15 @@ procedure TPasAnalyzer.UseExpr(El: TPasExpr);
 
   procedure UseSystemExit;
   var
-    ParamsExpr: TParamsExpr;
     Params: TPasExprArray;
     SubEl: TPasElement;
     Proc: TPasProcedure;
     ProcScope: TPasProcedureScope;
+    ParentParams: TPRParentParams;
   begin
-    ParamsExpr:=Resolver.GetParamsOfNameExpr(El);
-    if ParamsExpr=nil then exit;
-    Params:=ParamsExpr.Params;
+    Resolver.GetParamsOfNameExpr(El,ParentParams);
+    if ParentParams.Params=nil then exit;
+    Params:=ParentParams.Params.Params;
     if length(Params)<1 then
       exit;
     SubEl:=El.Parent;
@@ -1551,18 +1552,50 @@ procedure TPasAnalyzer.UseExpr(El: TPasExpr);
     UseElement(SubEl,rraAssign,false);
   end;
 
+  procedure UseBuilInFuncTypeInfo;
+  var
+    ParentParams: TPRParentParams;
+    ParamResolved: TPasResolverResult;
+    SubEl: TPasElement;
+    Params: TPasExprArray;
+  begin
+    Resolver.GetParamsOfNameExpr(El,ParentParams);
+    if ParentParams.Params=nil then
+      RaiseNotSupported(20190225150136,El);
+    Params:=ParentParams.Params.Params;
+    if length(Params)<>1 then
+      RaiseNotSupported(20180226144217,El.Parent);
+    Resolver.ComputeElement(Params[0],ParamResolved,[rcNoImplicitProc]);
+    {$IFDEF VerbosePasAnalyzer}
+    writeln('TPasAnalyzer.UseExpr typeinfo ',GetResolverResultDbg(ParamResolved));
+    {$ENDIF}
+    if ParamResolved.IdentEl=nil then
+      RaiseNotSupported(20180628155107,Params[0]);
+    if (ParamResolved.IdentEl is TPasProcedure)
+        and (TPasProcedure(ParamResolved.IdentEl).ProcType is TPasFunctionType) then
+      begin
+      SubEl:=TPasFunctionType(TPasProcedure(ParamResolved.IdentEl).ProcType).ResultEl.ResultType;
+      MarkImplScopeRef(El,SubEl,psraTypeInfo);
+      UseTypeInfo(SubEl);
+      end
+    else
+      begin
+      SubEl:=ParamResolved.IdentEl;
+      MarkImplScopeRef(El,SubEl,psraTypeInfo);
+      UseTypeInfo(SubEl);
+      end;
+    // the parameter is not used otherwise
+  end;
+
 var
   Ref: TResolvedReference;
   C: TClass;
   Params: TPasExprArray;
   i: Integer;
   BuiltInProc: TResElDataBuiltInProc;
-  ParamResolved: TPasResolverResult;
   Decl: TPasElement;
   ModScope: TPasModuleScope;
   Access: TResolvedRefAccess;
-  SubEl: TPasElement;
-  ParamsExpr: TParamsExpr;
 begin
   if El=nil then exit;
   // Note: expression itself is not marked, but it can reference identifiers
@@ -1614,35 +1647,13 @@ begin
         BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
         case BuiltInProc.BuiltIn of
         bfExit:
+          begin
           UseSystemExit;
+          exit;
+          end;
         bfTypeInfo:
           begin
-          ParamsExpr:=Resolver.GetParamsOfNameExpr(El);
-          if ParamsExpr=nil then
-            RaiseNotSupported(20190225150136,El);
-          Params:=ParamsExpr.Params;
-          if length(Params)<>1 then
-            RaiseNotSupported(20180226144217,El.Parent);
-          Resolver.ComputeElement(Params[0],ParamResolved,[rcNoImplicitProc]);
-          {$IFDEF VerbosePasAnalyzer}
-          writeln('TPasAnalyzer.UseExpr typeinfo ',GetResolverResultDbg(ParamResolved));
-          {$ENDIF}
-          if ParamResolved.IdentEl=nil then
-            RaiseNotSupported(20180628155107,Params[0]);
-          if (ParamResolved.IdentEl is TPasProcedure)
-              and (TPasProcedure(ParamResolved.IdentEl).ProcType is TPasFunctionType) then
-            begin
-            SubEl:=TPasFunctionType(TPasProcedure(ParamResolved.IdentEl).ProcType).ResultEl.ResultType;
-            MarkImplScopeRef(El,SubEl,psraTypeInfo);
-            UseTypeInfo(SubEl);
-            end
-          else
-            begin
-            SubEl:=ParamResolved.IdentEl;
-            MarkImplScopeRef(El,SubEl,psraTypeInfo);
-            UseTypeInfo(SubEl);
-            end;
-          // the parameter is not used otherwise
+          UseBuilInFuncTypeInfo;
           exit;
           end;
         bfAssert:
@@ -1694,7 +1705,7 @@ begin
   else if C=TProcedureExpr then
     UseProcedure(TProcedureExpr(El).Proc)
   else if C=TInlineSpecializeExpr then
-    UseSpecializeType(TInlineSpecializeExpr(El).DestType,paumElement)
+    UseInlineSpecializeExpr(TInlineSpecializeExpr(El))
   else
     RaiseNotSupported(20170307085444,El);
 end;
@@ -1804,6 +1815,15 @@ begin
     end;
 end;
 
+procedure TPasAnalyzer.UseInlineSpecializeExpr(El: TInlineSpecializeExpr);
+var
+  i: Integer;
+begin
+  for i:=0 to El.Params.Count-1 do
+    UseType(TPasType(El.Params[i]),paumElement);
+  UseExpr(El.NameExpr);
+end;
+
 procedure TPasAnalyzer.UseScopeReferences(Refs: TPasScopeReferences);
 begin
   if Refs=nil then exit;

+ 19 - 46
packages/fcl-passrc/src/pparser.pp

@@ -320,7 +320,7 @@ type
     procedure ParseClassMembers(AType: TPasClassType);
     procedure ProcessMethod(AType: TPasClassType; IsClass : Boolean; AVisibility : TPasMemberVisibility);
     procedure ReadGenericArguments(List: TFPList; Parent: TPasElement);
-    procedure ReadSpecializeArguments(Spec: TPasSpecializeType);
+    procedure ReadSpecializeArguments(Parent: TPasElement; Params: TFPList);
     function ReadDottedIdentifier(Parent: TPasElement; out Expr: TPasExpr; NeedAsString: boolean): String;
     function CheckProcedureArgs(Parent: TPasElement;
       Args: TFPList; // list of TPasArgument
@@ -1695,8 +1695,6 @@ begin
     else
       begin
       // simple type reference
-      if not NeedExpr then
-        ReleaseAndNil(TPasElement(Expr){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF});
       Result:=ResolveTypeReference(Name,Parent);
       end;
     ok:=true;
@@ -1730,7 +1728,7 @@ begin
       GenNameExpr:=nil; // ownership transferred to ST
       end;
     // read nested specialize arguments
-    ReadSpecializeArguments(ST);
+    ReadSpecializeArguments(ST,ST.Params);
     // Important: resolve type reference AFTER args, because arg count is needed
     ST.DestType:=ResolveTypeReference(GenName,ST,ST.Params.Count);
 
@@ -2329,8 +2327,6 @@ var
   SrcPos, ScrPos: TPasSourcePos;
   ProcType: TProcType;
   ProcExpr: TProcedureExpr;
-  SpecType: TPasSpecializeType;
-
 begin
   Result:=nil;
   CanSpecialize:=aCannot;
@@ -2502,7 +2498,7 @@ begin
           // an inline specialization (e.g. A<B,C>  or  something.A<B>)
           // check expression in front is an identifier
           Expr:=Result;
-          while Expr.Kind=pekBinary do
+          if Expr.Kind=pekBinary then
             begin
             if Expr.OpCode<>eopSubIdent then
               ParseExcSyntaxError;
@@ -2511,25 +2507,14 @@ begin
           if Expr.Kind<>pekIdent then
             ParseExcSyntaxError;
 
-          // read specialized type
+          // read specialized params
           ISE:=TInlineSpecializeExpr(CreateElement(TInlineSpecializeExpr,'',AParent,SrcPos));
-          SpecType:=TPasSpecializeType(CreateElement(TPasSpecializeType,'',ISE,SrcPos));
-          ISE.DestType:=SpecType;
-          ReadSpecializeArguments(SpecType);
-          // can't resolve SpecType.DestType here
+          ReadSpecializeArguments(ISE,ISE.Params);
 
           // A<B>  or  something.A<B>
-          if Expr.Parent is TBinaryExpr then
-            begin
-            if TBinaryExpr(Expr.Parent).right<>Expr then
-              ParseExcSyntaxError;
-            TBinaryExpr(Expr.Parent).right:=ISE;
-            ISE.Parent:=Expr.Parent;
-            end;
-          SpecType.Expr:=Expr;
-          Expr.Parent:=SpecType;
-          if Expr=Result then
-            Result:=ISE;
+          ISE.NameExpr:=Result;
+          Result.Parent:=ISE;
+          Result:=ISE;
           ISE:=nil;
           CanSpecialize:=aCannot;
           NextToken;
@@ -4113,8 +4098,6 @@ Var
   T : TPasGenericTemplateType;
   Expr: TPasExpr;
   TypeEl: TPasType;
-  SrcPos: TPasSourcePos;
-  ISE: TInlineSpecializeExpr;
 begin
   ExpectToken(tkLessThan);
   repeat
@@ -4125,39 +4108,28 @@ begin
     if Curtoken = tkColon then
       repeat
         NextToken;
-        // comma separated list: identifier, class, record, constructor
+        // comma separated list of constraints: identifier, class, record, constructor
         case CurToken of
         tkclass,tkrecord,tkconstructor:
           begin
           if T.TypeConstraint='' then
             T.TypeConstraint:=CurTokenString;
           Expr:=CreatePrimitiveExpr(T,pekIdent,CurTokenText);
+          T.AddConstraint(Expr);
           NextToken;
           end;
         tkIdentifier,tkspecialize:
           begin
-          SrcPos:=CurSourcePos;
-          TypeEl:=ParseTypeReference(T,true,Expr);
-          if TypeEl<>nil then
-            begin
+          TypeEl:=ParseTypeReference(T,false,Expr);
+          if T.TypeConstraint='' then
             T.TypeConstraint:=TypeEl.Name;
-            if TypeEl is TPasSpecializeType then
-              begin
-              ISE:=TInlineSpecializeExpr(CreateElement(TInlineSpecializeExpr,'',T,SrcPos));
-              ISE.DestType:=TPasSpecializeType(TypeEl);
-              TypeEl.Parent:=ISE;
-              Expr:=ISE;
-              end
-            else if TypeEl.Parent=T then
-              ParseExc(nParserExpectTokenError,SParserExpectTokenError,['20190831211205:'+TypeEl.ClassName])
-            else
-              TypeEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
-            end;
+          if (Expr<>nil) and (Expr.Parent=T) then
+            Expr.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+          T.AddConstraint(TypeEl);
           end;
         else
           CheckToken(tkIdentifier);
         end;
-        T.AddConstraint(Expr);
       until CurToken<>tkComma;
     Engine.FinishScope(stTypeDef,T);
   until not (CurToken in [tkSemicolon,tkComma]);
@@ -4167,7 +4139,8 @@ begin
 end;
 {$warn 5043 on}
 
-procedure TPasParser.ReadSpecializeArguments(Spec: TPasSpecializeType);
+procedure TPasParser.ReadSpecializeArguments(Parent: TPasElement;
+  Params: TFPList);
 // after parsing CurToken is on tkGreaterThan
 Var
   TypeEl: TPasType;
@@ -4176,8 +4149,8 @@ begin
   CheckToken(tkLessThan);
   repeat
     //writeln('ARG TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
-    TypeEl:=ParseType(Spec,CurTokenPos,'');
-    Spec.AddParam(TypeEl);
+    TypeEl:=ParseType(Parent,CurTokenPos,'');
+    Params.Add(TypeEl);
     NextToken;
     if CurToken=tkComma then
       continue

+ 68 - 34
packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -42,6 +42,8 @@ type
     procedure TestGen_ConstraintClassType_DotIsAsTypeCast;
     procedure TestGen_ConstraintClassType_ForInT;
     procedure TestGen_ConstraintClassType_IsAs;
+    // ToDo: A<T:T> fail
+    // ToDo: A<T:B<T>> fail
 
     // generic record
     procedure TestGen_RecordLocalNameDuplicateFail;
@@ -103,18 +105,29 @@ type
 
     // ToDo: helpers for generics
 
-    // generic functions
-    procedure TestGen_GenericFunction; // ToDo
-    // ToDo: generic class method overload <T> <S,T>
-    // ToDo: procedure TestGen_GenMethod_ClassConstructorFail;
-
     // generic statements
     procedure TestGen_LocalVar;
     procedure TestGen_Statements;
     procedure TestGen_InlineSpecializeExpr;
+    // ToDo: a.b<c>(d)
+    // ToDo: with a do b<c>
     procedure TestGen_TryExcept;
     procedure TestGen_Call;
-    // ToTo: nested proc
+    procedure TestGen_NestedProc;
+
+    // generic functions
+    procedure TestGenProc_Function; // ToDo
+    //procedure TestGenProc_Forward; // ToDo
+    // ToDo: forward parametrized impl must not repeat constraints
+    // ToDo: forward parametrized impl overloads
+    // ToDo: parametrized nested proc fail
+    // ToDo: generic class method overload <T> <S,T>
+    // ToDo: procedure TestGenMethod_ClassConstructorFail;
+    // ToDo: procedure TestGenMethod_NestedProc;
+    // ToDo: virtual method cannot have type parameters
+    // ToDo: message method cannot have type parameters
+    // ToDo: interface method cannot have type parameters
+    // ToDo: parametrized method mismatch interface method
   end;
 
 implementation
@@ -200,10 +213,7 @@ procedure TTestResolveGenerics.TestGen_ConstraintStringFail;
 begin
   StartProgram(false);
   Add([
-  'generic function DoIt<T:string>(a: T): T;',
-  'begin',
-  '  Result:=a;',
-  'end;',
+  'type generic TRec<T:string> = record end;',
   'begin',
   '']);
   CheckResolverException('"String" is not a valid constraint',
@@ -219,10 +229,7 @@ begin
   '  TObject = class end;',
   '  TBird = class end;',
   '  TBear = class end;',
-  'generic function DoIt<T: TBird, TBear>(a: T): T;',
-  'begin',
-  '  Result:=a;',
-  'end;',
+  '  generic TRec<T: TBird, TBear> = record end;',
   'begin',
   '']);
   CheckResolverException('"TBird" constraint and "TBear" constraint cannot be specified together',
@@ -553,6 +560,7 @@ begin
   '    specialize TAnt<TObject>(v).v:=nil;',
   '  a:=v as specialize TAnt<U>;',
   '  if (v as specialize TAnt<TObject>).v=nil then ;',
+  '  if nil=(v as specialize TAnt<TObject>).v then ;',
   'end;',
   'begin',
   '']);
@@ -812,7 +820,7 @@ begin
   '  end;',
   'begin',
   '']);
-  CheckResolverException('Declaration of "T" differs from previous declaration at afile.pp(7,20)',
+  CheckResolverException('Declaration of "T" differs from previous declaration at afile.pp(7,18)',
     nDeclOfXDiffersFromPrevAtY);
 end;
 
@@ -987,7 +995,7 @@ begin
   'end;',
   'begin',
   '']);
-  CheckResolverException('T cannot have parameters',nXCannotHaveParameters);
+  CheckResolverException('illegal qualifier ":" after "T"',nIllegalQualifierAfter);
 end;
 
 procedure TTestResolveGenerics.TestGen_Class_MethodImplTypeParamNameMismatch;
@@ -1480,24 +1488,6 @@ begin
   CheckParserException('Expected "Identifier" at token "specialize" in file afile.pp at line 4 column 11',nParserExpectTokenError);
 end;
 
-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);',
-  '']);
-  ParseProgram;
-end;
-
 procedure TTestResolveGenerics.TestGen_LocalVar;
 begin
   StartProgram(false);
@@ -1671,6 +1661,50 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_NestedProc;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '    function Fly(p:T): T;',
+  '  end;',
+  'function TBird.Fly(p:T): T;',
+  '  function Run: T;',
+  '  begin',
+  '    Fly:=Result;',
+  '  end;',
+  'begin',
+  '  Run;',
+  'end;',
+  'var',
+  '  w: specialize TBird<word>;',
+  '  b: specialize TBird<boolean>;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_Function;
+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);',
+  '']);
+  ParseProgram;
+end;
+
 initialization
   RegisterTests([TTestResolveGenerics]);
 

+ 2 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -1092,6 +1092,8 @@ begin
     writeln('TCustomTestResolver.TearDown GlobalRefCount Was='+IntToStr(FStartElementRefCount)+' Now='+IntToStr(TPasElement.GlobalRefCount));
     {$IFDEF CheckPasTreeRefCount}
     El:=TPasElement.FirstRefEl;
+    if El=nil then
+      writeln('  TPasElement.FirstRefEl=nil');
     while El<>nil do
       begin
       writeln('  ',GetObjName(El),' RefIds.Count=',El.RefIds.Count,':');

Some files were not shown because too many files changed in this diff