pastojs: fixed delay init specialized interface

git-svn-id: trunk@47919 -

packages/pastojs/src/fppas2js.pp

@@ -5239,9 +5239,16 @@ end;
 
 procedure TPas2JSResolver.SpecializeGenericIntf(
   SpecializedItem: TPRSpecializedItem);
+var
+  El: TPasElement;
 begin
   inherited SpecializeGenericIntf(SpecializedItem);
   RenameSpecialized(SpecializedItem);
+  El:=SpecializedItem.SpecializedEl;
+  if (El is TPasGenericType)
+      and IsFullySpecialized(TPasGenericType(El))
+      and (SpecializeParamsNeedDelay(SpecializedItem)<>nil) then
+    TPas2JSResolverHub(Hub).AddJSDelaySpecialize(TPasGenericType(El));
 end;
 
 procedure TPas2JSResolver.SpecializeGenericImpl(
@@ -5252,11 +5259,6 @@ begin
   inherited SpecializeGenericImpl(SpecializedItem);
 
   El:=SpecializedItem.SpecializedEl;
-  if (El is TPasGenericType)
-      and IsFullySpecialized(TPasGenericType(El))
-      and (SpecializeParamsNeedDelay(SpecializedItem)<>nil) then
-    TPas2JSResolverHub(Hub).AddJSDelaySpecialize(TPasGenericType(El));
-
   if El is TPasMembersType then
     begin
     if FOverloadScopes=nil then
@@ -8208,6 +8210,7 @@ begin
         Lib:=TPasLibrary(El);
         if Assigned(Lib.LibrarySection) then
           AddToSourceElements(Src,ConvertDeclarations(Lib.LibrarySection,IntfContext));
+        // ToDo AddDelayedInits(Lib,Src,IntfContext);
         CreateInitSection(Lib,Src,IntfContext);
         end
       else

packages/pastojs/tests/tcgenerics.pas

@@ -55,6 +55,7 @@ type
     procedure TestGen_ClassInterface_InterfacedObject;
     procedure TestGen_ClassInterface_COM_RTTI;
     procedure TestGen_ClassInterface_Helper;
+    procedure TestGen_ClassInterface_DelayedInitSpec;
 
     // statements
     Procedure TestGen_InlineSpec_Constructor;
@@ -1634,6 +1635,74 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_ClassInterface_DelayedInitSpec;
+begin
+  WithTypeInfo:=true;
+  StartProgram(true,[supTObject,supTInterfacedObject]);
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+  '{$mode delphi}',
+  'type',
+  '  TAnt<T> = interface',
+  '    procedure Run(x: T);',
+  '  end;',
+  '']),
+  LinesToStr([
+  '']));
+  Add([
+  '{$mode delphi}',
+  'uses UnitA;',
+  'type',
+  '  TArrWord = array of word;',
+  '  TMyIntf = TAnt<TArrWord>;',
+  '  TBird = class(TInterfacedObject,TMyIntf)',
+  '    procedure Run(a: TArrWord); external name ''Run'';',
+  '  end;',
+  'var',
+  '  i: TMyIntf;',
+  'begin',
+  '  i:=TBird.Create;',
+  '  i.Run([3,4]);',
+  'end.']);
+  ConvertProgram;
+  CheckUnit('UnitA.pas',
+    LinesToStr([ // statements
+    'rtl.module("UnitA", ["system"], function () {',
+    '  var $mod = this;',
+    '  $mod.$rtti.$Interface("TAnt<test1.TArrWord>");',
+    '  rtl.createInterface(',
+    '    this,',
+    '    "TAnt$G1",',
+    '    "{B145F21B-2696-32D5-87A5-F16C037A2D45}",',
+    '    ["Run"],',
+    '    pas.system.IUnknown,',
+    '    function () {',
+    '      this.$initSpec = function () {',
+    '        var $r = this.$rtti;',
+    '        $r.addMethod("Run", 0, [["x", pas.program.$rtti["TArrWord"]]]);',
+    '      };',
+    '    },',
+    '    "TAnt<test1.TArrWord>"',
+    '  );',
+    '});']));
+  CheckSource('TestGen_ClassInterface_DelayedInitSpec',
+    LinesToStr([ // statements
+    'this.$rtti.$DynArray("TArrWord", {',
+    '  eltype: rtl.word',
+    '});',
+    'rtl.createClass(this, "TBird", pas.system.TInterfacedObject, function () {',
+    '  rtl.addIntf(this, pas.UnitA.TAnt$G1);',
+    '  rtl.addIntf(this, pas.system.IUnknown);',
+    '});',
+    'this.i = null;',
+    'pas.UnitA.TAnt$G1.$initSpec();',
+    '']),
+    LinesToStr([ // $mod.$main
+    'rtl.setIntfP($mod, "i", rtl.queryIntfT($mod.TBird.$create("Create"), pas.UnitA.TAnt$G1), true);',
+    '$mod.i.Run([3, 4]);',
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_InlineSpec_Constructor;
 begin
   StartProgram(false);

packages/pastojs/tests/tcmodules.pas

@@ -887,7 +887,7 @@ type
     Procedure TestAWait_ExternalClassPromise;
     Procedure TestAWait_JSValue;
     Procedure TestAWait_Result;
-    Procedure TestAWait_ResultPromiseMissingTypeFail;
+    Procedure TestAWait_ResultPromiseMissingTypeFail; // await(AsyncCallResultPromise) needs T
     Procedure TestAsync_AnonymousProc;
     Procedure TestAsync_ProcType;
     Procedure TestAsync_ProcTypeAsyncModMismatchFail;
@@ -32647,6 +32647,8 @@ begin
   'type',
   '  TJSPromise = class external name ''Promise''',
   '  end;',
+  '  TJSThenable = class external name ''Thenable''',
+  '  end;',
   'function Fly(w: word): TJSPromise;',
   'begin',
   'end;',