fcl-passrc: specialize for-loop

git-svn-id: trunk@42602 -

packages/fcl-passrc/src/pasresolver.pp

@@ -1726,11 +1726,14 @@ type
     procedure SpecializeProcedureType(GenEl, SpecEl: TPasProcedureType);
     procedure SpecializeProcedureBody(GenEl, SpecEl: TProcedureBody);
     procedure SpecializeDeclarations(GenEl, SpecEl: TPasDeclarations);
+    procedure SpecializeSpecializeType(GenEl, SpecEl: TPasSpecializeType);
     procedure SpecializeArgument(GenEl, SpecEl: TPasArgument);
     procedure SpecializeImplBlock(GenEl, SpecEl: TPasImplBlock);
     procedure SpecializeImplAssign(GenEl, SpecEl: TPasImplAssign);
+    procedure SpecializeImplForLoop(GenEl, SpecEl: TPasImplForLoop);
     procedure SpecializeExpr(GenEl, SpecEl: TPasExpr);
     procedure SpecializePrimitiveExpr(GenEl, SpecEl: TPrimitiveExpr);
+    procedure SpecializeBinaryExpr(GenEl, SpecEl: TBinaryExpr);
   protected
     // custom types (added by descendant resolvers)
     function CheckAssignCompatibilityCustom(
@@ -2138,6 +2141,7 @@ type
     function IsArrayOperatorAdd(Expr: TPasExpr): boolean;
     function IsTypeCast(Params: TParamsExpr): boolean;
     function GetTypeParameterCount(aType: TPasGenericType): integer;
+    function IsGenericTemplType(const ResolvedEl: TPasResolverResult): boolean;
     function IsInterfaceType(const ResolvedEl: TPasResolverResult;
       IntfType: TPasClassInterfaceType): boolean; overload;
     function IsInterfaceType(TypeEl: TPasType; IntfType: TPasClassInterfaceType): boolean; overload;
@@ -4244,6 +4248,30 @@ begin
   Result:=(El.ClassType=TPrimitiveExpr) and (TPrimitiveExpr(El).Kind=pekIdent);
 end;
 
+// inline
+function TPasResolver.IsGenericTemplType(const ResolvedEl: TPasResolverResult
+  ): boolean;
+begin
+  Result:=(ResolvedEl.BaseType=btContext)
+      and (ResolvedEl.LoTypeEl.ClassType=TPasGenericTemplateType);
+end;
+
+// inline
+function TPasResolver.GetLocalScope: TPasScope;
+begin
+  Result:=TopScope;
+  if Result.ClassType=TPasGroupScope then
+    Result:=TPasGroupScope(Result).Scopes[0];
+end;
+
+// inline
+function TPasResolver.GetParentLocalScope: TPasScope;
+begin
+  Result:=Scopes[ScopeCount-2];
+  if Result.ClassType=TPasGroupScope then
+    Result:=TPasGroupScope(Result).Scopes[0];
+end;
+
 function TPasResolver.GetNameExprValue(El: TPasExpr): string;
 begin
   if El=nil then
@@ -11479,6 +11507,14 @@ begin
 
   //writeln('TPasResolver.ComputeBinaryExpr ',OpcodeStrings[Bin.OpCode],' Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
 
+  if IsGenericTemplType(LeftResolved) or IsGenericTemplType(RightResolved) then
+    begin
+    // cannot yet be decided
+    ResolvedEl:=LeftResolved;
+    ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
+    exit;
+    end;
+
   if LeftResolved.BaseType in btAllInteger then
     begin
     if (rrfReadable in LeftResolved.Flags)
@@ -14249,9 +14285,15 @@ begin
   // check if there is already such a specialization
   GenericType:=El.DestType as TPasGenericType;
   if not (GenericType.CustomData is TPasGenericScope) then
-    RaiseNotYetImplemented(20190726194316,El,GetObjName(GenericType.CustomData));
+    RaiseMsg(20190726194316,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
+      [GetTypeDescription(GenericType)],El);
   GenScope:=TPasGenericScope(GenericType.CustomData);
 
+  if (not (GenericType is TPasClassType))
+      and (GenScope.GenericStep<psgsInterfaceParsed) then
+    RaiseMsg(20190807205038,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
+      [GetTypeDescription(GenericType)],El);
+
   if not CheckSpecializeConstraints(El) then
     begin
     // not fully specialized -> use generic type
@@ -14625,7 +14667,8 @@ begin
 
   // check specialized type step
   if SpecializedItem.Step<psssInterfaceFinished then
-    RaiseNotYetImplemented(20190804120128,GenericType,GetObjName(SpecializedItem.SpecializedType));
+    RaiseMsg(20190804120128,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
+      [GetTypeDescription(GenericType)],SpecializedItem.FirstSpecialize);
   if SpecializedItem.Step>psssInterfaceFinished then
     exit;
   SpecializedItem.Step:=psssImplementationBuilding;
@@ -14740,12 +14783,14 @@ begin
   C:=GenEl.ClassType;
   if C=TPrimitiveExpr then
     SpecializePrimitiveExpr(TPrimitiveExpr(GenEl),TPrimitiveExpr(SpecEl))
+  else if C=TBinaryExpr then
+    SpecializeBinaryExpr(TBinaryExpr(GenEl),TBinaryExpr(SpecEl))
   else if C=TPasImplBeginBlock then
-    // no special Add
     SpecializeImplBlock(TPasImplBeginBlock(GenEl),TPasImplBeginBlock(SpecEl))
   else if C=TPasImplAssign then
-    // no special Add
     SpecializeImplAssign(TPasImplAssign(GenEl),TPasImplAssign(SpecEl))
+  else if C=TPasImplForLoop then
+    SpecializeImplForLoop(TPasImplForLoop(GenEl),TPasImplForLoop(SpecEl))
   else if C=TPasVariable then
     begin
     AddVariable(TPasVariable(SpecEl));
@@ -14771,6 +14816,11 @@ begin
     AddType(TPasProcedureType(SpecEl));
     SpecializeProcedureType(TPasProcedureType(GenEl),TPasProcedureType(SpecEl));
     end
+  else if C=TPasSpecializeType then
+    begin
+    AddType(TPasSpecializeType(SpecEl));
+    SpecializeSpecializeType(TPasSpecializeType(GenEl),TPasSpecializeType(SpecEl));
+    end
   else
     RaiseNotYetImplemented(20190728151215,GenEl);
 end;
@@ -14807,6 +14857,7 @@ procedure TPasResolver.SpecializeElType(GenEl, SpecEl: TPasElement;
   GenElType: TPasType; var SpecElType: TPasType);
 var
   Ref: TPasElement;
+  NewClass: TPTreeElement;
 begin
   if GenElType=nil then exit;
   if GenElType.Parent<>GenEl then
@@ -14828,7 +14879,9 @@ begin
     exit;
     end;
   // e.g. anonymous type
-  RaiseNotYetImplemented(20190728152244,GenEl);
+  NewClass:=TPTreeElement(GenElType.ClassType);
+  SpecElType:=TPasType(NewClass.Create(GenElType.Name,SpecEl));
+  SpecializeElement(GenElType,SpecElType);
 end;
 
 procedure TPasResolver.SpecializeElExpr(GenEl, SpecEl: TPasElement;
@@ -14997,6 +15050,34 @@ begin
     end;
 end;
 
+procedure TPasResolver.SpecializeSpecializeType(GenEl,
+  SpecEl: TPasSpecializeType);
+var
+  i: Integer;
+  GenParam, SpecParam: TPasElement;
+  NewClass: TPTreeElement;
+begin
+  SpecializeElType(GenEl,SpecEl,GenEl.DestType,SpecEl.DestType);
+  SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
+  for i:=0 to GenEl.Params.Count-1 do
+    begin
+    GenParam:=TPasElement(GenEl.Params[i]);
+    if GenParam.Parent<>GenEl then
+      begin
+      // reference
+      GenParam.AddRef{$IFDEF CheckPasTreeRefCount}('TPasSpecializeType.Params'){$ENDIF};
+      SpecEl.AddParam(GenParam);
+      continue;
+      end;
+    NewClass:=TPTreeElement(GenParam.ClassType);
+    SpecParam:=TPasElement(NewClass.Create(GenParam.Name,SpecEl));
+    SpecEl.Params.Add(SpecParam);
+    SpecializeElement(GenParam,SpecParam);
+    end;
+
+  FinishSpecializeType(SpecEl);
+end;
+
 procedure TPasResolver.SpecializeArgument(GenEl, SpecEl: TPasArgument);
 begin
   SpecEl.Access:=GenEl.Access;
@@ -15027,18 +15108,45 @@ end;
 
 procedure TPasResolver.SpecializeImplAssign(GenEl, SpecEl: TPasImplAssign);
 begin
-  SpecializeImplBlock(GenEl,SpecEl);
+  if GenEl.Elements.Count>0 then
+    RaiseNotYetImplemented(20190808142935,GenEl);
   SpecEl.Kind:=GenEl.Kind;
   SpecializeElExpr(GenEl,SpecEl,GenEl.left,SpecEl.left);
   SpecializeElExpr(GenEl,SpecEl,GenEl.right,SpecEl.right);
 end;
 
+procedure TPasResolver.SpecializeImplForLoop(GenEl, SpecEl: TPasImplForLoop);
+var
+  i: Integer;
+  GenImpl, NewImpl: TPasImplElement;
+  NewClass: TPTreeElement;
+begin
+  if GenEl.Variable<>nil then
+    RaiseNotYetImplemented(20190808142627,GenEl);
+  SpecializeElExpr(GenEl,SpecEl,GenEl.VariableName,SpecEl.VariableName);
+  SpecEl.LoopType:=GenEl.LoopType;
+  SpecializeElExpr(GenEl,SpecEl,GenEl.StartExpr,SpecEl.StartExpr);
+  SpecializeElExpr(GenEl,SpecEl,GenEl.EndExpr,SpecEl.EndExpr);
+  FinishForLoopHeader(SpecEl);
+  // SpecEl.Body is set via AddElement
+  for i:=0 to GenEl.Elements.Count-1 do
+    begin
+    GenImpl:=TPasImplElement(GenEl.Elements[i]);
+    if GenImpl.Parent<>GenEl then
+      RaiseNotYetImplemented(20190806092151,GenEl,GetElementSourcePosStr(GenImpl));
+    NewClass:=TPTreeElement(GenImpl.ClassType);
+    NewImpl:=TPasImplElement(NewClass.Create(GenImpl.Name,SpecEl));
+    SpecEl.AddElement(NewImpl);
+    SpecializeElement(GenImpl,NewImpl);
+    end;
+end;
+
 procedure TPasResolver.SpecializeExpr(GenEl, SpecEl: TPasExpr);
 begin
   SpecEl.Kind:=GenEl.Kind;
   SpecEl.OpCode:=GenEl.OpCode;
-  SpecEl.format1:=GenEl.format1;
-  SpecEl.format2:=GenEl.format2;
+  SpecializeElExpr(GenEl,SpecEl,GenEl.format1,SpecEl.format1);
+  SpecializeElExpr(GenEl,SpecEl,GenEl.format2,SpecEl.format2);
 end;
 
 procedure TPasResolver.SpecializePrimitiveExpr(GenEl, SpecEl: TPrimitiveExpr);
@@ -15047,6 +15155,13 @@ begin
   SpecEl.Value:=GenEl.Value;
 end;
 
+procedure TPasResolver.SpecializeBinaryExpr(GenEl, SpecEl: TBinaryExpr);
+begin
+  SpecializeExpr(GenEl,SpecEl);
+  SpecializeElExpr(GenEl,SpecEl,GenEl.left,SpecEl.left);
+  SpecializeElExpr(GenEl,SpecEl,GenEl.right,SpecEl.right);
+end;
+
 function TPasResolver.CheckAssignCompatibilityCustom(const LHS,
   RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
   var Handled: boolean): integer;
@@ -18592,20 +18707,6 @@ begin
   {AllowWriteln-}
 end;
 
-function TPasResolver.GetLocalScope: TPasScope;
-begin
-  Result:=TopScope;
-  if Result.ClassType=TPasGroupScope then
-    Result:=TPasGroupScope(Result).Scopes[0];
-end;
-
-function TPasResolver.GetParentLocalScope: TPasScope;
-begin
-  Result:=Scopes[ScopeCount-2];
-  if Result.ClassType=TPasGroupScope then
-    Result:=TPasGroupScope(Result).Scopes[0];
-end;
-
 function TPasResolver.CreateScope(El: TPasElement; ScopeClass: TPasScopeClass
   ): TPasScope;
 begin
@@ -20314,6 +20415,11 @@ begin
     begin
     LBT:=GetActualBaseType(LHS.BaseType);
     RBT:=GetActualBaseType(RHS.BaseType);
+    if IsGenericTemplType(LHS) or IsGenericTemplType(RHS) then
+      begin
+      // not fully specified -> maybe
+      exit(cCompatible);
+      end;
     if LHS.LoTypeEl=nil then
       begin
       if LBT=btUntyped then

packages/fcl-passrc/src/pparser.pp

@@ -4081,45 +4081,28 @@ procedure TPasParser.ReadSpecializeArguments(Spec: TPasElement);
   end;
 
 Var
-  Expr: TPasExpr;
   TypeEl: TPasType;
-
 begin
   //writeln('START TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
   CheckToken(tkLessThan);
-  NextToken;
-  Expr:=nil;
-  try
-    repeat
-      //writeln('ARG TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
-      TypeEl:=ParseTypeReference(Spec,true,Expr);
-      if TypeEl.Parent=Spec then
-        AddParam(TypeEl)
-      else
-        begin
-        TypeEl.Release{$IFDEF CheckPasTreeRefCount}('ResolveTypeReference'){$ENDIF};
-        AddParam(Expr);
-        Expr:=nil;
-        end;
-      if CurToken=tkComma then
-        begin
-        NextToken;
-        continue;
-        end
-      else if CurToken=tkshr then
-        begin
-        ChangeToken(tkGreaterThan);
-        break;
-        end
-      else if CurToken=tkGreaterThan then
-        break
-      else
-        ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
-          [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]);
-    until false;
-  finally
-    Expr.Free;
-  end;
+  repeat
+    //writeln('ARG TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
+    TypeEl:=ParseType(Spec,CurTokenPos,'');
+    AddParam(TypeEl);
+    NextToken;
+    if CurToken=tkComma then
+      continue
+    else if CurToken=tkshr then
+      begin
+      ChangeToken(tkGreaterThan);
+      break;
+      end
+    else if CurToken=tkGreaterThan then
+      break
+    else
+      ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
+        [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]);
+  until false;
 end;
 
 function TPasParser.ReadDottedIdentifier(Parent: TPasElement; out

packages/fcl-passrc/tests/tcclasstype.pas

@@ -557,8 +557,8 @@ begin
   AssertNotNull('Have param types',C.Params);
   AssertEquals('Have one param type',1,C.Params.Count);
   AssertNotNull('First Param ',C.Params[0]);
-  AssertEquals('First Param expr',TPrimitiveExpr,TObject(C.Params[0]).ClassType);
-  AssertEquals('Has specialize param integer','Integer',TPrimitiveExpr(C.Params[0]).Value);
+  AssertEquals('First Param unresolvedtype',TPasUnresolvedTypeRef,TObject(C.Params[0]).ClassType);
+  AssertEquals('Has specialize param integer','Integer',TPasUnresolvedTypeRef(C.Params[0]).Name);
 end;
 
 procedure TTestClassType.TestOneSpecializedClass;

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -13,13 +13,14 @@ type
 
   TTestResolveGenerics = Class(TCustomTestResolver)
   Published
-    // generic functions
-    procedure TestGen_GenericFunction; // ToDo
-
     // generic types
     procedure TestGen_MissingTemplateFail;
     procedure TestGen_VarTypeWithoutSpecializeFail;
     procedure TestGen_GenTypeWithWrongParamCountFail;
+    procedure TestGen_GenericNotFoundFail;
+    procedure TestGen_SameNameSameParamCountFail;
+
+    // constraints
     procedure TestGen_ConstraintStringFail;
     procedure TestGen_ConstraintMultiClassFail;
     procedure TestGen_ConstraintRecordExpectedFail;
@@ -30,56 +31,65 @@ type
     // ToDo: constraint T:Unit2.TBird
     // ToDo: constraint T:Unit2.TGen<word>
     procedure TestGen_TemplNameEqTypeNameFail;
-    procedure TestGen_GenericNotFoundFail;
-    procedure TestGen_SameNameSameParamCountFail;
+
+    // generic record
     procedure TestGen_RecordLocalNameDuplicateFail;
     procedure TestGen_Record;
     procedure TestGen_RecordDelphi;
     procedure TestGen_RecordNestedSpecialized;
+    procedure TestGen_Record_SpecializeSelfInsideFail;
     // ToDo: enums within generic
+    procedure TestGen_RecordAnoArray;
     // ToDo: procedure TestGen_SpecializeArg_ArrayOf;  type TBird = specialize<array of word>
     // ToDo: unitname.specialize TBird<word>.specialize
+
+    // generic class
     procedure TestGen_Class;
     procedure TestGen_ClassDelphi;
     procedure TestGen_ClassForward;
     procedure TestGen_Class_Method;
-    procedure TestGen_Class_Method_LocalVar;
-    // ToDo: specialize inside generic fail
+    procedure TestGen_Class_SpecializeSelfInside;
     // ToDo: generic class forward (constraints must be repeated)
     // ToDo: generic class forward  constraints mismatch fail
     // ToDo: generic class overload <T> <S,T>
-    // ToDo: generic class method overload <T> <S,T>
+    procedure TestGen_Class_GenAncestor;
+    procedure TestGen_Class_AncestorSelfFail;
     // ToDo: ancestor cycle: TBird<T> = class(TBird<word>) fail
     // ToDo: class-of
     // ToDo: UnitA.impl uses UnitB.intf uses UnitA.intf, UnitB has specialize of UnitA
+
     // ToDo: generic interface
+
     // ToDo: generic array
+
     // ToDo: generic procedure type
+
     // ToDo: pointer of generic
-    // ToDo: generic helpers
+
+    // ToDo: helpers for generics
+
+    // generic functions
+    // ToDo: generic class method overload <T> <S,T>
+    procedure TestGen_GenericFunction; // ToDo
+
+    // generic statements
+    procedure TestGen_LocalVar;
+    procedure TestGen_ForLoop;
+    // ToDo: for
+    // ToDo: for-in
+    // ToDo: if
+    // ToDo: case
+    // ToDo: while, repeat
+    // ToDo: try finally/except
+    // ToDo: call
+    // ToDo: dot
+    // ToDo: is as
   end;
 
 implementation
 
 { TTestResolveGenerics }
 
-procedure TTestResolveGenerics.TestGen_GenericFunction;
-begin
-  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_MissingTemplateFail;
 begin
   StartProgram(false);
@@ -114,6 +124,33 @@ begin
     nIdentifierNotFound);
 end;
 
