Browse Source

pastojs: fixed call inherited of nested class

mattias 3 years ago
parent
commit
bcea5581de
2 changed files with 76 additions and 17 deletions
  1. 9 16
      packages/pastojs/src/fppas2js.pp
  2. 67 1
      packages/pastojs/tests/tcmodules.pas

+ 9 - 16
packages/pastojs/src/fppas2js.pp

@@ -25437,24 +25437,17 @@ var
   procedure PrependClassOrRecName(var Path: string; ClassOrRec: TPasMembersType);
   procedure PrependClassOrRecName(var Path: string; ClassOrRec: TPasMembersType);
   begin
   begin
     if (ClassOrRec.ClassType=TPasClassType) and TPasClassType(ClassOrRec).IsExternal then
     if (ClassOrRec.ClassType=TPasClassType) and TPasClassType(ClassOrRec).IsExternal then
-      Prepend(Path,TPasClassType(ClassOrRec).ExternalName)
+      repeat
+        Prepend(Path,TPasClassType(ClassOrRec).ExternalName);
+        if ClassOrRec.Parent.ClassType=TPasClassType then
+          ClassOrRec := ClassOrRec.Parent as TPasClassType
+        else
+          break;
+      until false
     else
     else
       Prepend(Path,CreateGlobalTypePath(ClassOrRec,AContext));
       Prepend(Path,CreateGlobalTypePath(ClassOrRec,AContext));
   end;
   end;
 
 
-  procedure PrependClassOrRecNameFullPath(var Path: string; ClassOrRec: TPasMembersType);
-  begin
-    while True do
-    begin
-      PrependClassOrRecName(Path, ClassOrRec);
-
-      if ClassOrRec.Parent.ClassType=TPasClassType then
-        ClassOrRec := ClassOrRec.Parent as TPasClassType
-      else
-        Break;
-    end;
-  end;
-
   function NeedsWithExpr: boolean;
   function NeedsWithExpr: boolean;
   var
   var
     Parent: TPasElement;
     Parent: TPasElement;
@@ -25673,7 +25666,7 @@ begin
     // an external class -> use the literal
     // an external class -> use the literal
     Result:=TPasClassType(El).ExternalName;
     Result:=TPasClassType(El).ExternalName;
     if El.Parent is TPasMembersType then
     if El.Parent is TPasMembersType then
-      PrependClassOrRecNameFullPath(Result,TPasMembersType(El.Parent));
+      PrependClassOrRecName(Result,TPasMembersType(El.Parent));
     exit;
     exit;
     end
     end
   else if NeedsWithExpr then
   else if NeedsWithExpr then
@@ -25743,7 +25736,7 @@ begin
 
 
         if Full then
         if Full then
           begin
           begin
-          PrependClassOrRecNameFullPath(Result,TPasMembersType(ParentEl));
+          PrependClassOrRecName(Result,TPasMembersType(ParentEl));
           break;
           break;
           end;
           end;
 
 

+ 67 - 1
packages/pastojs/tests/tcmodules.pas

@@ -635,6 +635,7 @@ type
     Procedure TestNestedClass_Alias;
     Procedure TestNestedClass_Alias;
     Procedure TestNestedClass_Record;
     Procedure TestNestedClass_Record;
     Procedure TestNestedClass_Class;
     Procedure TestNestedClass_Class;
+    Procedure TestNestedClass_CallInherited;
 
 
     // external class
     // external class
     Procedure TestExternalClass_Var;
     Procedure TestExternalClass_Var;
@@ -18168,7 +18169,6 @@ end;
 
 
 procedure TTestModule.TestNestedClass_Class;
 procedure TTestModule.TestNestedClass_Class;
 begin
 begin
-  WithTypeInfo:=true;
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
   'type',
   'type',
@@ -18254,6 +18254,72 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestModule.TestNestedClass_CallInherited;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  TBird = class',
+  '  type',
+  '    TWing = class',
+  '      function Fly(w: word = 17): word; virtual;',
+  '    end;',
+  '  end;',
+  '  TEagle = class(TBird)',
+  '  type',
+  '    TEagleWing = class(TWing)',
+  '      function Fly(w: word): word; override;',
+  '    end;',
+  '  end;',
+  'function TBird.TWing.Fly(w: word): word;',
+  'begin',
+  'end;',
+  'function TEagle.TEagleWing.Fly(w: word): word;',
+  'begin',
+  '  inherited;',
+  '  inherited Fly;',
+  '  inherited Fly(3);',
+  '  Result:=inherited Fly;',
+  '  Result:=inherited Fly(4);',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestNestedClass_CallInherited',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass(this, "TBird", this.TObject, function () {',
+    '  rtl.createClass(this, "TWing", $mod.TObject, function () {',
+    '    this.Fly = function (w) {',
+    '      var Result = 0;',
+    '      return Result;',
+    '    };',
+    '  }, "TBird.TWing");',
+    '});',
+    'rtl.createClass(this, "TEagle", this.TBird, function () {',
+    '  rtl.createClass(this, "TEagleWing", this.TWing, function () {',
+    '    this.Fly = function (w) {',
+    '      var Result = 0;',
+    '      $mod.TBird.TWing.Fly.apply(this, arguments);',
+    '      $mod.TBird.TWing.Fly.call(this, 17);',
+    '      $mod.TBird.TWing.Fly.call(this, 3);',
+    '      Result = $mod.TBird.TWing.Fly.call(this, 17);',
+    '      Result = $mod.TBird.TWing.Fly.call(this, 4);',
+    '      return Result;',
+    '    };',
+    '  }, "TEagle.TEagleWing");',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestExternalClass_Var;
 procedure TTestModule.TestExternalClass_Var;
 begin
 begin
   StartProgram(false);
   StartProgram(false);