From 5c7974fceb768f96853b4abc05cb122ac8ccfd0c Mon Sep 17 00:00:00 2001 From: mattias Date: Mon, 25 Oct 2021 21:41:27 +0200 Subject: [PATCH] pastojs: fixed class property getter static --- packages/fcl-passrc/tests/tcresolver.pas | 8 +- packages/pastojs/src/fppas2js.pp | 5 +- packages/pastojs/tests/tcmodules.pas | 110 ++++++++++++++++++++++- 3 files changed, 116 insertions(+), 7 deletions(-) diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index b7f468ffc4..058aa63ff1 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -985,7 +985,7 @@ type Procedure TestLibrary_ExportFunc; Procedure TestLibrary_ExportFunc_NameIntFail; Procedure TestLibrary_ExportFunc_IndexStringFail; - Procedure TestLibrary_ExportVar; // ToDo + Procedure TestLibrary_ExportVar; Procedure TestLibrary_ExportLocalFuncFail; Procedure TestLibrary_Initialization_Finalization; Procedure TestLibrary_ExportFuncOverloadFail; @@ -18839,15 +18839,15 @@ end; procedure TTestResolver.TestLibrary_ExportVar; begin - exit; - StartLibrary(false); Add([ 'var', ' Size: word; export name ''size'';', + ' Fly: string;', + ' Run: word;', 'exports', ' Size,', - ' Fly as ''FlyHi'',', + ' Fly name ''FlyHi'',', ' Run index 3+4;', 'begin', '']); diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 656a8387d3..0baa051e0e 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -9955,7 +9955,10 @@ begin begin // a.StaticProc -> pas.unit1.aclass.StaticProc(defaultargs) // ToDo: check if left side has only types (no call nor field) - Result:=ConvertIdentifierExpr(RightEl,TPrimitiveExpr(RightEl).Value,aContext); + if Assigned(OnConvertRight) then + Result:=OnConvertRight(RightEl,AContext,Data) + else + Result:=ConvertIdentifierExpr(RightEl,TPrimitiveExpr(RightEl).Value,AContext); exit; end; end; diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 828d6b1d2b..dc0a946f26 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -525,9 +525,10 @@ type Procedure TestClasS_CallInheritedConstructor; Procedure TestClass_ClassVar_Assign; Procedure TestClass_CallClassMethod; - Procedure TestClass_CallClassMethodStatic; // ToDo + Procedure TestClass_CallClassMethodStatic; Procedure TestClass_Property; Procedure TestClass_Property_ClassMethod; + Procedure TestClass_Property_ClassMethodStatic; Procedure TestClass_Property_Indexed; Procedure TestClass_Property_IndexSpec; Procedure TestClass_PropertyOfTypeArray; @@ -912,7 +913,7 @@ type Procedure TestLibrary_Empty; Procedure TestLibrary_ExportFunc; Procedure TestLibrary_Export_Index_Fail; - Procedure TestLibrary_ExportVar; // ToDo + Procedure TestLibrary_ExportVar; Procedure TestLibrary_ExportUnitFunc; // ToDo: test delayed specialization init // ToDo: analyzer @@ -14033,6 +14034,111 @@ begin ''])); end; +procedure TTestModule.TestClass_Property_ClassMethodStatic; +begin + StartProgram(false); + Add([ + 'type', + ' TObject = class', + ' class function GetInt: longint; static;', + ' class procedure SetInt(Value: longint); static;', + ' class function GetItems(Index: word): longint; static;', + ' class procedure SetItems(Index: word; const Value: longint); static;', + ' end;', + ' TBird = class', + ' class procedure Fly;', + ' class property IntA: longint read GetInt write SetInt;', + ' class property Items[Index: word]: longint read GetItems write SetItems;', + ' end;', + 'class function tobject.getint: longint;', + 'begin', + 'end;', + 'class procedure tobject.setint(value: longint);', + 'begin', + 'end;', + 'class function tobject.GetItems(Index: word): longint;', + 'begin', + 'end;', + 'class procedure TObject.SetItems(Index: word; const Value: longint);', + 'begin', + 'end;', + 'class procedure tbird.fly;', + 'var w: longint;', + 'begin', + ' inta:=inta+51;', + ' w:=items[52];', + ' items[53]:=54;', + 'end;', + 'var Obj: tbird;', + ' i: longint;', + 'begin', + ' tbird.inta:=tbird.inta+1;', + ' i:=tbird.items[2];', + ' tbird.items[3]:=4;', + ' obj.inta:=obj.inta+11;', + ' i:=obj.items[12];', + ' obj.items[13]:=14;', + ' with Tbird do begin', + ' inta:=inta+21;', + ' i:=items[22];', + ' items[23]:=24;', + ' end;', + ' with Obj do begin', + ' inta:=inta+31;', + ' i:=items[32];', + ' items[33]:=34;', + ' end;', + '']); + ConvertProgram; + CheckSource('TestClass_Property_ClassMethod', + LinesToStr([ // statements + 'rtl.createClass(this, "TObject", null, function () {', + ' this.$init = function () {', + ' };', + ' this.$final = function () {', + ' };', + ' this.GetInt = function () {', + ' var Result = 0;', + ' return Result;', + ' };', + ' this.SetInt = function (Value) {', + ' };', + ' this.GetItems = function (Index) {', + ' var Result = 0;', + ' return Result;', + ' };', + ' this.SetItems = function (Index, Value) {', + ' };', + '});', + 'rtl.createClass(this, "TBird", this.TObject, function () {', + ' this.Fly = function () {', + ' var w = 0;', + ' this.SetInt(this.GetInt() + 51);', + ' w = this.GetItems(52);', + ' this.SetItems(53, 54);', + ' };', + '});', + 'this.Obj = null;', + 'this.i = 0;', + '']), + LinesToStr([ // $mod.$main + '$mod.TObject.SetInt($mod.TObject.GetInt() + 1);', + '$mod.i = $mod.TObject.GetItems(2);', + '$mod.TObject.SetItems(3, 4);', + '$mod.TObject.SetInt($mod.TObject.GetInt() + 11);', + '$mod.i = $mod.TObject.GetItems(12);', + '$mod.TObject.SetItems(13, 14);', + 'var $with = $mod.TBird;', + '$with.SetInt($with.GetInt() + 21);', + '$mod.i = $with.GetItems(22);', + '$with.SetItems(23, 24);', + 'var $with1 = $mod.Obj;', + '$with1.SetInt($with1.GetInt() + 31);', + '$mod.i = $with1.GetItems(32);', + '$with1.SetItems(33, 34);', + ''])); +end; + procedure TTestModule.TestClass_Property_Indexed; begin StartProgram(false);