fcl-passrc: specialize nested class type

git-svn-id: trunk@42712 -

packages/fcl-passrc/src/pasresolver.pp

@@ -1795,6 +1795,7 @@ type
     procedure SpecializeRangeType(GenEl, SpecEl: TPasRangeType);
     procedure SpecializeArrayType(GenEl, SpecEl: TPasArrayType; SpecializedItem: TPSSpecializedItem);
     procedure SpecializeRecordType(GenEl, SpecEl: TPasRecordType; SpecializedItem: TPSSpecializedItem);
+    procedure SpecializeClassType(GenEl, SpecEl: TPasClassType; SpecializedItem: TPSSpecializedItem);
     procedure SpecializeEnumValue(GenEl, SpecEl: TPasEnumValue);
     procedure SpecializeEnumType(GenEl, SpecEl: TPasEnumType);
     procedure SpecializeSetType(GenEl, SpecEl: TPasSetType);
@@ -14866,21 +14867,17 @@ end;
 procedure TPasResolver.SpecializeGenTypeIntf(GenericType: TPasGenericType;
   SpecializedItem: TPSSpecializedItem);
 var
-  GenericTemplateTypes: TFPList;
   SpecType: TPasGenericType;
   NewClassType, GenClassType: TPasClassType;
   GenScope: TPasGenericScope;
-  TemplType: TPasGenericTemplateType;
   C: TClass;
   NewArrayType, GenArrayType: TPasArrayType;
   NewRecordType, GenRecordType: TPasRecordType;
-  HeaderScope: TPasClassHeaderScope;
   GenProcType, NewProcType: TPasProcedureType;
 begin
   if SpecializedItem.Step<>psssNone then
     exit;
   SpecializedItem.Step:=psssInterfaceBuilding;
-  GenericTemplateTypes:=GenericType.GenericTemplateTypes;
   SpecType:=SpecializedItem.SpecializedType;
 
   SpecializePasElementProperties(GenericType,SpecType);
@@ -14900,53 +14897,7 @@ begin
     begin
     NewClassType:=TPasClassType(SpecType);
     GenClassType:=TPasClassType(GenericType);
-    NewClassType.ObjKind:=GenClassType.ObjKind;
-    NewClassType.PackMode:=GenClassType.PackMode;
-    if GenClassType.HelperForType<>nil then
-      RaiseNotYetImplemented(20190730182758,GenClassType,'');
-    if GenClassType.IsForward then
-      RaiseNotYetImplemented(20190730182858,GenClassType);
-    NewClassType.IsExternal:=GenClassType.IsExternal;
-    NewClassType.IsShortDefinition:=GenClassType.IsShortDefinition;
-    if GenClassType.GUIDExpr<>nil then
-      SpecializeElExpr(GenClassType,NewClassType,GenClassType.GUIDExpr,NewClassType.GUIDExpr);
-    NewClassType.Modifiers.Assign(GenClassType.Modifiers);
-    NewClassType.ExternalNameSpace:=GenClassType.ExternalNameSpace;
-    NewClassType.ExternalName:=GenClassType.ExternalName;
-    NewClassType.InterfaceType:=GenClassType.InterfaceType;
-
-    // ancestor+interfaces
-    // ancestor can be specialized types. For example: = class(TAncestor<T>)
-    // -> create a scope with the specialized parameters
-    HeaderScope:=TPasClassHeaderScope.Create;
-    SpecializedItem.HeaderScope:=HeaderScope;
-    TemplType:=TPasGenericTemplateType(GenericTemplateTypes[0]);
-    HeaderScope.Element:=TemplType;
-    AddSpecializedTemplateIdentifiers(GenericTemplateTypes,
-                                      SpecializedItem.Params,HeaderScope);
-    PushScope(HeaderScope);
-    SpecializeElType(GenClassType,NewClassType,
-                     GenClassType.AncestorType,NewClassType.AncestorType);
-    SpecializeElList(GenClassType,NewClassType,
-                     GenClassType.Interfaces,NewClassType.Interfaces,true
-                     {$IFDEF CheckPasTreeRefCount},'TPasClassType.Interfaces'{$ENDIF});
-    if TopScope<>HeaderScope then
-      RaiseNotYetImplemented(20190813003056,GenClassType);
-    PopScope;
-    SpecializedItem.HeaderScope:=nil;
-    HeaderScope.Free;
-
-    FinishAncestors(NewClassType);
-
-    // Note: class scope is created by FinishAncestors
-    GenScope:=NoNil(NewClassType.CustomData) as TPasClassScope;
-    GenScope.SpecializedItem:=SpecializedItem;
-    AddSpecializedTemplateIdentifiers(GenericTemplateTypes,
-                                      SpecializedItem.Params,GenScope);
-    // specialize sub elements
-    SpecializeMembers(GenClassType,NewClassType);
-    SpecializedItem.Step:=psssInterfaceFinished;
-    FinishClassType(NewClassType);
+    SpecializeClassType(GenClassType,NewClassType,SpecializedItem);
     end
   else if C=TPasArrayType then
     begin