+procedure TTestResolveGenerics.TestGen_GenericNotFoundFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TBird = specialize TAnimal<word>;',
+  'begin',
+  '']);
+  CheckResolverException('identifier not found "TAnimal<>"',
+    nIdentifierNotFound);
+end;
+
+procedure TTestResolveGenerics.TestGen_SameNameSameParamCountFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TBird<S,T> = record w: T; end;',
+  '  TBird<X,Y> = record f: X; end;',
+  'begin',
+  '']);
+  CheckResolverException('Duplicate identifier "TBird" at afile.pp(4,8)',
+    nDuplicateIdentifier);
+end;
+
 procedure TTestResolveGenerics.TestGen_ConstraintStringFail;
 begin
   StartProgram(false);
@@ -211,7 +248,7 @@ begin
   Add([
   '{$mode objfpc}',
   'type',
-  '  generic TBird<TBird:record> = record v: T; end;',
+  '  generic TBird<TBird> = record v: T; end;',
   'var r: specialize TBird<word>;',
   'begin',
   '']);
@@ -219,33 +256,6 @@ begin
     nDuplicateIdentifier);
 end;
 
-procedure TTestResolveGenerics.TestGen_GenericNotFoundFail;
-begin
-  StartProgram(false);
-  Add([
-  '{$mode objfpc}',
-  'type',
-  '  TBird = specialize TAnimal<word>;',
-  'begin',
-  '']);
-  CheckResolverException('identifier not found "TAnimal<>"',
-    nIdentifierNotFound);
-end;
-
-procedure TTestResolveGenerics.TestGen_SameNameSameParamCountFail;
-begin
-  StartProgram(false);
-  Add([
-  '{$mode delphi}',
-  'type',
-  '  TBird<S,T> = record w: T; end;',
-  '  TBird<X,Y> = record f: X; end;',
-  'begin',
-  '']);
-  CheckResolverException('Duplicate identifier "TBird" at afile.pp(4,8)',
-    nDuplicateIdentifier);
-end;
-
 procedure TTestResolveGenerics.TestGen_RecordLocalNameDuplicateFail;
 begin
   StartProgram(false);
