Michaël Van Canneyt 1 день назад
Родитель
Сommit
3539b5710b

+ 4 - 3
packages/fcl-json/src/fpjsonrtti.pp

@@ -572,7 +572,7 @@ begin
     tkBool :
       SetOrdProp(AObject,PI,Ord(PropData.AsBoolean));
     tkQWord :
-      SetOrdProp(AObject,PI,Trunc(PropData.AsFloat));
+      SetOrdProp(AObject,PI,Int64(PropData.AsQWord));
     tkObject,
     tkArray,
     tkRecord,
@@ -924,8 +924,9 @@ begin
     varlongword,
     varint64 :
       Result:=TJSONInt64Number.Create(Data);
+    varqword :
+      Result:=TJSONQWordNumber.Create(Data);
     vardecimal,
-    varqword,
     varsingle,
     vardouble,
     varCurrency :
@@ -1206,7 +1207,7 @@ begin
     tkInt64 :
       Result:=TJSONInt64Number.Create(GetOrdProp(AObject,PropertyInfo));
     tkQWord :
-      Result:=TJSONFloatNumber.Create(GetOrdProp(AObject,PropertyInfo));
+      Result:=TJSONQWordNumber.Create(QWord(GetOrdProp(AObject,PropertyInfo)));
     tkObject :
       Result:=ObjectToJSON(GetObjectProp(AObject,PropertyInfo));
     tkArray,

+ 8 - 0
packages/fcl-json/tests/testcomps.pas

@@ -118,6 +118,14 @@ Type
     Property Int64Prop : Int64 Read FIntProp Write FIntProp default 7;
   end;
 
+  TQWordObj = class(TPersistent)
+  private
+    FValue: QWord;
+  published
+    property Value: QWord read FValue write FValue;
+  end;
+
+
   // String property.
   TStringComponent = Class(TComponent)
   private

+ 8 - 5
packages/fcl-json/tests/testjson.lpi

@@ -13,6 +13,11 @@
       </Flags>
       <SessionStorage Value="InProjectDir"/>
     </General>
+    <CustomData Count="3">
+      <Item0 Name="OpenAPIBase"/>
+      <Item1 Name="OpenAPIConfig"/>
+      <Item2 Name="OpenAPIFile"/>
+    </CustomData>
     <BuildModes Count="1">
       <Item1 Name="default" Default="True"/>
     </BuildModes>
@@ -21,14 +26,14 @@
     </PublishOptions>
     <RunParams>
       <local>
-        <CommandLineParams Value="--suite=TTestJSONDeStreamer.TestDateTime"/>
+        <CommandLineParams Value="--suite=TTestJSONStreamer.TestQwordProp"/>
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
       <FormatVersion Value="2"/>
       <Modes Count="1">
         <Mode0 Name="default">
           <local>
-            <CommandLineParams Value="--suite=TTestJSONDeStreamer.TestDateTime"/>
+            <CommandLineParams Value="--suite=TTestJSONStreamer.TestQwordProp"/>
             <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
           </local>
         </Mode0>
@@ -68,13 +73,11 @@
     </SearchPaths>
     <Linking>
       <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
         <UseHeaptrc Value="True"/>
         <TrashVariables Value="True"/>
       </Debugging>
     </Linking>
-    <Other>
-      <CustomOptions Value="-tunicodertl"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="2">

+ 16 - 0
packages/fcl-json/tests/testjsonrtti.pas

@@ -85,6 +85,8 @@ type
     procedure TestDateTimeProp5;
     procedure TestDateTimeProp6;
     procedure TestDateTimeProp7;
+    Procedure TestQwordProp;
+
     Procedure TestVariantShortint;
     Procedure TestVariantbyte;
     Procedure TestVariantword;
@@ -1508,6 +1510,20 @@ begin
   AssertProp('DateTimeProp',FormatDateTime('hh:nn',EncodeDate(1996,8,1)+EncodeTime(23,20,0,0)));
 end;
 
+procedure TTestJSONStreamer.TestQwordProp;
+var
+  D : TJSONObject;
+  V : TJSONData;
+  Obj : TQWordObj;
+begin
+  Obj := TQWordObj.Create;
+  Obj.Value := High(QWord);
+  D:=StreamObject(Obj);
+  V := D.Find('Value');
+  AssertEquals('Max QWord type', 'TJSONQWordNumber', V.ClassName);
+  AssertEquals('Max QWord', High(QWord), V.AsQWord);
+end;
+
 procedure TTestJSONStreamer.TestVariantShortint;
 
 Var