Support stringifying simple getter methods for classes

EricGrange · Jan 25, 2022 · 55eca20 · 55eca20
1 parent cdcc279
commit 55eca20
Show file tree

Hide file tree

Showing 3 changed files with 73 additions and 4 deletions.
diff --git a/Source/dwsJSONScript.pas b/Source/dwsJSONScript.pas
@@ -62,7 +62,9 @@ implementation
 // ------------------------------------------------------------------
 // ------------------------------------------------------------------
 
-uses dwsCompilerUtils, dwsConstExprs, dwsArrayElementContext;
+uses
+   dwsCompilerUtils, dwsConstExprs, dwsArrayElementContext,
+   dwsInfo, dwsInfoClasses;
 
 // ------------------
 // ------------------ JSONScript ------------------
@@ -319,7 +321,14 @@ class procedure JSONScript.StringifyComposite(exec : TdwsExecution;
    fieldSym : TFieldSymbol;
    propSym : TPropertySymbol;
    locData : IDataContext;
+   progInfo : TProgramInfo;
+   info : IInfo;
+   scriptObj : IScriptObj;
 begin
+   if exec is TdwsProgramExecution then
+      progInfo := TdwsProgramExecution(exec).ProgramInfo
+   else progInfo := nil;
+
    writer.BeginObject;
    while compSym <> nil do begin
       for i:=0 to compSym.Members.Count-1 do begin
@@ -340,9 +349,18 @@ class procedure JSONScript.StringifyComposite(exec : TdwsExecution;
             fieldSym:=TFieldSymbol(sym);
             dataPtr.CreateOffset(fieldSym.Offset, locData);
             StringifySymbol(exec, writer, fieldSym.Typ, locData);
-         end else begin
-   //         SetLength(bufData, sym.Typ.Size);
-            Assert(False, 'published method getters not supported yet');
+         end else if sym is TFuncSymbol then begin
+            Assert(progInfo <> nil);
+            if compSym is TRecordSymbol then begin
+               Assert(False, 'JSON utility does not yet support published method getters for records');
+            end else begin
+               scriptObj := (dataPtr.GetSelf as  TScriptObjInstance) as IScriptObj;
+               info := TInfoFunc.Create(progInfo, sym, progInfo.Execution.DataContext_Nil,
+                                        nil, scriptObj, TClassSymbol(compSym));
+            end;
+            StringifySymbol(exec, writer, sym.Typ, info.Call.GetDataPtr);
+            info := nil;
+            scriptObj := nil;
          end;
       end;
       compSym := compSym.Parent;

diff --git a/Test/JSONConnectorPass/stringify_class_getter.pas b/Test/JSONConnectorPass/stringify_class_getter.pas
@@ -0,0 +1,34 @@
+type
+   TSubTest = class
+      private 
+         FSub : TSubTest;
+         FName : String;
+         function GetSub : TSubTest; begin Result := FSub; end;
+
+      published
+         property Name : String read ('<' + FName + '>') write FName;
+         property Sub : TSubtest read GetSub write FSub;
+   end;
+
+type
+   TTest = class
+      protected
+         function GetStr : String; begin Result := 'hello'; end;
+
+      published
+         property Str : String read GetStr;
+         property Int : Integer read (123);
+         property Bool : Boolean read (1 <> 0);
+         property Num : Float read (3.14);
+         property Arr : array of String read (StrSplit('abc,de', ','));
+         property Sub : TSubTest;
+   end;
+
+var i := new TTest;
+i.Sub := new TSubTest;
+i.Sub.Name := 'hello';
+i.Sub.Sub := new TSubTest;
+i.Sub.Sub.Name := 'world';
+
+
+PrintLn(JSON.PrettyStringify(i));
diff --git a/Test/JSONConnectorPass/stringify_class_getter.txt b/Test/JSONConnectorPass/stringify_class_getter.txt
@@ -0,0 +1,17 @@
+{
+	"Arr" : [
+		"abc",
+		"de"
+	],
+	"Bool" : true,
+	"Int" : 123,
+	"Num" : 3.14,
+	"Str" : "hello",
+	"Sub" : {
+		"Name" : "<hello>",
+		"Sub" : {
+			"Name" : "<world>",
+			"Sub" : null
+		}
+	}
+}