From 8d2e9b2f75cbfd29d5f822eb4e4cd6489522c114 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Sat, 27 Jun 2020 07:02:42 +0000 Subject: [PATCH] pas2js: descend pascal class from jsfunction git-svn-id: trunk@45700 - --- packages/fcl-passrc/src/pasresolver.pp | 2 +- packages/pastojs/src/fppas2js.pp | 18 ++++--- packages/pastojs/tests/tcmodules.pas | 72 ++++++++++++++++++++++++++ utils/pas2js/dist/rtl.js | 38 +++++++++----- 4 files changed, 110 insertions(+), 20 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index a20ab5a974..ecb2e82ca4 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -28034,7 +28034,7 @@ var begin Result:=false; if aClass=nil then exit; - while (aClass<>nil) and aClass.IsExternal do + while aClass<>nil do begin if aClass.ExternalName=ExtName then exit(true); AncestorScope:=(aClass.CustomData as TPasClassScope).AncestorScope; diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 6f8594876e..6696b0bcab 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -2990,7 +2990,7 @@ begin if not aClass.IsExternal then exit; if aClass.Parent is TPasMembersType then exit; // nested class - if not IsExternalClass_Name(aClass,Data^.JSName) then exit; + if aClass.ExternalName<>Data^.JSName then exit; Data^.Found:=aClass; Data^.ElScope:=ElScope; Data^.StartScope:=StartScope; @@ -4333,12 +4333,12 @@ begin okClass: begin if (ClassScope.NewInstanceFunction=nil) + and (Proc.ClassType=TPasClassFunction) and (ClassScope.AncestorScope<>nil) and (TPasClassType(ClassScope.AncestorScope.Element).IsExternal) - and (Proc.ClassType=TPasClassFunction) and (Proc.Visibility in [visProtected,visPublic,visPublished]) and (TPasClassFunction(Proc).FuncType.ResultEl.ResultType=AClassOrRec) - and (Proc.Modifiers*[pmOverride,pmExternal]=[]) + and (Proc.Modifiers-[pmVirtual,pmAssembler]=[]) and (Proc.ProcType.Modifiers*[ptmOfObject]=[ptmOfObject]) then begin // The first non private class function in a Pascal class descending @@ -14374,7 +14374,7 @@ var AncestorPath, OwnerName, DestructorName, FnName, IntfKind: String; C: TClass; AssignSt: TJSSimpleAssignStatement; - NeedInitFunction, HasConstructor: Boolean; + NeedInitFunction, HasConstructor, IsJSFunction, NeedClassExt: Boolean; Proc: TPasProcedure; aResolver: TPas2JSResolver; begin @@ -14419,11 +14419,17 @@ begin Call:=CreateCallExpression(El); try AncestorIsExternal:=(Ancestor is TPasClassType) and TPasClassType(Ancestor).IsExternal; + IsJSFunction:=aResolver.IsExternalClass_Name(El,'Function'); + + NeedClassExt:=AncestorIsExternal or IsJSFunction; + if NeedClassExt and (El.ObjKind<>okClass) then + RaiseNotSupported(El,AContext,20200627083750); + if El.ObjKind=okInterface then FnName:=GetBIName(pbifnIntfCreate) else if El.ObjKind in okAllHelpers then FnName:=GetBIName(pbifnCreateHelper) - else if AncestorIsExternal then + else if NeedClassExt then FnName:=GetBIName(pbifnCreateClassExt) else FnName:=GetBIName(pbifnCreateClass); @@ -14462,7 +14468,7 @@ begin AncestorPath:=CreateReferencePath(Ancestor,AContext,rpkPathAndName); Call.AddArg(CreatePrimitiveDotExpr(AncestorPath,El)); - if AncestorIsExternal and (El.ObjKind=okClass) then + if NeedClassExt then begin // add the name of the NewInstance function if Scope.NewInstanceFunction<>nil then diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 2a20477b16..47adb79f7c 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -609,6 +609,7 @@ type Procedure TestExternalClass_NewInstance_NonVirtualFail; Procedure TestExternalClass_NewInstance_FirstParamNotString_Fail; Procedure TestExternalClass_NewInstance_SecondParamTyped_Fail; + Procedure TestExternalClass_JSFunctionPasDescendant; Procedure TestExternalClass_PascalProperty; Procedure TestExternalClass_TypeCastToRootClass; Procedure TestExternalClass_TypeCastToJSObject; @@ -17481,6 +17482,77 @@ begin ConvertProgram; end; +procedure TTestModule.TestExternalClass_JSFunctionPasDescendant; +begin + StartProgram(false); + Add([ + '{$modeswitch externalclass}', + 'type', + ' TJSFunction = class external name ''Function''', + ' end;', + ' TExtA = class external name ''ExtA''(TJSFunction)', + ' end;', + ' TBird = class (TExtA)', + ' public', + ' Size: word;', + ' class var Legs: word;', + ' constructor Create(a: word);', + ' end;', + ' TEagle = class (TBird)', + ' public', + ' constructor Create(b: word); reintroduce;', + ' end;', + 'constructor TBird.Create(a: word);', + 'begin', + 'end;', + 'constructor TEagle.Create(b: word);', + 'begin', + ' inherited Create(b);', + 'end;', + 'var', + ' Bird: TBird;', + ' Eagle: TEagle;', + 'begin', + ' Bird:=TBird.Create(3);', + ' Eagle:=TEagle.Create(4);', + ' Bird.Size:=Bird.Size+5;', + ' Bird.Legs:=Bird.Legs+6;', + ' Eagle.Size:=Eagle.Size+5;', + ' Eagle.Legs:=Eagle.Legs+6;', + '']); + ConvertProgram; + CheckSource('TestExternalClass_JSFunctionPasDescendant', + LinesToStr([ // statements + 'rtl.createClassExt($mod, "TBird", ExtA, "", function () {', + ' this.Legs = 0;', + ' this.$init = function () {', + ' this.Size = 0;', + ' };', + ' this.$final = function () {', + ' };', + ' this.Create = function (a) {', + ' return this;', + ' };', + '});', + 'rtl.createClassExt($mod, "TEagle", $mod.TBird, "", function () {', + ' this.Create$1 = function (b) {', + ' $mod.TBird.Create.call(this, b);', + ' return this;', + ' };', + '});', + 'this.Bird = null;', + 'this.Eagle = null;', + '']), + LinesToStr([ // $mod.$main + '$mod.Bird = $mod.TBird.$create("Create", [3]);', + '$mod.Eagle = $mod.TEagle.$create("Create$1", [4]);', + '$mod.Bird.Size = $mod.Bird.Size + 5;', + '$mod.TBird.Legs = $mod.Bird.Legs + 6;', + '$mod.Eagle.Size = $mod.Eagle.Size + 5;', + '$mod.TBird.Legs = $mod.Eagle.Legs + 6;', + ''])); +end; + procedure TTestModule.TestExternalClass_PascalProperty; begin StartProgram(false); diff --git a/utils/pas2js/dist/rtl.js b/utils/pas2js/dist/rtl.js index 05be95e4de..109acea58a 100644 --- a/utils/pas2js/dist/rtl.js +++ b/utils/pas2js/dist/rtl.js @@ -347,34 +347,41 @@ var rtl = { // Create a class using an external ancestor. // If newinstancefnname is given, use that function to create the new object. // If exist call BeforeDestruction and AfterConstruction. - var c = Object.create(ancestor); + var isFunc = rtl.isFunction(ancestor); + var c = null; + if (isFunc){ + // create pascal class descendent from JS function + c = Object.create(ancestor.prototype); + } else if (ancestor.$func){ + // create pascal class descendent from a pascal class descendent of a JS function + isFunc = true; + c = Object.create(ancestor); + c.$ancestor = ancestor; + } else { + c = Object.create(ancestor); + } c.$create = function(fn,args){ if (args == undefined) args = []; var o = null; if (newinstancefnname.length>0){ o = this[newinstancefnname](fn,args); - if (!o.$class){ - o.$class = this; - o.$classname = this.$classname; - o.$name = this.$name; - o.$fullname = this.$fullname; - o.$ancestor = this.$ancestor; - } + } else if(isFunc) { + o = new c.$func(args); } else { - o = Object.create(this); + o = Object.create(c); } - if (this.$init) this.$init.call(o); + if (o.$init) o.$init(); try{ if (typeof(fn)==="string"){ this[fn].apply(o,args); } else { fn.apply(o,args); }; - if (this.AfterConstruction) this.call.AfterConstruction(o); + if (o.AfterConstruction) o.AfterConstruction(); } catch($e){ // do not call BeforeDestruction - if (this.Destroy) this.Destroy.call(o); - if (this.$final) this.$final.call(o); + if (o.Destroy) o.Destroy(); + if (o.$final) o.$final(); throw $e; } return o; @@ -385,6 +392,11 @@ var rtl = { if (this.$final) this.$final(); }; rtl.initClass(c,parent,name,initfn); + if (isFunc){ + function f(){} + f.prototype = c; + c.$func = f; + } }, createHelper: function(parent,name,ancestor,initfn){