@@ -312,6 +322,34 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_Record_SpecializeSelfInsideFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  generic TBird<T> = record',
+  '    v: specialize TBird<word>;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('type "TBird" is not yet completely defined',
+    nTypeXIsNotYetCompletelyDefined);
+end;
+
+procedure TTestResolveGenerics.TestGen_RecordAnoArray;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  generic TBird<T> = record v: T; end;',
+  'var b: specialize TBird<array of word>;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_Class;
 begin
   StartProgram(false);
@@ -403,7 +441,82 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolveGenerics.TestGen_Class_Method_LocalVar;
+procedure TTestResolveGenerics.TestGen_Class_SpecializeSelfInside;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '    e: T;',
+  '    v: TBird<boolean>;',
+  '  end;',
+  'var',
+  '  b: specialize TBird<word>;',
+  '  w: word;',
+  'begin',
+  '  b.e:=w;',
+  '  if b.v.e then ;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_GenAncestor;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '    i: T;',
+  '  end;',
+  '  generic TEagle<T> = class(TBird<T>)',
+  '    j: T;',
+  '  end;',
+  'var',
+  '  e: specialize TEagle<word>;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_AncestorSelfFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class(TBird<word>)',
+  '    e: T;',
+  '  end;',
+  'var',
+  '  b: specialize TBird<word>;',
+  'begin',
+  '']);
+  CheckResolverException('type "TBird" is not yet completely defined',nTypeXIsNotYetCompletelyDefined);
+end;
+
+procedure TTestResolveGenerics.TestGen_GenericFunction;
+begin
+  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);
   Add([
@@ -431,6 +544,29 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_ForLoop;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<{#Templ}T> = class',
+  '    function Fly(p:T): T;',
+  '  end;',
+  'function TBird.Fly(p:T): T;',
+  'var i: T;',
+  'begin',
+  '  for i:=0 to 3 do Result:=i+p;',
+  'end;',
+  'var',
+  '  b: specialize TBird<word>;',
+  'begin',
+  '  b.Fly(2);',
+  '']);
+  ParseProgram;
+end;
+
 initialization
   RegisterTests([TTestResolveGenerics]);