@@ -15195,7 +15146,13 @@ begin
     AddRecordType(TPasRecordType(SpecEl),nil);
     SpecializeRecordType(TPasRecordType(GenEl),TPasRecordType(SpecEl),nil);
     end
-  // ToDo: TPasClassType
+  else if C=TPasClassType then
+    begin
+    if GetTypeParameterCount(TPasClassType(GenEl))>0 then
+      RaiseNotYetImplemented(20190816214947,GenEl);
+    AddClassType(TPasClassType(SpecEl),nil);
+    SpecializeClassType(TPasClassType(GenEl),TPasClassType(SpecEl),nil);
+    end
   else if C=TPasStringType then
     begin
     AddType(TPasStringType(SpecEl));
@@ -16039,6 +15996,78 @@ begin
     SpecializedItem.Step:=psssInterfaceFinished;
 end;
 
+procedure TPasResolver.SpecializeClassType(GenEl, SpecEl: TPasClassType;
+  SpecializedItem: TPSSpecializedItem);
+var
+  HeaderScope: TPasClassHeaderScope;
+  TemplType: TPasGenericTemplateType;
+  GenericTemplateTypes: TFPList;
+  GenScope: TPasClassScope;
+begin
+  GenericTemplateTypes:=GenEl.GenericTemplateTypes;
+  SpecEl.ObjKind:=GenEl.ObjKind;
+  SpecEl.PackMode:=GenEl.PackMode;
+  if GenEl.HelperForType<>nil then
+    RaiseNotYetImplemented(20190730182758,GenEl,'');
+  if GenEl.IsForward then
+    RaiseNotYetImplemented(20190730182858,GenEl);
+  SpecEl.IsExternal:=GenEl.IsExternal;
+  SpecEl.IsShortDefinition:=GenEl.IsShortDefinition;
+  if GenEl.GUIDExpr<>nil then
+    SpecializeElExpr(GenEl,SpecEl,GenEl.GUIDExpr,SpecEl.GUIDExpr);
+  SpecEl.Modifiers.Assign(GenEl.Modifiers);
+  SpecEl.ExternalNameSpace:=GenEl.ExternalNameSpace;
+  SpecEl.ExternalName:=GenEl.ExternalName;
+  SpecEl.InterfaceType:=GenEl.InterfaceType;
+
+  // ancestor+interfaces
+  if SpecializedItem<>nil then
+    begin
+    // ancestor can be specialized types. For example: = class(TAncestor<T>)
+    // -> create a scope with the specialized parameters
+    HeaderScope:=TPasClassHeaderScope.Create;
+    SpecializedItem.HeaderScope:=HeaderScope;
+    TemplType:=TPasGenericTemplateType(GenericTemplateTypes[0]);
+    HeaderScope.Element:=TemplType;
+    AddSpecializedTemplateIdentifiers(GenericTemplateTypes,
+                                      SpecializedItem.Params,HeaderScope);
+    PushScope(HeaderScope);
+    end
+  else
+    HeaderScope:=nil;
+  SpecializeElType(GenEl,SpecEl,
+                   GenEl.AncestorType,SpecEl.AncestorType);
+  SpecializeElList(GenEl,SpecEl,
+                   GenEl.Interfaces,SpecEl.Interfaces,true
+                   {$IFDEF CheckPasTreeRefCount},'TPasClassType.Interfaces'{$ENDIF});
+  if HeaderScope<>nil then
+    begin
+    if TopScope<>HeaderScope then
+      RaiseNotYetImplemented(20190813003056,GenEl);
+    PopScope;
+    SpecializedItem.HeaderScope:=nil;
+    HeaderScope.Free;
+    end;
+
+  FinishAncestors(SpecEl);
+
+  // Note: class scope is created by FinishAncestors
+  GenScope:=NoNil(SpecEl.CustomData) as TPasClassScope;
+  if GenScope.SpecializedItem<>nil then
+    RaiseNotYetImplemented(20190816215413,SpecEl);
+  if SpecializedItem<>nil then
+    begin
+    GenScope.SpecializedItem:=SpecializedItem;
+    AddSpecializedTemplateIdentifiers(GenericTemplateTypes,
+                                      SpecializedItem.Params,GenScope);
+    end;
+  // specialize sub elements
+  SpecializeMembers(GenEl,SpecEl);
+  if SpecializedItem<>nil then
+    SpecializedItem.Step:=psssInterfaceFinished;
+  FinishClassType(SpecEl);
+end;
+
 procedure TPasResolver.SpecializeEnumValue(GenEl, SpecEl: TPasEnumValue);
 begin
   SpecializeElExpr(GenEl,SpecEl,GenEl.Value,SpecEl.Value);

packages/fcl-passrc/src/pparser.pp

