Browse Source

fcl-passrc: insert specialize behind generic

git-svn-id: trunk@42830 -
Mattias Gaertner 6 years ago
parent
commit
db849a4a79
2 changed files with 60 additions and 2 deletions
  1. 27 2
      packages/fcl-passrc/src/pasresolver.pp
  2. 33 0
      packages/pastojs/tests/tcgenerics.pas

+ 27 - 2
packages/fcl-passrc/src/pasresolver.pp

@@ -14992,6 +14992,31 @@ var
   GenericType, NewEl: TPasGenericType;
   GenScope: TPasGenericScope;
   SpecializedTypes: TObjectList;
+
+  procedure InsertBehind(List: TFPList);
+  var
+    Last: TPasElement;
+    i: Integer;
+  begin
+    Last:=GenericType;
+    if SpecializedTypes<>nil then
+      begin
+      i:=SpecializedTypes.Count-2;
+      if i>=0 then
+        Last:=TPSSpecializedItem(SpecializedTypes[i]).SpecializedType;
+      end;
+    i:=List.IndexOf(Last);
+    if i<0 then
+      begin
+      {$IF defined(VerbosePasResolver) or defined(VerbosePas2JS)}
+      writeln('InsertBehind Generic=',GetObjName(GenericType),' Last=',GetObjName(Last));
+      {$ENDIF}
+      RaiseNotYetImplemented(20190826150507,El);
+      end;
+    List.Insert(i+1,NewEl);
+  end;
+
+var
   NewName: String;
   NewClass: TPTreeElement;
   SrcModule: TPasModule;
@@ -15034,12 +15059,12 @@ begin
 
   if NewParent is TPasDeclarations then
     begin
-    TPasDeclarations(NewParent).Declarations.Add(NewEl);
+    InsertBehind(TPasDeclarations(NewParent).Declarations);
     {$IFDEF CheckPasTreeRefCount}NewEl.RefIds.Add('TPasDeclarations.Children');{$ENDIF}
     end
   else if NewParent is TPasMembersType then
     begin
-    TPasMembersType(NewParent).Members.Add(NewEl);
+    InsertBehind(TPasMembersType(NewParent).Members);
     {$IFDEF CheckPasTreeRefCount}NewEl.RefIds.Add('TPasMembersType.Members');{$ENDIF}
     end
   else

+ 33 - 0
packages/pastojs/tests/tcgenerics.pas

@@ -21,6 +21,7 @@ type
     Procedure TestGen_ClassEmpty;
     Procedure TestGen_Class_EmptyMethod;
     Procedure TestGen_Class_TList;
+    Procedure TestGen_ClassAncestor;
 
     // generic external class
     procedure TestGen_ExtClass_Array;
@@ -207,6 +208,38 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_ClassAncestor;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '  end;',
+  '  generic TEagle<T> = class(TBird<T>)',
+  '  end;',
+  'var a: specialize TEagle<word>;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_ClassAncestor',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird$G2", $mod.TObject, function () {',
+    '});',
+    'rtl.createClass($mod, "TEagle$G1", $mod.TBird$G2, function () {',
+    '});',
+    'this.a = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_ExtClass_Array;
 begin
   StartProgram(false);