Browse Source

pastojs: class in implementation

git-svn-id: trunk@35919 -
Mattias Gaertner 8 years ago
parent
commit
f95be9c80d
2 changed files with 73 additions and 1 deletions
  1. 4 1
      packages/pastojs/src/fppas2js.pp
  2. 69 0
      packages/pastojs/tests/tcmodules.pas

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

@@ -7430,7 +7430,10 @@ begin
       Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnCreateClass]]);
 
     // add parameter: owner. For top level class, the module is the owner.
-    OwnerName:=AContext.GetLocalName(El.GetModule);
+    if El.Parent is TImplementationSection then
+      OwnerName:=AContext.GetLocalName(El.Parent)
+    else
+      OwnerName:=AContext.GetLocalName(El.GetModule);
     if OwnerName='' then
       OwnerName:='this';
     Call.AddArg(CreateBuiltInIdentifierExpr(OwnerName));

+ 69 - 0
packages/pastojs/tests/tcmodules.pas

@@ -321,6 +321,7 @@ type
     Procedure TestClass_TObjectConstructorWithParams;
     Procedure TestClass_Var;
     Procedure TestClass_Method;
+    Procedure TestClass_Implementation;
     Procedure TestClass_Inheritance;
     Procedure TestClass_AbstractMethod;
     Procedure TestClass_CallInherited_NoParams;
@@ -5942,6 +5943,74 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestClass_Implementation;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'type',
+  '  TObject = class',
+  '    constructor Create;',
+  '  end;',
+  'implementation',
+  'type',
+  '  TIntClass = class',
+  '    constructor Create; reintroduce;',
+  '    class procedure DoGlob;',
+  '  end;',
+  'constructor tintclass.create;',
+  'begin',
+  '  inherited;',
+  '  inherited create;',
+  '  doglob;',
+  'end;',
+  'class procedure tintclass.doglob;',
+  'begin',
+  'end;',
+  'constructor tobject.create;',
+  'var',
+  '  iC: tintclass;',
+  'begin',
+  '  ic:=tintclass.create;',
+  '  tintclass.doglob;',
+  '  ic.doglob;',
+  'end;',
+  'initialization',
+  '  tintclass.doglob;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestClass_Implementation',
+    LinesToStr([ // statements
+    'var $impl = $mod.$impl;',
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function () {',
+    '    var iC = null;',
+    '    iC = $impl.TIntClass.$create("Create$1");',
+    '    $impl.TIntClass.DoGlob();',
+    '    iC.$class.DoGlob();',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$impl.TIntClass.DoGlob();',
+    '']),
+    LinesToStr([
+    'rtl.createClass($impl, "TIntClass", $mod.TObject, function () {',
+    '  this.Create$1 = function () {',
+    '    $mod.TObject.Create.apply(this, arguments);',
+    '    $mod.TObject.Create.call(this);',
+    '    this.$class.DoGlob();',
+    '  };',
+    '  this.DoGlob = function () {',
+    '  };',
+    '});',
+    '']));
+end;
+
 procedure TTestModule.TestClass_Inheritance;
 begin
   StartProgram(false);