From 27bb90fcc8846c294fd664d5ec06ad7dbcc958b0 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Sun, 28 Jun 2020 15:55:31 +0000 Subject: [PATCH] pas2js: Pascal descendent from JS function: inherited calls ancestor function git-svn-id: trunk@45708 - --- packages/fcl-json/src/fpjson.pp | 2 +- packages/fcl-passrc/src/pasresolver.pp | 4 +- packages/pastojs/src/fppas2js.pp | 68 ++++++++++++++++---------- packages/pastojs/tests/tcmodules.pas | 4 ++ 4 files changed, 48 insertions(+), 30 deletions(-) diff --git a/packages/fcl-json/src/fpjson.pp b/packages/fcl-json/src/fpjson.pp index c9a2879d79..ff2ac38418 100644 --- a/packages/fcl-json/src/fpjson.pp +++ b/packages/fcl-json/src/fpjson.pp @@ -1048,7 +1048,7 @@ begin TJSONData.DoError(SErrNoParserHandler) else begin - Setlength(S,JSON.Size); + Setlength(S{%H-},JSON.Size); if Length(S)>0 then JSON.ReadBuffer(S[1],Length(S)); end; diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index ecb2e82ca4..c7c4bf09d9 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -15919,7 +15919,7 @@ begin IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches; try - SetLength(InferenceTypes,TemplTypes.Count); + SetLength(InferenceTypes{%H-},TemplTypes.Count); for i:=0 to TemplTypes.Count-1 do InferenceTypes[i]:=Default(TInferredType); @@ -28223,7 +28223,7 @@ begin ['type with '+IntToStr(Params.Count)+' generic template(s)', GenericEl.Name+GetGenericParamCommas(GenericTemplateList.Count)],El); - SetLength(ParamsResolved,Params.Count); + SetLength(ParamsResolved{%H-},Params.Count); IsSelf:=true; for i:=0 to Params.Count-1 do begin diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 6696b0bcab..16ba55ecc7 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -563,6 +563,7 @@ type pbifnBitwiseNativeIntXor, pbifnCheckMethodCall, pbifnCheckVersion, + pbifnClassAncestorFunc, pbifnClassInstanceFree, pbifnClassInstanceNew, pbifnCreateClass, @@ -742,6 +743,7 @@ const 'xor', // pbifnBitwiseNativeIntXor, 'checkMethodCall', // pbifnCheckMethodCall 'checkVersion', // pbifnCheckVersion + '$func', // pbifnClassAncestorFunc '$destroy', // pbifnClassInstanceFree '$create', // pbifnClassInstanceNew 'createClass', // pbifnCreateClass rtl.createClass @@ -9691,36 +9693,48 @@ function TPasToJSConverter.ConvertInheritedExpr(El: TInheritedExpr; DoError(20170418204325,nNestedInheritedNeedsParameters,sNestedInheritedNeedsParameters, [],El); - if (AncestorProc.Parent is TPasClassType) - and TPasClassType(AncestorProc.Parent).IsExternal then - begin - // ancestor is in an external class - // They could be overriden, without a Pascal declaration - // -> use the direct ancestor class of the current proc - aClass:=SelfContext.ThisPas as TPasClassType; - if aClass.CustomData=nil then - RaiseInconsistency(20170323111252,aClass); - ClassScope:=TPasClassScope(aClass.CustomData); - AncestorScope:=ClassScope.AncestorScope; - if AncestorScope=nil then - RaiseInconsistency(20170323111306,aClass); - AncestorClass:=AncestorScope.Element as TPasClassType; - FunName:=CreateReferencePath(AncestorClass,AContext,rpkPathAndName,true) - +'.'+TransformVariableName(AncestorProc,AContext); - end - else - FunName:=CreateReferencePath(AncestorProc,AContext,rpkPathAndName,true); - if AncestorProc.ProcType.Args.Count=0 then - Apply:=false; - if Apply and (SelfContext=AContext) then - // create "ancestor.funcname.apply(this,arguments)" - FunName:=FunName+'.apply' - else - // create "ancestor.funcname.call(this,param1,param2,...)" - FunName:=FunName+'.call'; Call:=nil; try Call:=CreateCallExpression(ParentEl); + if (AncestorProc.Parent is TPasClassType) + and TPasClassType(AncestorProc.Parent).IsExternal then + begin + // ancestor is in an external class + // They could be overriden, without a Pascal declaration + // -> use the direct ancestor class of the current proc + aClass:=SelfContext.ThisPas as TPasClassType; + if aClass.CustomData=nil then + RaiseInconsistency(20170323111252,aClass); + ClassScope:=TPasClassScope(aClass.CustomData); + AncestorScope:=ClassScope.AncestorScope; + if AncestorScope=nil then + RaiseInconsistency(20170323111306,aClass); + AncestorClass:=AncestorScope.Element as TPasClassType; + if (AncestorProc.ClassType=TPasConstructor) and SameText(AncestorProc.Name,'new') + and AContext.Resolver.IsExternalClass_Name(TPasClassType(AncestorProc.Parent),'Function') then + begin + // calling ancestor new constructor + // this.$func(param1,param2,...) + FunName:='this.'+GetBIName(pbifnClassAncestorFunc); + Call.Expr:=CreatePrimitiveDotExpr(FunName,ParentEl); + CreateProcedureCall(Call,ParamsExpr,AncestorProc.ProcType,AContext); + Result:=Call; + exit; + end + else + FunName:=CreateReferencePath(AncestorClass,AContext,rpkPathAndName,true) + +'.'+TransformVariableName(AncestorProc,AContext); + end + else + FunName:=CreateReferencePath(AncestorProc,AContext,rpkPathAndName,true); + if AncestorProc.ProcType.Args.Count=0 then + Apply:=false; + if Apply and (SelfContext=AContext) then + // create "ancestor.funcname.apply(this,arguments)" + FunName:=FunName+'.apply' + else + // create "ancestor.funcname.call(this,param1,param2,...)" + FunName:=FunName+'.call'; Call.Expr:=CreatePrimitiveDotExpr(FunName,ParentEl); Call.AddArg(CreatePrimitiveDotExpr(SelfName,ParentEl)); if Apply then diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 47adb79f7c..295e641bbf 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -17491,6 +17491,7 @@ begin ' TJSFunction = class external name ''Function''', ' end;', ' TExtA = class external name ''ExtA''(TJSFunction)', + ' constructor New(w: word);', ' end;', ' TBird = class (TExtA)', ' public', @@ -17504,6 +17505,8 @@ begin ' end;', 'constructor TBird.Create(a: word);', 'begin', + ' inherited;', // silently ignored + ' inherited New(a);', // this.$func(a) 'end;', 'constructor TEagle.Create(b: word);', 'begin', @@ -17531,6 +17534,7 @@ begin ' this.$final = function () {', ' };', ' this.Create = function (a) {', + ' this.$func(a);', ' return this;', ' };', '});',