fcl-passrc: for-in constrainedgenerictemplate

git-svn-id: trunk@42950 -

packages/fcl-passrc/src/pasresolver.pp

@@ -13843,6 +13843,7 @@ begin
       [GetBaseDescription(InResolved)],Loop.StartExpr);
 
   LoTypeEl:=InResolved.LoTypeEl;
+  writeln('AAA1 TPasResolver.CheckForInClassOrRec ',GetResolverResultDbg(InResolved));
   if LoTypeEl=nil then exit;
 
   // check function InVar.GetEnumerator
@@ -13851,6 +13852,7 @@ begin
     exit;
   // find aRecord.GetEnumerator
   Getter:=DotScope.FindIdentifier('GetEnumerator');
+  writeln('AAA2 TPasResolver.CheckForInClassOrRec ',GetObjPath(Getter));
   PopScope;
   if Getter=nil then
     begin
@@ -20586,6 +20588,8 @@ begin
     Result:=PushRecordDotScope(TPasRecordType(LoType))
   else if C=TPasEnumType then
     Result:=PushEnumDotScope(HiType,TPasEnumType(LoType))
+  else if C=TPasGenericTemplateType then
+    Result:=PushTemplateDotScope(TPasGenericTemplateType(LoType),HiType)
   else
     Result:=PushHelperDotScope(HiType);
 end;

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -32,14 +32,15 @@ type
     // ToDo: constraint T:Unit2.TBird
     // ToDo: constraint T:Unit2.TGen<word>
     procedure TestGen_ConstraintSpecialize;
-    procedure TestGen_ConstraintTSpecializeT;
+    procedure TestGen_ConstraintTSpecializeWithT;
+    procedure TestGen_ConstraintTSpecializeAsTFail;
     procedure TestGen_TemplNameEqTypeNameFail;
     procedure TestGen_ConstraintInheritedMissingRecordFail;
     procedure TestGen_ConstraintInheritedMissingClassTypeFail;
     procedure TestGen_ConstraintMultiParam;
     procedure TestGen_ConstraintMultiParamClassMismatch;
     procedure TestGen_ConstraintClassType_DotIsAsTypeCast;
-    procedure TestGen_ConstraintClassType_ForInT; // ToDo
+    procedure TestGen_ConstraintClassType_ForInT;
 
     // generic record
     procedure TestGen_RecordLocalNameDuplicateFail;
@@ -110,7 +111,6 @@ type
     procedure TestGen_LocalVar;
     procedure TestGen_Statements;
     procedure TestGen_InlineSpecializeExpr;
-    // ToDo: for-in
     procedure TestGen_TryExcept;
     // ToDo: call
     // ToTo: nested proc
@@ -328,7 +328,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolveGenerics.TestGen_ConstraintTSpecializeT;
+procedure TTestResolveGenerics.TestGen_ConstraintTSpecializeWithT;
 begin
   StartProgram(false);
   Add([
@@ -358,6 +358,19 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_ConstraintTSpecializeAsTFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  generic TAnt<S> = record v: S; end;',
+  '  generic TBird<T; U: specialize T<word>> = record v: T; end;',
+  'begin',
+  '']);
+  CheckResolverException('identifier not found "T<>"',nIdentifierNotFound);
+end;
+
 procedure TTestResolveGenerics.TestGen_TemplNameEqTypeNameFail;
 begin
   StartProgram(false);
@@ -481,7 +494,6 @@ end;
 
 procedure TTestResolveGenerics.TestGen_ConstraintClassType_ForInT;
 begin
-  exit; // ToDo
   StartProgram(false);
   Add([
   '{$mode objfpc}',
@@ -495,31 +507,28 @@ begin
   '  generic TAnt<U> = class',
   '    function GetEnumerator: specialize TEnumerator<U>;',
   '  end;',
-  '  generic TRedAnt<S> = class(specialize TAnt<S>);',
+  '  generic TBird<S; T: specialize TAnt<S>> = class',
-  '  generic TBird<S; T: specialize TRedAnt<S>> = class',
   '    m: T;',
-  '    function GetEnumerator: specialize TEnumerator<T>;',
+  '    procedure Fly;',
   '  end;',
-  '  TFireAnt = class(specialize TRedAnt<word>);',
-  '  generic TEagle<U> = class(specialize TBird<U,TFireAnt>)',
-  '  end;',
-  '  TRedEagle = specialize TEagle<word>;',
   'function TEnumerator.MoveNext: boolean;',
   'begin',
   'end;',
   'function TAnt.GetEnumerator: specialize TEnumerator<U>;',
   'begin',
   'end;',
-  'function TBird.GetEnumerator: specialize TEnumerator<S>;',
+  'procedure TBird.Fly;',
+  'var i: S;',
   'begin',
+  '  for i in m do ;',
   'end;',
   'var',
-  '  r: TRedEagle;',
+  '  a: TAnt<word>;',
   '  w: word;',
-  '  f: TFireAnt;',
+  '  b: TBird<word,specialize TAnt<word>>;',
   'begin',
-  '  for w in r.m do ;',
+  '  for w in a do ;',
-  '  for f in r do ;',
+  '  for w in b.m do ;',
   '']);
   ParseProgram;
 end;