Browse Source

pastojs: fixed spezialize other unit generic with param in unit intf of spezialize, issue #37762

git-svn-id: trunk@46930 -
Mattias Gaertner 4 years ago
parent
commit
5cde0fc1e2
2 changed files with 71 additions and 2 deletions
  1. 3 1
      packages/pastojs/src/fppas2js.pp
  2. 68 1
      packages/pastojs/tests/tcgenerics.pas

+ 3 - 1
packages/pastojs/src/fppas2js.pp

@@ -5173,7 +5173,9 @@ begin
     if GenResolver=nil then
       GenResolver:=GetResolver(GenMod);
     ParamResolver:=GetResolver(ParamMod);
-    if ParamResolver.FinishedInterfaceIndex<GenResolver.FinishedInterfaceIndex then
+    if (ParamResolver.FinishedInterfaceIndex>GenResolver.FinishedInterfaceIndex)
+        or (ParamResolver.FinishedInterfaceIndex=0) // 0 means currently parsing
+        then
       exit(Param); // param in a later unit interface
     // generic in a later unit interface -> no delay needed
     end;

+ 68 - 1
packages/pastojs/tests/tcgenerics.pas

@@ -77,6 +77,7 @@ type
     procedure TestGenMethod_ObjFPC;
 
     // generic array
+    procedure TestGen_Array_OtherUnit;
     procedure TestGen_ArrayOfUnitImplRec;
 
     // generic procedure type
@@ -2037,6 +2038,62 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_Array_OtherUnit;
+begin
+  WithTypeInfo:=true;
+  StartProgram(true,[supTObject]);
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+  'type',
+  '  generic TDyn<T> = array of T;',
+  '  generic TStatic<T> = array[1..2] of T;',
+  '']),
+  '');
+  AddModuleWithIntfImplSrc('UnitB.pas',
+  LinesToStr([
+  'uses UnitA;',
+  'type',
+  '  TAnt = class end;',
+  '  TAntArray = specialize TDyn<TAnt>;',
+  'procedure Run;',
+  '']),
+  LinesToStr([
+  'procedure Run;',
+  'begin',
+  '  if typeinfo(TAntArray)=nil then ;',
+  'end;',
+  '']));
+  Add([
+  'uses UnitB;',
+  'begin',
+  '  Run;',
+  '']);
+  ConvertProgram;
+  CheckUnit('UnitA.pas',
+    LinesToStr([ // statements
+    'rtl.module("UnitA", ["system"], function () {',
+    '  var $mod = this;',
+    '  this.$rtti.$DynArray("TDyn<UnitB.TAnt>", {});',
+    '});']));
+  CheckUnit('UnitB.pas',
+    LinesToStr([ // statements
+    'rtl.module("UnitB", ["system", "UnitA"], function () {',
+    '  var $mod = this;',
+    '  rtl.createClass(this, "TAnt", pas.system.TObject, function () {',
+    '  });',
+    '  this.Run = function () {',
+    '    if (pas.UnitA.$rtti["TDyn<UnitB.TAnt>"] === null) ;',
+    '  };',
+    '});']));
+  CheckSource('TestGen_Array_OtherUnit',
+    LinesToStr([ // statements
+    'pas.UnitA.$rtti["TDyn<UnitB.TAnt>"].eltype = pas.UnitB.$rtti["TAnt"];',
+    '']),
+    LinesToStr([ // $mod.$main
+    '  pas.UnitB.Run();',
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_ArrayOfUnitImplRec;
 begin
   WithTypeInfo:=true;
@@ -2052,12 +2109,16 @@ begin
   '  TBird = record',
   '    b: word;',
   '  end;',
+  '  TAnt = class end;',
+  '  TAntArray = specialize TDyn<TAnt>;',
   'var',
   '  d: specialize TDyn<TBird>;',
   '  s: specialize TStatic<TBird>;',
+  '  p: pointer;',
   'begin',
   '  d[0].b:=s[1].b;',
   '  s:=s;',
+  '  p:=typeinfo(TAntArray);',
   '']));
   Add([
   'uses UnitA;',
@@ -2069,6 +2130,7 @@ begin
     'rtl.module("UnitA", ["system"], function () {',
     '  var $mod = this;',
     '  var $impl = $mod.$impl;',
+    '  this.$rtti.$DynArray("TDyn<UnitA.TAnt>", {});',
     '  this.$rtti.$DynArray("TDyn<UnitA.TBird>", {});',
     '  this.TStatic$G1$clone = function (a) {',
     '    var r = [];',
@@ -2091,16 +2153,21 @@ begin
     '      var $r = $mod.$rtti.$Record("TBird", {});',
     '      $r.addField("b", rtl.word);',
     '    });',
+    '    rtl.createClass($impl, "TAnt", pas.system.TObject, function () {',
+    '    });',
     '    $impl.d = [];',
     '    $impl.s = rtl.arraySetLength(null, $impl.TBird, 2);',
+    '    $impl.p = null;',
     '  };',
     '  $mod.$init = function () {',
     '    $impl.d[0].b = $impl.s[0].b;',
     '    $impl.s = $mod.TStatic$G1$clone($impl.s);',
+    '    $impl.p = $mod.$rtti["TDyn<UnitA.TAnt>"];',
     '  };',
     '}, []);']));
-  CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
+  CheckSource('TestGen_ArrayOfUnitImplRec',
     LinesToStr([ // statements
+    'pas.UnitA.$rtti["TDyn<UnitA.TAnt>"].eltype = pas.UnitA.$rtti["TAnt"];',
     'pas.UnitA.$rtti["TDyn<UnitA.TBird>"].eltype = pas.UnitA.$rtti["TBird"];',
     'pas.UnitA.$rtti["TStatic<UnitA.TBird>"].eltype = pas.UnitA.$rtti["TBird"];',
     '']),