From 00ed18a61b18a83c4cd730aa44a20f69f5831199 Mon Sep 17 00:00:00 2001
From: mattias <nc-gaertnma@netcologne.de>
Date: Mon, 3 Feb 2025 13:59:43 +0100
Subject: [PATCH] pastojs: rtti flag for class property

---
 packages/pastojs/src/fppas2js.pp     |  3 ++
 packages/pastojs/tests/tcmodules.pas | 59 ++++++++++++++++++++++++++++
 2 files changed, 62 insertions(+)

diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp
index 30c753ca6c..74eff83096 100644
--- a/packages/pastojs/src/fppas2js.pp
+++ b/packages/pastojs/src/fppas2js.pp
@@ -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
diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas
index 29ef892791..6325f68e8d 100644
--- a/packages/pastojs/tests/tcmodules.pas
+++ b/packages/pastojs/tests/tcmodules.pas
@@ -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;