pastojs: test generic unit impl proc

git-svn-id: trunk@42890 -

packages/pastojs/tests/tcgenerics.pas

@@ -28,6 +28,8 @@ type
 
     // statements
     Procedure TestGen_InlineSpec_Constructor;
+    Procedure TestGen_CallUnitImplProc;
+    Procedure TestGen_IntAssignTemplVar;
   end;
 
 implementation
@@ -216,7 +218,7 @@ begin
   '  TObject = class end;',
   '  generic TBird<T> = class',
   '  end;',
-  '  generic TEagle<T> = class(TBird<T>)',
+  '  generic TEagle<T> = class(specialize TBird<T>)',
   '  end;',
   'var a: specialize TEagle<word>;',
   'begin',
@@ -337,6 +339,103 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_CallUnitImplProc;
+begin
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+    'type',
+    '  generic TBird<T> = class',
+    '    procedure Fly;',
+    '  end;',
+    'var b: specialize TBird<boolean>;',
+    '']),
+  LinesToStr([
+    'procedure DoIt;',
+    'var b: specialize TBird<word>;',
+    'begin',
+    '  b:=specialize TBird<word>.Create;',
+    '  b.Fly;',
+    'end;',
+    'procedure TBird.Fly;',
+    'begin',
+    '  DoIt;',
+    'end;',
+    '']));
+  StartProgram(true,[supTObject]);
+  Add('uses UnitA;');
+  Add('begin');
+  ConvertProgram;
+  CheckUnit('UnitA.pas',
+    LinesToStr([ // statements
+    'rtl.module("UnitA", ["system"], function () {',
+    '  var $mod = this;',
+    '  var $impl = $mod.$impl;',
+    '  rtl.createClass($mod, "TBird$G1", pas.system.TObject, function () {',
+    '    this.Fly = function () {',
+    '      $impl.DoIt();',
+    '    };',
+    '  });',
+    '  rtl.createClass($mod, "TBird$G2", pas.system.TObject, function () {',
+    '    this.Fly = function () {',
+    '      $impl.DoIt();',
+    '    };',
+    '  });',
+    '  this.b = null;',
+    '}, null, function () {',
+    '  var $mod = this;',
+    '  var $impl = $mod.$impl;',
+    '  $impl.DoIt = function () {',
+    '    var b = null;',
+    '    b = $mod.TBird$G2.$create("Create");',
+    '    b.Fly();',
+    '  };',
+    '});',
+    '']));
+end;
+
+procedure TTestGenerics.TestGen_IntAssignTemplVar;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '    m: T;',
+  '    procedure Fly;',
+  '  end;',
+  'var b: specialize TBird<word>;',
+  'procedure TBird.Fly;',
+  'var i: nativeint;',
+  'begin',
+  '  i:=m;',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_IntAssignTemplVar',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird$G1", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.m = 0;',
+    '  };',
+    '  this.Fly = function () {',
+    '    var i = 0;',
+    '    i = this.m;',
+    '  };',
+    '});',
+    'this.b = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 Initialization
   RegisterTests([TTestGenerics]);
 end.