paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 22:47:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: rtti flag for class property

Browse Source
This commit is contained in:
mattias 2025-02-03 13:59:43 +01:00
parent 2b6c136d01
commit 00ed18a61b
2 changed files with 62 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2385,6 +2385,7 @@ type
pfStoredFunction = 12; // stored function, function name is in Stored
pfHasIndex = 16; { if getter is function, append Index as last param
if setter is function, append Index as second last param }
pfClassProperty = 32; // class property
type
TMethodKind = (
mkProcedure, // 0 default
@ -21127,6 +21128,8 @@ begin
inc(Flags,pfStoredField);
end;
end;
if Prop.IsClass then
inc(Flags,pfClassProperty);
Call.AddArg(CreateLiteralNumber(Prop,Flags));
// add type

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

@ -886,6 +886,7 @@ type
Procedure TestRTTI_Class_Property;
Procedure TestRTTI_Class_PropertyParams;
Procedure TestRTTI_Class_PropertyPrivate;
Procedure TestRTTI_Class_ClassProperty;
Procedure TestRTTI_Class_OtherUnit_TypeAlias;
Procedure TestRTTI_Class_OmitRTTI;
Procedure TestRTTI_Class_Field_AnonymousArrayOfSelfClass;
@ -32064,6 +32065,64 @@ begin
'']));
end;
procedure TTestModule.TestRTTI_Class_ClassProperty;
begin
WithTypeInfo:=true;
StartProgram(false);
Add('type');
Add('{$RTTI explicit properties([vcPrivate,vcProtected,vcPublic,vcPublished])}');
Add(' TObject = class');
Add(' private');
Add(' class var FWord: word;');
Add(' class function GetWord: word; virtual; abstract;');
Add(' class procedure SetWord(Value: word); virtual; abstract;');
Add(' class property PrivateWord: word read FWord write FWord;');
Add(' protected');
Add(' class property ProtectedWord: word read FWord write SetWord;');
Add(' public');
Add(' class property PublicWord: word read GetWord;');
Add(' end;');
Add('begin');
ConvertProgram;
CheckSource('TestRTTI_Class_ClassProperty',
LinesToStr([ // statements
'rtl.createClass(this, "TObject", null, function () {',
' this.FWord = 0;',
' this.$init = function () {',
' };',
' this.$final = function () {',
' };',
' var $r = this.$rtti;',
' $r.addProperty(',
' "PrivateWord",',
' 32,',
' rtl.word,',
' "FWord",',
' "FWord",',
' 0',
' );',
' $r.addProperty(',
' "ProtectedWord",',
' 34,',
' rtl.word,',
' "FWord",',
' "SetWord",',
' 1',
' );',
' $r.addProperty(',
' "PublicWord",',
' 33,',
' rtl.word,',
' "GetWord",',
' "",',
' 2',
' );',
'});',
'']),
LinesToStr([ // $mod.$main
'']));
end;
procedure TTestModule.TestRTTI_Class_OtherUnit_TypeAlias;
begin
WithTypeInfo:=true;