paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-19 18:51:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: fixed class property getter static

Browse Source
This commit is contained in:
mattias 2021-10-25 21:41:27 +02:00
parent baa28faa19
commit 5c7974fceb
3 changed files with 116 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -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',
'']);

5
packages/pastojs/src/fppas2js.pp
View File

@ -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;

110
packages/pastojs/tests/tcmodules.pas
View File

@ -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);