From 30949ac5eb7bbcfae4389ed903902a290edbd724 Mon Sep 17 00:00:00 2001 From: mattias Date: Thu, 26 Sep 2019 07:37:38 +0000 Subject: [PATCH] pastojs: external static method --- compiler/packages/pastojs/src/fppas2js.pp | 51 +++++++--- compiler/packages/pastojs/tests/tcmodules.pas | 99 ++++++++++++++----- 2 files changed, 111 insertions(+), 39 deletions(-) diff --git a/compiler/packages/pastojs/src/fppas2js.pp b/compiler/packages/pastojs/src/fppas2js.pp index 16217ff..e8f7b41 100644 --- a/compiler/packages/pastojs/src/fppas2js.pp +++ b/compiler/packages/pastojs/src/fppas2js.pp @@ -20756,6 +20756,20 @@ var aPath:=Prefix+aPath; end; + function PrependClassName(var Path: string; ClassOrRec: TPasMembersType): boolean; + begin + if (ClassOrRec.ClassType=TPasClassType) and TPasClassType(ClassOrRec).IsExternal then + begin + Prepend(Path,TPasClassType(ClassOrRec).ExternalName); + Result:=true; + end + else + begin + Prepend(Path,ClassOrRec.Name); + Result:=false; + end; + end; + function NeedsWithExpr: boolean; var Parent: TPasElement; @@ -20966,11 +20980,17 @@ begin begin // redirect to helper-for-type ParentEl:=aResolver.ResolveAliasType(TPasClassType(ParentEl).HelperForType); + IsClassRec:=(ParentEl.ClassType=TPasClassType) + or (ParentEl.ClassType=TPasRecordType); + if not IsClassRec then + RaiseNotSupported(El,AContext,20190926091356); ShortName:=AContext.GetLocalName(ParentEl); end; if Full then - Prepend(Result,ParentEl.Name) + begin + if PrependClassName(Result,TPasMembersType(ParentEl)) then break; + end else begin // Not in a Pascal dotscope and accessing a class member. @@ -20980,14 +21000,18 @@ begin if ShortName<>'' then Prepend(Result,ShortName) else if El is TPasType then - Prepend(Result,ParentEl.Name) + begin + if PrependClassName(Result,TPasMembersType(ParentEl)) then break; + end else if El.Parent<>ParentEl then - Prepend(Result,ParentEl.Name) + begin + if PrependClassName(Result,TPasMembersType(ParentEl)) then break; + end else if (ParentEl.ClassType=TPasClassType) and (TPasClassType(ParentEl).HelperForType<>nil) then begin // helpers have no self - Prepend(Result,ParentEl.Name); + if PrependClassName(Result,TPasMembersType(ParentEl)) then break; end else if (SelfContext<>nil) and IsA(TPasType(SelfContext.ThisPas),TPasType(ParentEl)) then @@ -20997,16 +21021,17 @@ begin end else begin + if PrependClassName(Result,TPasMembersType(ParentEl)) then break; // missing JS var for Self - {$IFDEF VerbosePas2JS} - {AllowWriteln} - writeln('TPasToJSConverter.CreateReferencePath missing JS var for Self: El=',GetElementDbgPath(El),':',El.ClassName,' CurParentEl=',GetElementDbgPath(ParentEl),':',ParentEl.ClassName,' AContext:'); - AContext.WriteStack; - if Ref<>nil then - writeln('TPasToJSConverter.CreateReferencePath Ref=',GetObjName(Ref.Element),' at ',aResolver.GetElementSourcePosStr(Ref.Element)); - {AllowWriteln-} - {$ENDIF} - RaiseNotSupported(El,AContext,20180125004049); + //{$IFDEF VerbosePas2JS} + //{AllowWriteln} + //writeln('TPasToJSConverter.CreateReferencePath missing JS var for Self: El=',GetElementDbgPath(El),':',El.ClassName,' CurParentEl=',GetElementDbgPath(ParentEl),':',ParentEl.ClassName,' AContext:'); + //AContext.WriteStack; + //if Ref<>nil then + // writeln('TPasToJSConverter.CreateReferencePath Ref=',GetObjName(Ref.Element),' at ',aResolver.GetElementSourcePosStr(Ref.Element)); + //{AllowWriteln-} + //{$ENDIF} + //RaiseNotSupported(El,AContext,20180125004049); end; if (El.Parent=ParentEl) and (SelfContext<>nil) and not IsClassFunction(SelfContext.PasElement) then diff --git a/compiler/packages/pastojs/tests/tcmodules.pas b/compiler/packages/pastojs/tests/tcmodules.pas index d01f8f8..9fde99a 100644 --- a/compiler/packages/pastojs/tests/tcmodules.pas +++ b/compiler/packages/pastojs/tests/tcmodules.pas @@ -563,6 +563,7 @@ type Procedure TestExternalClass_DuplicateVarFail; Procedure TestExternalClass_Method; Procedure TestExternalClass_ClassMethod; + Procedure TestExternalClass_ClassMethodStatic; Procedure TestExternalClass_FunctionResultInTypeCast; Procedure TestExternalClass_NonExternalOverride; Procedure TestExternalClass_OverloadHint; @@ -15381,14 +15382,17 @@ begin ' class procedure DoIt(Id: longint = 1); external name ''$Execute'';', ' end;', ' TExtB = TExtA;', + 'var p: Pointer;', 'begin', ' texta.doit;', ' texta.doit();', ' texta.doit(2);', + ' p:=@TExtA.DoIt;', ' with texta do begin', ' doit;', ' doit();', ' doit(3);', + ' p:=@DoIt;', ' end;', ' textb.doit;', ' textb.doit();', @@ -15402,14 +15406,17 @@ begin ConvertProgram; CheckSource('TestExternalClass_ClassMethod', LinesToStr([ // statements + 'this.p = null;', '']), LinesToStr([ // $mod.$main 'ExtObj.$Execute(1);', 'ExtObj.$Execute(1);', 'ExtObj.$Execute(2);', + '$mod.p = rtl.createCallback(ExtObj, "$Execute");', 'ExtObj.$Execute(1);', 'ExtObj.$Execute(1);', 'ExtObj.$Execute(3);', + '$mod.p = rtl.createCallback(ExtObj, "$Execute");', 'ExtObj.$Execute(1);', 'ExtObj.$Execute(1);', 'ExtObj.$Execute(4);', @@ -15419,6 +15426,45 @@ begin ''])); end; +procedure TTestModule.TestExternalClass_ClassMethodStatic; +begin + StartProgram(false); + Add([ + '{$modeswitch externalclass}', + 'type', + ' TExtA = class external name ''ExtObj''', + ' class procedure DoIt(Id: longint = 1); static;', + ' end;', + 'var p: Pointer;', + 'begin', + ' texta.doit;', + ' texta.doit();', + ' texta.doit(2);', + ' p:=@TExtA.DoIt;', + ' with texta do begin', + ' doit;', + ' doit();', + ' doit(3);', + ' p:=@DoIt;', + ' end;', + '']); + ConvertProgram; + CheckSource('TestExternalClass_ClassMethodStatic', + LinesToStr([ // statements + 'this.p = null;', + '']), + LinesToStr([ // $mod.$main + 'ExtObj.DoIt(1);', + 'ExtObj.DoIt(1);', + 'ExtObj.DoIt(2);', + '$mod.p = ExtObj.DoIt;', + 'ExtObj.DoIt(1);', + 'ExtObj.DoIt(1);', + 'ExtObj.DoIt(3);', + '$mod.p = ExtObj.DoIt;', + ''])); +end; + procedure TTestModule.TestExternalClass_FunctionResultInTypeCast; begin StartProgram(false); @@ -15467,32 +15513,33 @@ end; procedure TTestModule.TestExternalClass_NonExternalOverride; begin StartProgram(false); - Add('{$modeswitch externalclass}'); - Add('type'); - Add(' TExtA = class external name ''ExtObjA'''); - Add(' procedure ProcA; virtual;'); - Add(' procedure ProcB; virtual;'); - Add(' end;'); - Add(' TExtB = class external name ''ExtObjB'' (TExtA)'); - Add(' end;'); - Add(' TExtC = class (TExtB)'); - Add(' procedure ProcA; override;'); - Add(' end;'); - Add('procedure TExtC.ProcA;'); - Add('begin'); - Add(' ProcA;'); - Add(' Self.ProcA;'); - Add(' ProcB;'); - Add(' Self.ProcB;'); - Add('end;'); - Add('var'); - Add(' A: texta;'); - Add(' B: textb;'); - Add(' C: textc;'); - Add('begin'); - Add(' a.proca;'); - Add(' b.proca;'); - Add(' c.proca;'); + Add([ + '{$modeswitch externalclass}', + 'type', + ' TExtA = class external name ''ExtObjA''', + ' procedure ProcA; virtual;', + ' procedure ProcB; virtual;', + ' end;', + ' TExtB = class external name ''ExtObjB'' (TExtA)', + ' end;', + ' TExtC = class (TExtB)', + ' procedure ProcA; override;', + ' end;', + 'procedure TExtC.ProcA;', + 'begin', + ' ProcA;', + ' Self.ProcA;', + ' ProcB;', + ' Self.ProcB;', + 'end;', + 'var', + ' A: texta;', + ' B: textb;', + ' C: textc;', + 'begin', + ' a.proca;', + ' b.proca;', + ' c.proca;']); ConvertProgram; CheckSource('TestExternalClass_NonExternalOverride', LinesToStr([ // statements