From bcea5581def3f663a2fa52bca29f7e2191e7e45e Mon Sep 17 00:00:00 2001 From: mattias Date: Sun, 22 May 2022 19:56:39 +0200 Subject: [PATCH] pastojs: fixed call inherited of nested class --- packages/pastojs/src/fppas2js.pp | 25 ++++------ packages/pastojs/tests/tcmodules.pas | 68 +++++++++++++++++++++++++++- 2 files changed, 76 insertions(+), 17 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index d852d77884..601a62c86b 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -25437,24 +25437,17 @@ var procedure PrependClassOrRecName(var Path: string; ClassOrRec: TPasMembersType); begin 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 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; @@ -25673,7 +25666,7 @@ begin // an external class -> use the literal Result:=TPasClassType(El).ExternalName; if El.Parent is TPasMembersType then - PrependClassOrRecNameFullPath(Result,TPasMembersType(El.Parent)); + PrependClassOrRecName(Result,TPasMembersType(El.Parent)); exit; end else if NeedsWithExpr then @@ -25743,7 +25736,7 @@ begin if Full then begin - PrependClassOrRecNameFullPath(Result,TPasMembersType(ParentEl)); + PrependClassOrRecName(Result,TPasMembersType(ParentEl)); break; end; diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 52849b9198..db1dbbd6fc 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -635,6 +635,7 @@ type Procedure TestNestedClass_Alias; Procedure TestNestedClass_Record; Procedure TestNestedClass_Class; + Procedure TestNestedClass_CallInherited; // external class Procedure TestExternalClass_Var; @@ -18168,7 +18169,6 @@ end; procedure TTestModule.TestNestedClass_Class; begin - WithTypeInfo:=true; StartProgram(false); Add([ 'type', @@ -18254,6 +18254,72 @@ begin ''])); 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; begin StartProgram(false);