Browse Source

pastojs: calling constructor of nested external class, issue 38858

mattias 3 years ago
parent
commit
e8f9ffdb5e
2 changed files with 85 additions and 2 deletions
  1. 17 2
      packages/pastojs/src/fppas2js.pp
  2. 68 0
      packages/pastojs/tests/tcmodules.pas

+ 17 - 2
packages/pastojs/src/fppas2js.pp

@@ -25203,6 +25203,19 @@ var
       Prepend(Path,CreateGlobalTypePath(ClassOrRec,AContext));
   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;
   var
     Parent: TPasElement;
@@ -25420,6 +25433,8 @@ begin
     begin
     // an external class -> use the literal
     Result:=TPasClassType(El).ExternalName;
+    if El.Parent is TPasMembersType then
+      PrependClassOrRecNameFullPath(Result,TPasMembersType(El.Parent));
     exit;
     end
   else if NeedsWithExpr then
@@ -25489,7 +25504,7 @@ begin
 
         if Full then
           begin
-          PrependClassOrRecName(Result,TPasMembersType(ParentEl));
+          PrependClassOrRecNameFullPath(Result,TPasMembersType(ParentEl));
           break;
           end;
 
@@ -25554,7 +25569,7 @@ begin
           end
         else if (ParentEl.ClassType=TPasClassType) and TPasClassType(ParentEl).IsExternal then
           begin
-          Prepend(Result,TPasClassType(ParentEl).ExternalName);
+          PrependClassOrRecName(Result,TPasClassType(ParentEl));
           break;
           end
         else if coShortRefGlobals in Options then

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

@@ -650,6 +650,7 @@ type
     Procedure TestExternalClass_ForInJSObject;
     Procedure TestExternalClass_ForInJSArray;
     Procedure TestExternalClass_IncompatibleArgDuplicateIdentifier;
+    Procedure TestExternalClass_NestedConstructor;
 
     // class interfaces
     Procedure TestClassInterface_Corba;
@@ -19525,6 +19526,73 @@ begin
   ConvertUnit;
 end;
 
+procedure TTestModule.TestExternalClass_NestedConstructor;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSObject = class external name ''Object''',
+  '    type TBird = class external name ''Bird''',
+  '      type TWing = class external name ''Wing''',
+  '        constructor New;',
+  '        constructor Create(w: word = 3);',
+  '      end;',
+  '    end;',
+  '  end;',
+  'var',
+  '  w: TJSObject.TBird.TWing;',
+  'begin',
+  '  w:=tjsobject.tbird.twing.new;',
+  '  w:=tjsobject.tbird.twing.new();',
+  '  w:=tjsobject.tbird.twing.create;',
+  '  w:=tjsobject.tbird.twing.create(4);',
+  '  with tjsobject do begin',
+  '    w:=tbird.twing.new;',
+  '    w:=tbird.twing.new();',
+  '    w:=tbird.twing.create;',
+  '    w:=tbird.twing.create(11);',
+  '  end;',
+  '  with tjsobject.tbird do begin',
+  '    w:=twing.new;',
+  '    w:=twing.new();',
+  '    w:=twing.create;',
+  '    w:=twing.create(21);',
+  '  end;',
+  '  with tjsobject.tbird.twing do begin',
+  '    w:=new;',
+  '    w:=new();',
+  '    w:=create;',
+  '    w:=create(31);',
+  '  end;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestExternalClass_NestedConstructor',
+    LinesToStr([ // statements
+    'this.w = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.w = new Object.Bird.Wing();',
+    '$mod.w = new Object.Bird.Wing();',
+    '$mod.w = new Object.Bird.Wing.Create();',
+    '$mod.w = new Object.Bird.Wing.Create(4);',
+    '$mod.w = new Object.Bird.Wing();',
+    '$mod.w = new Object.Bird.Wing();',
+    '$mod.w = new Object.Bird.Wing.Create();',
+    '$mod.w = new Object.Bird.Wing.Create(11);',
+    'var $with = Object.Bird;',
+    '$mod.w = new Object.Bird.Wing();',
+    '$mod.w = new Object.Bird.Wing();',
+    '$mod.w = new Object.Bird.Wing.Create();',
+    '$mod.w = new Object.Bird.Wing.Create(21);',
+    'var $with1 = Object.Bird.Wing;',
+    '$mod.w = new $with1();',
+    '$mod.w = new $with1();',
+    '$mod.w = new Object.Bird.Wing.Create();',
+    '$mod.w = new Object.Bird.Wing.Create(31);',
+    '']));
+end;
+
 procedure TTestModule.TestClassInterface_Corba;
 begin
   StartProgram(false);