@@ -3750,7 +3750,7 @@ function TPasParser.AddUseUnit(ASection: TPasSection;
   const NamePos: TPasSourcePos; AUnitName: string; NameExpr: TPasExpr;
   InFileExpr: TPrimitiveExpr): TPasUsesUnit;
 
-  procedure CheckDuplicateInUsesList(UsesClause: TPasUsesClause);
+  procedure CheckDuplicateInUsesList(AUnitName : string; UsesClause: TPasUsesClause);
   var
     i: Integer;
   begin
@@ -3760,16 +3760,6 @@ function TPasParser.AddUseUnit(ASection: TPasSection;
         ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]);
   end;
 
-  procedure CheckDuplicateInUsesList(UnitRef: TPasElement; UsesClause: TPasUsesClause);
-  var
-    i: Integer;
-  begin
-    if UsesClause=nil then exit;
-    for i:=0 to length(UsesClause)-1 do
-      if UsesClause[i].Module=UnitRef then
-        ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]);
-  end;
-
 var
   UnitRef: TPasElement;
   UsesUnit: TPasUsesUnit;
@@ -3787,23 +3777,16 @@ begin
         exit; // for compatibility ignore implicit use of system in system
       ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]);
       end;
+    CheckDuplicateInUsesList(AUnitName,ASection.UsesClause);
+    if ASection.ClassType=TImplementationSection then
+      CheckDuplicateInUsesList(AUnitName,CurModule.InterfaceSection.UsesClause);
 
     UnitRef := Engine.FindModule(AUnitName,NameExpr,InFileExpr);
     if Assigned(UnitRef) then
-      begin
-      UnitRef.AddRef{$IFDEF CheckPasTreeRefCount}('TPasUsesUnit.Module'){$ENDIF};
-      CheckDuplicateInUsesList(UnitRef,ASection.UsesClause);
-      if ASection.ClassType=TImplementationSection then
-        CheckDuplicateInUsesList(UnitRef,CurModule.InterfaceSection.UsesClause);
-      end
+      UnitRef.AddRef{$IFDEF CheckPasTreeRefCount}('TPasUsesUnit.Module'){$ENDIF}
     else
-      begin
-      CheckDuplicateInUsesList(ASection.UsesClause);
-      if ASection.ClassType=TImplementationSection then
-        CheckDuplicateInUsesList(CurModule.InterfaceSection.UsesClause);
       UnitRef := TPasUnresolvedUnitRef(CreateElement(TPasUnresolvedUnitRef,
         AUnitName, ASection, NamePos));
-      end;
 
     UsesUnit:=TPasUsesUnit(CreateElement(TPasUsesUnit,AUnitName,ASection,NamePos));
     Result:=ASection.AddUnitToUsesList(AUnitName,NameExpr,InFileExpr,UnitRef,UsesUnit);

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -660,7 +660,6 @@ end;
 
 procedure TTestResolveGenerics.TestGen_Class_NestedClass;
 begin
-  exit;
   StartProgram(false);
   Add([
   '{$mode objfpc}',
@@ -669,15 +668,22 @@ begin
   '  generic TBird<T> = class',
   '  public type TWing = class',
   '      s: T;',
+  '      function GetIt: T;',
   '    end;',
   '  public',
   '    w: TWing;',
   '  end;',
   '  TBirdWord = specialize TBird<word>;',
+  'function TBird.TWing.GetIt: T;',
+  'begin',
+  'end;',
   'var',
   '  b: TBirdWord;',
+  '  i: word;',
   'begin',
-  '  b.w.s:=3;']);
+  '  b.w.s:=3;',
+  '  i:=b.w.GetIt;',
+  '']);
   ParseProgram;
 end;
 

packages/fcl-passrc/tests/tcresolver.pas

@@ -360,7 +360,6 @@ type
     Procedure TestUnitUseIntf;
     Procedure TestUnitUseImplFail;
     Procedure TestUnit_DuplicateUsesFail;
-    Procedure TestUnit_DuplicateUsesIntfImplFail;
     Procedure TestUnit_NestedFail;
     Procedure TestUnitUseDotted;
     Procedure TestUnit_ProgramDefaultNamespace;
@@ -5675,28 +5674,6 @@ begin
     nParserDuplicateIdentifier);
 end;
 
-procedure TTestResolver.TestUnit_DuplicateUsesIntfImplFail;
-begin
-  AddModuleWithIntfImplSrc('unit2.pp',
-    LinesToStr([
-    'type number = longint;']),
-    LinesToStr([
-    '']));
-
-  StartUnit(true);
-  Add([
-  'interface',
-  'uses unit2;',
-  'var j: number;',
-  'implementation',
-  'uses unit2;',
-  'initialization',
-  '  if number(3) then ;',
-  '']);
-  CheckParserException('Duplicate identifier "unit2" at token ";" in file afile.pp at line 6 column 11',
-    nParserDuplicateIdentifier);
-end;
-
 procedure TTestResolver.TestUnit_NestedFail;
 begin
   AddModuleWithIntfImplSrc('unit2.pp',