summaryrefslogtreecommitdiff
path: root/packages/fcl-json
diff options
context:
space:
mode:
authormichael <michael@3ad0048d-3df7-0310-abae-a5850022a9f2>2009-07-03 06:38:18 +0000
committermichael <michael@3ad0048d-3df7-0310-abae-a5850022a9f2>2009-07-03 06:38:18 +0000
commit965eea536adb672c4dea8601624b9ca68b8302d6 (patch)
tree1fbf6d39932045c7ea0b975b19c6e4ca6eb76622 /packages/fcl-json
parentb7302babfcd9e01293e5e03c58065c28ecf313f4 (diff)
downloadfpc-965eea536adb672c4dea8601624b9ca68b8302d6.tar.gz
* Patch from Inoussa OUEDRAOGO to support int64 numbers
git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@13358 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'packages/fcl-json')
-rw-r--r--packages/fcl-json/src/fpjson.pp233
-rw-r--r--packages/fcl-json/src/jsonconf.pp53
-rw-r--r--packages/fcl-json/src/jsonparser.pp5
-rw-r--r--packages/fcl-json/tests/jsonconftest.pp5
-rw-r--r--packages/fcl-json/tests/testjsondata.pp184
-rw-r--r--packages/fcl-json/tests/testjsonparser.pp24
6 files changed, 486 insertions, 18 deletions
diff --git a/packages/fcl-json/src/fpjson.pp b/packages/fcl-json/src/fpjson.pp
index dc2385e1a5..fe73515721 100644
--- a/packages/fcl-json/src/fpjson.pp
+++ b/packages/fcl-json/src/fpjson.pp
@@ -39,10 +39,12 @@ type
function GetAsBoolean: Boolean; virtual; abstract;
function GetAsFloat: TJSONFloat; virtual; abstract;
function GetAsInteger: Integer; virtual; abstract;
+ function GetAsInt64: Int64; virtual; abstract;
function GetIsNull: Boolean; virtual;
procedure SetAsBoolean(const AValue: Boolean); virtual; abstract;
procedure SetAsFloat(const AValue: TJSONFloat); virtual; abstract;
procedure SetAsInteger(const AValue: Integer); virtual; abstract;
+ procedure SetAsInt64(const AValue: Int64); virtual; abstract;
function GetAsJSON: TJSONStringType; virtual; abstract;
function GetAsString: TJSONStringType; virtual; abstract;
procedure SetAsString(const AValue: TJSONStringType); virtual; abstract;
@@ -61,13 +63,14 @@ type
Property AsString : TJSONStringType Read GetAsString Write SetAsString;
Property AsFloat : TJSONFloat Read GetAsFloat Write SetAsFloat;
Property AsInteger : Integer Read GetAsInteger Write SetAsInteger;
+ Property AsInt64 : Int64 Read GetAsInt64 Write SetAsInt64;
Property AsBoolean : Boolean Read GetAsBoolean Write SetAsBoolean;
Property IsNull : Boolean Read GetIsNull;
Property AsJSON : TJSONStringType Read GetAsJSON;
end;
TJSONDataClass = Class of TJSONData;
- TJSONNumberType = (ntFloat,ntInteger);
+ TJSONNumberType = (ntFloat,ntInteger,ntInt64);
TJSONNumber = class(TJSONData)
protected
@@ -85,9 +88,11 @@ type
function GetAsBoolean: Boolean; override;
function GetAsFloat: TJSONFloat; override;
function GetAsInteger: Integer; override;
+ function GetAsInt64: Int64; override;
procedure SetAsBoolean(const AValue: Boolean); override;
procedure SetAsFloat(const AValue: TJSONFloat); override;
procedure SetAsInteger(const AValue: Integer); override;
+ procedure SetAsInt64(const AValue: Int64); override;
function GetAsJSON: TJSONStringType; override;
function GetAsString: TJSONStringType; override;
procedure SetAsString(const AValue: TJSONStringType); override;
@@ -108,9 +113,11 @@ type
function GetAsBoolean: Boolean; override;
function GetAsFloat: TJSONFloat; override;
function GetAsInteger: Integer; override;
+ function GetAsInt64: Int64; override;
procedure SetAsBoolean(const AValue: Boolean); override;
procedure SetAsFloat(const AValue: TJSONFloat); override;
procedure SetAsInteger(const AValue: Integer); override;
+ procedure SetAsInt64(const AValue: Int64); override;
function GetAsJSON: TJSONStringType; override;
function GetAsString: TJSONStringType; override;
procedure SetAsString(const AValue: TJSONStringType); override;
@@ -122,6 +129,31 @@ type
Procedure Clear; override;
end;
+ { TJSONInt64Number }
+
+ TJSONInt64Number = class(TJSONNumber)
+ Private
+ FValue : Int64;
+ protected
+ function GetAsBoolean: Boolean; override;
+ function GetAsFloat: TJSONFloat; override;
+ function GetAsInteger: Integer; override;
+ function GetAsInt64: Int64; override;
+ procedure SetAsBoolean(const AValue: Boolean); override;
+ procedure SetAsFloat(const AValue: TJSONFloat); override;
+ procedure SetAsInteger(const AValue: Integer); override;
+ procedure SetAsInt64(const AValue: Int64); override;
+ function GetAsJSON: TJSONStringType; override;
+ function GetAsString: TJSONStringType; override;
+ procedure SetAsString(const AValue: TJSONStringType); override;
+ function GetValue: variant; override;
+ procedure SetValue(const AValue: variant); override;
+ public
+ Constructor Create(AValue : Int64); reintroduce;
+ class function NumberType : TJSONNumberType; override;
+ Procedure Clear; override;
+ end;
+
{ TJSONString }
TJSONString = class(TJSONData)
@@ -133,9 +165,11 @@ type
function GetAsBoolean: Boolean; override;
function GetAsFloat: TJSONFloat; override;
function GetAsInteger: Integer; override;
+ function GetAsInt64: Int64; override;
procedure SetAsBoolean(const AValue: Boolean); override;
procedure SetAsFloat(const AValue: TJSONFloat); override;
procedure SetAsInteger(const AValue: Integer); override;
+ procedure SetAsInt64(const AValue: Int64); override;
function GetAsJSON: TJSONStringType; override;
function GetAsString: TJSONStringType; override;
procedure SetAsString(const AValue: TJSONStringType); override;
@@ -156,9 +190,11 @@ type
function GetAsBoolean: Boolean; override;
function GetAsFloat: TJSONFloat; override;
function GetAsInteger: Integer; override;
+ function GetAsInt64: Int64; override;
procedure SetAsBoolean(const AValue: Boolean); override;
procedure SetAsFloat(const AValue: TJSONFloat); override;
procedure SetAsInteger(const AValue: Integer); override;
+ procedure SetAsInt64(const AValue: Int64); override;
function GetAsJSON: TJSONStringType; override;
function GetAsString: TJSONStringType; override;
procedure SetAsString(const AValue: TJSONStringType); override;
@@ -176,10 +212,12 @@ type
function GetAsBoolean: Boolean; override;
function GetAsFloat: TJSONFloat; override;
function GetAsInteger: Integer; override;
+ function GetAsInt64: Int64; override;
function GetIsNull: Boolean; override;
procedure SetAsBoolean(const AValue: Boolean); override;
procedure SetAsFloat(const AValue: TJSONFloat); override;
procedure SetAsInteger(const AValue: Integer); override;
+ procedure SetAsInt64(const AValue: Int64); override;
function GetAsJSON: TJSONStringType; override;
function GetAsString: TJSONStringType; override;
procedure SetAsString(const AValue: TJSONStringType); override;
@@ -202,6 +240,7 @@ type
function GetBooleans(Index : Integer): Boolean;
function GetFloats(Index : Integer): TJSONFloat;
function GetIntegers(Index : Integer): Integer;
+ function GetInt64s(Index : Integer): Int64;
function GetNulls(Index : Integer): Boolean;
function GetObjects(Index : Integer): TJSONObject;
function GetStrings(Index : Integer): TJSONStringType;
@@ -210,6 +249,7 @@ type
procedure SetBooleans(Index : Integer; const AValue: Boolean);
procedure SetFloats(Index : Integer; const AValue: TJSONFloat);
procedure SetIntegers(Index : Integer; const AValue: Integer);
+ procedure SetInt64s(Index : Integer; const AValue: Int64);
procedure SetObjects(Index : Integer; const AValue: TJSONObject);
procedure SetStrings(Index : Integer; const AValue: TJSONStringType);
protected
@@ -217,9 +257,11 @@ type
function GetAsBoolean: Boolean; override;
function GetAsFloat: TJSONFloat; override;
function GetAsInteger: Integer; override;
+ function GetAsInt64: Int64; override;
procedure SetAsBoolean(const AValue: Boolean); override;
procedure SetAsFloat(const AValue: TJSONFloat); override;
procedure SetAsInteger(const AValue: Integer); override;
+ procedure SetAsInt64(const AValue: Int64); override;
function GetAsJSON: TJSONStringType; override;
function GetAsString: TJSONStringType; override;
procedure SetAsString(const AValue: TJSONStringType); override;
@@ -240,6 +282,7 @@ type
Procedure Clear; override;
function Add(Item : TJSONData): Integer;
function Add(I : Integer): Integer;
+ function Add(I : Int64): Int64;
function Add(S : String): Integer;
function Add: Integer;
function Add(F : TJSONFloat): Integer;
@@ -253,6 +296,7 @@ type
Property Types[Index : Integer] : TJSONType Read GetTypes;
Property Nulls[Index : Integer] : Boolean Read GetNulls;
Property Integers[Index : Integer] : Integer Read GetIntegers Write SetIntegers;
+ Property Int64s[Index : Integer] : Int64 Read GetInt64s Write SetInt64s;
Property Strings[Index : Integer] : TJSONStringType Read GetStrings Write SetStrings;
Property Floats[Index : Integer] : TJSONFloat Read GetFloats Write SetFloats;
Property Booleans[Index : Integer] : Boolean Read GetBooleans Write SetBooleans;
@@ -272,6 +316,7 @@ type
function GetElements(AName: string): TJSONData;
function GetFloats(AName : String): TJSONFloat;
function GetIntegers(AName : String): Integer;
+ function GetInt64s(AName : String): Int64;
function GetIsNull(AName : String): Boolean; reintroduce;
function GetNameOf(Index : Integer): TJSONStringType;
function GetObjects(AName : String): TJSONObject;
@@ -282,6 +327,7 @@ type
procedure SetElements(AName: string; const AValue: TJSONData);
procedure SetFloats(AName : String; const AValue: TJSONFloat);
procedure SetIntegers(AName : String; const AValue: Integer);
+ procedure SetInt64s(AName : String; const AValue: Int64);
procedure SetIsNull(AName : String; const AValue: Boolean);
procedure SetObjects(AName : String; const AValue: TJSONObject);
procedure SetStrings(AName : String; const AValue: TJSONStringType);
@@ -290,9 +336,11 @@ type
function GetAsBoolean: Boolean; override;
function GetAsFloat: TJSONFloat; override;
function GetAsInteger: Integer; override;
+ function GetAsInt64: Int64; override;
procedure SetAsBoolean(const AValue: Boolean); override;
procedure SetAsFloat(const AValue: TJSONFloat); override;
procedure SetAsInteger(const AValue: Integer); override;
+ procedure SetAsInt64(const AValue: Int64); override;
function GetAsJSON: TJSONStringType; override;
function GetAsString: TJSONStringType; override;
procedure SetAsString(const AValue: TJSONStringType); override;
@@ -317,6 +365,7 @@ type
function Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer; overload;
function Add(const AName: TJSONStringType; AValue: TJSONStringType): Integer; overload;
function Add(const AName: TJSONStringType; Avalue: Integer): Integer; overload;
+ function Add(const AName: TJSONStringType; Avalue: Int64): Integer; overload;
function Add(const AName: TJSONStringType): Integer; overload;
function Add(const AName: TJSONStringType; AValue : TJSONArray): Integer; overload;
procedure Delete(Index : Integer);
@@ -330,6 +379,7 @@ type
Property Nulls[AName : String] : Boolean Read GetIsNull Write SetIsNull;
Property Floats[AName : String] : TJSONFloat Read GetFloats Write SetFloats;
Property Integers[AName : String] : Integer Read GetIntegers Write SetIntegers;
+ Property Int64s[AName : String] : Int64 Read GetInt64s Write SetInt64s;
Property Strings[AName : String] : TJSONStringType Read GetStrings Write SetStrings;
Property Booleans[AName : String] : Boolean Read GetBooleans Write SetBooleans;
Property Arrays[AName : String] : TJSONArray Read GetArrays Write SetArrays;
@@ -534,6 +584,11 @@ begin
Result:=StrToInt(FValue);
end;
+function TJSONstring.GetAsInt64: Int64;
+begin
+ Result:=StrToInt64(FValue);
+end;
+
procedure TJSONstring.SetAsBoolean(const AValue: Boolean);
begin
FValue:=BoolToStr(AValue);
@@ -549,6 +604,11 @@ begin
FValue:=IntToStr(AValue);
end;
+procedure TJSONstring.SetAsInt64(const AValue: Int64);
+begin
+ FValue:=IntToStr(AValue);
+end;
+
function TJSONstring.GetAsJSON: TJSONStringType;
begin
Result:='"'+StringToJSONString(FValue)+'"';
@@ -608,6 +668,10 @@ begin
Result:=Ord(FValue);
end;
+function TJSONboolean.GetAsInt64: Int64;
+begin
+ Result:=Ord(FValue);
+end;
procedure TJSONboolean.SetAsBoolean(const AValue: Boolean);
begin
@@ -624,6 +688,11 @@ begin
FValue:=(AValue<>0)
end;
+procedure TJSONboolean.SetAsInt64(const AValue: Int64);
+begin
+ FValue:=(AValue<>0)
+end;
+
function TJSONboolean.GetAsJSON: TJSONStringType;
begin
If FValue then
@@ -673,6 +742,11 @@ begin
ConvertError(True);
end;
+function TJSONnull.GetAsInt64: Int64;
+begin
+ ConvertError(True);
+end;
+
function TJSONnull.GetIsNull: Boolean;
begin
Result:=True;
@@ -693,6 +767,11 @@ begin
ConvertError(False);
end;
+procedure TJSONnull.SetAsInt64(const AValue: Int64);
+begin
+ ConvertError(False);
+end;
+
function TJSONnull.GetAsJSON: TJSONStringType;
begin
Result:='Null';
@@ -748,6 +827,11 @@ begin
Result:=Round(FValue);
end;
+function TJSONFloatNumber.GetAsInt64: Int64;
+begin
+ Result:=Round(FValue);
+end;
+
procedure TJSONFloatNumber.SetAsBoolean(const AValue: Boolean);
begin
FValue:=Ord(AValue);
@@ -763,6 +847,11 @@ begin
FValue:=AValue;
end;
+procedure TJSONFloatNumber.SetAsInt64(const AValue: Int64);
+begin
+ FValue:=AValue;
+end;
+
function TJSONFloatNumber.GetAsJSON: TJSONStringType;
begin
Result:=AsString;
@@ -826,6 +915,11 @@ begin
Result:=FValue;
end;
+function TJSONIntegerNumber.GetAsInt64: Int64;
+begin
+ Result:=FValue;
+end;
+
procedure TJSONIntegerNumber.SetAsBoolean(const AValue: Boolean);
begin
FValue:=Ord(AValue);
@@ -841,6 +935,11 @@ begin
FValue:=AValue;
end;
+procedure TJSONIntegerNumber.SetAsInt64(const AValue: Int64);
+begin
+ FValue:=AValue;
+end;
+
function TJSONIntegerNumber.GetAsJSON: TJSONStringType;
begin
Result:=AsString;
@@ -881,6 +980,87 @@ begin
FValue:=0;
end;
+{ TJSONInt64Number }
+
+function TJSONInt64Number.GetAsInt64: Int64;
+begin
+ Result := FValue;
+end;
+
+procedure TJSONInt64Number.SetAsInt64(const AValue: Int64);
+begin
+ FValue := AValue;
+end;
+
+function TJSONInt64Number.GetAsBoolean: Boolean;
+begin
+ Result:=FValue<>0;
+end;
+
+function TJSONInt64Number.GetAsFloat: TJSONFloat;
+begin
+ Result:= FValue;
+end;
+
+function TJSONInt64Number.GetAsInteger: Integer;
+begin
+ Result := FValue;
+end;
+
+procedure TJSONInt64Number.SetAsBoolean(const AValue: Boolean);
+begin
+ FValue:=Ord(AValue);
+end;
+
+procedure TJSONInt64Number.SetAsFloat(const AValue: TJSONFloat);
+begin
+ FValue:=Round(AValue);
+end;
+
+procedure TJSONInt64Number.SetAsInteger(const AValue: Integer);
+begin
+ FValue:=AValue;
+end;
+
+function TJSONInt64Number.GetAsJSON: TJSONStringType;
+begin
+ Result:=AsString;
+end;
+
+function TJSONInt64Number.GetAsString: TJSONStringType;
+begin
+ Result:=IntToStr(FValue)
+end;
+
+procedure TJSONInt64Number.SetAsString(const AValue: TJSONStringType);
+begin
+ FValue:=StrToInt64(AValue);
+end;
+
+function TJSONInt64Number.GetValue: variant;
+begin
+ Result:=FValue;
+end;
+
+procedure TJSONInt64Number.SetValue(const AValue: variant);
+begin
+ FValue:=AValue;
+end;
+
+constructor TJSONInt64Number.Create(AValue: Int64);
+begin
+ FValue := AValue;
+end;
+
+class function TJSONInt64Number.NumberType: TJSONNumberType;
+begin
+ Result:=ntInt64;
+end;
+
+procedure TJSONInt64Number.Clear;
+begin
+ FValue:=0;
+end;
{ TJSONArray }
@@ -904,6 +1084,11 @@ begin
Result:=Items[Index].AsInteger;
end;
+function TJSONArray.GetInt64s(Index : Integer): Int64;
+begin
+ Result:=Items[Index].AsInt64;
+end;
+
function TJSONArray.GetNulls(Index : Integer): Boolean;
begin
Result:=Items[Index].IsNull;
@@ -945,6 +1130,11 @@ begin
Items[Index]:=TJSONIntegerNumber.Create(AValue);
end;
+procedure TJSONArray.SetInt64s(Index : Integer; const AValue: Int64);
+begin
+ Items[Index]:=TJSONInt64Number.Create(AValue);
+end;
+
procedure TJSONArray.SetObjects(Index : Integer; const AValue: TJSONObject);
begin
Items[Index]:=AValue;
@@ -979,6 +1169,11 @@ begin
ConvertError(True);
end;
+function TJSONArray.GetAsInt64: Int64;
+begin
+ ConvertError(True);
+end;
+
procedure TJSONArray.SetAsBoolean(const AValue: Boolean);
begin
ConvertError(False);
@@ -993,6 +1188,10 @@ procedure TJSONArray.SetAsInteger(const AValue: Integer);
begin
ConvertError(False);
end;
+procedure TJSONArray.SetAsInt64(const AValue: Int64);
+begin
+ ConvertError(False);
+end;
{$warnings on}
function TJSONArray.GetAsJSON: TJSONStringType;
@@ -1074,7 +1273,7 @@ begin
else
Result:=TJSONNull.Create;
vtCurrency : Result:=TJSONFloatNumber.Create(vCurrency^);
- vtInt64 : Result:=TJSONFloatNumber.Create(vInt64^);
+ vtInt64 : Result:=TJSONInt64Number.Create(vInt64^);
vtObject : if (VObject is TJSONData) then
Result:=TJSONData(VObject)
else
@@ -1147,6 +1346,11 @@ begin
Result:=Add(TJSONIntegerNumber.Create(I));
end;
+function TJSONArray.Add(I: Int64): Int64;
+begin
+ Result:=Add(TJSONInt64Number.Create(I));
+end;
+
function TJSONArray.Add(S: String): Integer;
begin
Result:=Add(TJSONString.Create(S));
@@ -1218,6 +1422,11 @@ begin
Result:=GetElements(AName).AsInteger;
end;
+function TJSONObject.GetInt64s(AName : String): Int64;
+begin
+ Result:=GetElements(AName).AsInt64;
+end;
+
function TJSONObject.GetIsNull(AName : String): Boolean;
begin
Result:=GetElements(AName).IsNull;
@@ -1276,6 +1485,11 @@ begin
SetElements(AName,TJSONIntegerNumber.Create(AVAlue));
end;
+procedure TJSONObject.SetInt64s(AName : String; const AValue: Int64);
+begin
+ SetElements(AName,TJSONInt64Number.Create(AVAlue));
+end;
+
procedure TJSONObject.SetIsNull(AName : String; const AValue: Boolean);
begin
If Not AValue then
@@ -1317,6 +1531,11 @@ begin
ConvertError(True);
end;
+function TJSONObject.GetAsInt64: Int64;
+begin
+ ConvertError(True);
+end;
+
procedure TJSONObject.SetAsBoolean(const AValue: Boolean);
begin
ConvertError(False);
@@ -1331,6 +1550,11 @@ procedure TJSONObject.SetAsInteger(const AValue: Integer);
begin
ConvertError(False);
end;
+
+procedure TJSONObject.SetAsInt64(const AValue: Int64);
+begin
+ ConvertError(False);
+end;
{$warnings on}
function TJSONObject.GetAsJSON: TJSONStringType;
@@ -1498,6 +1722,11 @@ begin
Result:=Add(AName,TJSONIntegerNumber.Create(AValue));
end;
+function TJSONObject.Add(const AName: TJSONStringType; Avalue: Int64): Integer;
+begin
+ Result:=Add(AName,TJSONInt64Number.Create(AValue));
+end;
+
function TJSONObject.Add(const AName: TJSONStringType): Integer;
begin
Result:=Add(AName,TJSONNull.Create);
diff --git a/packages/fcl-json/src/jsonconf.pp b/packages/fcl-json/src/jsonconf.pp
index 11d8e381b6..cd92eee95a 100644
--- a/packages/fcl-json/src/jsonconf.pp
+++ b/packages/fcl-json/src/jsonconf.pp
@@ -83,15 +83,18 @@ type
function GetValue(const APath: WideString; const ADefault: WideString): WideString; overload;
function GetValue(const APath: WideString; ADefault: Integer): Integer; overload;
+ function GetValue(const APath: WideString; ADefault: Int64): Int64; overload;
function GetValue(const APath: WideString; ADefault: Boolean): Boolean; overload;
function GetValue(const APath: WideString; ADefault: Double): Double; overload;
procedure SetValue(const APath: WideString; const AValue: WideString); overload;
procedure SetValue(const APath: WideString; AValue: Integer); overload;
+ procedure SetValue(const APath: WideString; AValue: Int64); overload;
procedure SetValue(const APath: WideString; AValue: Boolean); overload;
procedure SetValue(const APath: WideString; AValue: Double); overload;
procedure SetDeleteValue(const APath: WideString; const AValue, DefValue: WideString); overload;
procedure SetDeleteValue(const APath: WideString; AValue, DefValue: Integer); overload;
+ procedure SetDeleteValue(const APath: WideString; AValue, DefValue: Int64); overload;
procedure SetDeleteValue(const APath: WideString; AValue, DefValue: Boolean); overload;
procedure DeletePath(const APath: WideString);
@@ -284,6 +287,20 @@ begin
Result:=StrToIntDef(El.AsString,ADefault);
end;
+function TJSONConfig.GetValue(const APath: WideString; ADefault: Int64): Int64;
+var
+ El : TJSONData;
+
+begin
+ El:=FindElement(StripSlash(APath),False);
+ If Not Assigned(el) then
+ Result:=ADefault
+ else if (el is TJSONNumber) then
+ Result:=El.AsInt64
+ else
+ Result:=StrToInt64Def(El.AsString,ADefault);
+end;
+
function TJSONConfig.GetValue(const APath: WideString; ADefault: Boolean): Boolean;
var
@@ -376,6 +393,33 @@ begin
FModified:=True;
end;
+procedure TJSONConfig.SetValue(const APath: WideString; AValue: Int64);
+
+var
+ El : TJSONData;
+ ElName : WideString;
+ O : TJSONObject;
+ I : integer;
+
+begin
+ El:=FindElement(StripSlash(APath),True,O,ElName);
+ if Assigned(El) and (Not (El is TJSONInt64Number)) then
+ begin
+ I:=O.IndexOfName(elName);
+ If (I<>-1) then // Normally not needed...
+ O.Delete(i);
+ El:=Nil;
+ end;
+ If Not Assigned(el) then
+ begin
+ El:=TJSONInt64Number.Create(AValue);
+ O.Add(ElName,El);
+ end
+ else
+ El.AsInt64:=AValue;
+ FModified:=True;
+end;
+
procedure TJSONConfig.SetDeleteValue(const APath: WideString; AValue,
DefValue: Integer);
begin
@@ -385,6 +429,15 @@ begin
SetValue(APath, AValue);
end;
+procedure TJSONConfig.SetDeleteValue(const APath: WideString; AValue,
+ DefValue: Int64);
+begin
+ if AValue = DefValue then
+ DeleteValue(APath)
+ else
+ SetValue(APath, AValue);
+end;
+
procedure TJSONConfig.SetValue(const APath: WideString; AValue: Boolean);
var
diff --git a/packages/fcl-json/src/jsonparser.pp b/packages/fcl-json/src/jsonparser.pp
index 9bff97bf33..01dafed080 100644
--- a/packages/fcl-json/src/jsonparser.pp
+++ b/packages/fcl-json/src/jsonparser.pp
@@ -127,13 +127,16 @@ Function TJSONParser.ParseNumber : TJSONNumber;
Var
I : Integer;
+ I64 : Int64;
F : TJSONFloat;
S : String;
begin
S:=CurrentTokenString;
I:=0;
- If TryStrToInt(S,I) then
+ If TryStrToInt64(S,I64) then
+ Result:=TJSONInt64Number.Create(I64)
+ Else If TryStrToInt(S,I) then
Result:=TJSONIntegerNumber.Create(I)
else
begin
diff --git a/packages/fcl-json/tests/jsonconftest.pp b/packages/fcl-json/tests/jsonconftest.pp
index b9749dab64..735db714c5 100644
--- a/packages/fcl-json/tests/jsonconftest.pp
+++ b/packages/fcl-json/tests/jsonconftest.pp
@@ -48,10 +48,11 @@ end;
procedure TTestJSONConfig.TestDataTypes;
Const
- A = 1;
+ A = Integer(1);
B = 'A string';
C = 1.23;
D = True;
+ E = Int64($FFFFFFFFFFFFF);
Var
Co : TJSONCOnfig;
@@ -67,6 +68,8 @@ begin
AssertEquals('Float read/Write',c,Co.GetValue('c',0.0),0.01);
Co.SetValue('d',d);
AssertEquals('Boolean read/Write',d,Co.GetValue('d',False));
+ Co.SetValue('e',E);
+ AssertEquals('Int64 read/Write',e,Co.GetValue('e',Int64(0)));
Co.Flush;
finally
DeleteConf(Co,True);
diff --git a/packages/fcl-json/tests/testjsondata.pp b/packages/fcl-json/tests/testjsondata.pp
index ada2de8f99..d8d863504e 100644
--- a/packages/fcl-json/tests/testjsondata.pp
+++ b/packages/fcl-json/tests/testjsondata.pp
@@ -45,6 +45,7 @@ type
Procedure TestIsNull(J : TJSONData;Expected : Boolean);
Procedure TestAsBoolean(J : TJSONData;Expected : Boolean; ExpectError : boolean = False);
Procedure TestAsInteger(J : TJSONData; Expected : Integer; ExpectError : boolean = False);
+ Procedure TestAsInt64(J : TJSONData; Expected : Int64; ExpectError : boolean = False);
Procedure TestAsString(J : TJSONData; Expected : String; ExpectError : boolean = False);
Procedure TestAsFloat(J : TJSONData; Expected : TJSONFloat; ExpectError : boolean = False);
end;
@@ -74,6 +75,17 @@ type
procedure TestNegative;
procedure TestZero;
end;
+
+ { TTestInt64 }
+
+ TTestInt64 = class(TTestJSON)
+ Private
+ Procedure DoTest(I : Int64);
+ published
+ procedure TestPositive;
+ procedure TestNegative;
+ procedure TestZero;
+ end;
{ TTestFloat }
@@ -121,6 +133,7 @@ type
procedure TestCreateNilPointer;
procedure TestCreatePointer;
procedure TestAddInteger;
+ procedure TestAddInt64;
procedure TestAddFloat;
procedure TestAddBooleanTrue;
procedure TestAddBooleanFalse;
@@ -152,6 +165,7 @@ type
procedure TestCreateNilPointer;
procedure TestCreatePointer;
procedure TestAddInteger;
+ procedure TestAddInt64;
procedure TestAddFloat;
procedure TestAddBooleanTrue;
procedure TestAddBooleanFalse;
@@ -255,6 +269,40 @@ begin
end;
end;
+procedure TTestJSON.TestAsInt64(J: TJSONData; Expected: Int64;
+ ExpectError: boolean);
+
+Var
+ I : Int64;
+ AssignOK : Boolean;
+ Msg : String;
+
+begin
+ AssignOK:=False;
+ Try
+ I:=J.AsInt64;
+ AssignOK:=True;
+ If Not ExpectError then
+ AssertEquals(J.Classname+'.AsInt64',Expected,I);
+ except
+ On E : Exception do
+ begin
+ AssignOK:=False;
+ Msg:=E.Message;
+ end;
+ end;
+ If ExpectError then
+ begin
+ If AssignOK then
+ Fail(J.ClassName+'.AsInt64 must raise error');
+ end
+ else
+ begin
+ If not AssignOK then
+ Fail(J.ClassName+'.AsInt64 raised unexpected exception: '+Msg)
+ end;
+end;
+
procedure TTestJSON.TestAsString(J: TJSONData; Expected: String;
ExpectError: boolean);
@@ -339,6 +387,7 @@ begin
TestIsNull(J,False);
TestAsBoolean(J,True);
TestAsInteger(J,1);
+ TestAsInt64(J,1);
TestAsString(J,BoolToStr(True));
TestAsFloat(J,1.0);
finally
@@ -360,6 +409,7 @@ begin
TestIsNull(J,False);
TestAsBoolean(J,False);
TestAsInteger(J,0);
+ TestAsInt64(J,0);
TestAsString(J,BoolToStr(False));
TestAsFloat(J,0.0);
finally
@@ -385,6 +435,7 @@ begin
TestIsNull(J,True);
TestAsBoolean(J,False,True);
TestAsInteger(J,0,true);
+ TestAsInt64(J,0,true);
TestAsString(J,BoolToStr(False),true);
TestAsFloat(J,0.0,true);
finally
@@ -412,6 +463,7 @@ begin
TestIsNull(J,False);
TestAsBoolean(J,False,True);
TestAsInteger(J,0,true);
+ TestAsInt64(J,0,true);
TestAsString(J,S);
TestAsFloat(J,0.0,true);
finally
@@ -436,6 +488,7 @@ begin
TestIsNull(J,False);
TestAsBoolean(J,True,False);
TestAsInteger(J,1,False);
+ TestAsInt64(J,1,False);
TestAsString(J,S);
TestAsFloat(J,1.0,False);
finally
@@ -460,6 +513,7 @@ begin
TestIsNull(J,False);
TestAsBoolean(J,True,False);
TestAsInteger(J,-1,False);
+ TestAsInt64(J,-1,False);
TestAsString(J,S);
TestAsFloat(J,-1.0,False);
finally
@@ -503,6 +557,7 @@ begin
TestIsNull(J,False);
TestAsBoolean(J,True,False);
TestAsInteger(J,-1,True);
+ TestAsInt64(J,-1,True);
TestAsString(J,S);
TestAsFloat(J,-1.0,True);
finally
@@ -527,6 +582,7 @@ begin
TestIsNull(J,False);
TestAsBoolean(J,False,False);
TestAsInteger(J,0,True);
+ TestAsInt64(J,0,True);
TestAsString(J,S);
TestAsFloat(J,0,True);
finally
@@ -548,6 +604,7 @@ begin
TestIsNull(J,False);
TestAsBoolean(J,(F<>0),Not OK);
TestAsInteger(J,Round(F),(Pos('.',S)<>0) or (Pos('E',UpperCase(S))<>0));
+ TestAsInt64(J,Round(F),(Pos('.',S)<>0) or (Pos('E',UpperCase(S))<>0));
TestAsString(J,S);
TestAsFloat(J,F,Not OK);
finally
@@ -573,6 +630,7 @@ begin
TestIsNull(J,False);
TestAsBoolean(J,(I<>0));
TestAsInteger(J,I);
+ TestAsInt64(J,I);
TestAsString(J,IntToStr(I));
TestAsFloat(J,I);
finally
@@ -596,6 +654,47 @@ begin
DoTest(0);
end;
+{ TTestInt64 }
+
+procedure TTestInt64.DoTest(I: Int64);
+
+Var
+ J : TJSONInt64Number;
+
+begin
+ J:=TJSONInt64Number.Create(I);
+ try
+ TestJSONType(J,jtNumber);
+ TestItemCount(J,0);
+ AssertEquals('Numbertype is ntInt64',ord(ntInt64),Ord(J.NumberType));
+ TestJSON(J,IntToStr(i));
+ TestIsNull(J,False);
+ TestAsBoolean(J,(I<>0));
+ TestAsInteger(J,I);
+ TestAsInt64(J,I);
+ TestAsString(J,IntToStr(I));
+ TestAsFloat(J,I);
+ finally
+ FreeAndNil(J);
+ end;
+end;
+
+procedure TTestInt64.TestPositive;
+
+begin
+ DoTest(1);
+end;
+
+procedure TTestInt64.TestNegative;
+begin
+ DoTest(-1);
+end;
+
+procedure TTestInt64.TestZero;
+begin
+ DoTest(0);
+end;
+
{ TTestFloat }
procedure TTestFloat.DoTest(F: TJSONFloat);
@@ -615,6 +714,7 @@ begin
TestIsNull(J,False);
TestAsBoolean(J,(F<>0));
TestAsInteger(J,Round(F));
+ TestAsInt64(J,Round(F));
TestAsString(J,S);
TestAsFloat(J,F);
finally
@@ -663,6 +763,7 @@ begin
TestIsNull(J,False);
TestAsBoolean(J,False,True);
TestAsInteger(J,1,True);
+ TestAsInt64(J,1,True);
TestAsString(J,'',True);
TestAsFloat(J,0.0,True);
finally
@@ -780,12 +881,10 @@ end;
procedure TTestArray.TestCreateInt64;
Const
- S : Int64 = $FFFFFF;
+ S : Int64 = $FFFFFFFFFFFFF;
Var
J : TJSONArray;
- r : String;
- F : TJSONFloat;
begin
J:=TJSonArray.Create([S]);
@@ -793,9 +892,7 @@ begin
TestJSONType(J,jtArray);
TestItemCount(J,1);
TestJSONType(J[0],jtNumber);
- F:=S;
- Str(F,R);
- TestJSON(J,'['+R+']');
+ TestJSON(J,'['+IntToStr(S)+']');
finally
FreeAndNil(J);
end;
@@ -920,13 +1017,36 @@ Var
begin
J:=TJSonArray.Create;
try
- J.Add(0);
+ J.Add(Integer(0));
TestItemCount(J,1);
TestJSONType(J[0],jtNumber);
AssertEquals('J[0] is TJSONIntegerNumber',J[0].ClassType,TJSONIntegerNumber);
AssertEquals('j.Types[0]=jtNumber',ord(J.Types[0]),Ord(jtNumber));
AssertEquals('J.Integers[0]=0',0,J.integers[0]);
TestAsInteger(J[0],0);
+ TestAsInt64(J[0],0);
+ TestJSON(J,'[0]');
+ finally
+ FreeAndNil(J);
+ end;
+end;
+
+procedure TTestArray.TestAddInt64;
+
+Var
+ J : TJSONArray;
+
+begin
+ J:=TJSonArray.Create;
+ try
+ J.Add(Int64(0));
+ TestItemCount(J,1);
+ TestJSONType(J[0],jtNumber);
+ AssertEquals('J[0] is TJSONInt64Number',J[0].ClassType,TJSONInt64Number);
+ AssertEquals('j.Types[0]=jtNumber',ord(J.Types[0]),Ord(jtNumber));
+ AssertEquals('J.Int64s[0]=0',0,J.Int64s[0]);
+ TestAsInteger(J[0],0);
+ TestAsInt64(J[0],0);
TestJSON(J,'[0]');
finally
FreeAndNil(J);
@@ -1057,6 +1177,8 @@ begin
AssertEquals('J.Arrays[0] is TJSONArray',TJSONArray,J.Arrays[0].ClassType);
TestAsInteger(J.Arrays[0][0],0);
TestAsInteger(J.Arrays[0][1],1);
+ TestAsInt64(J.Arrays[0][0],0);
+ TestAsInt64(J.Arrays[0][1],1);
TestJSON(J,'[[0, 1]]');
finally
FreeAndNil(J);
@@ -1086,6 +1208,8 @@ begin
AssertEquals('J.Objects[0] is TJSONObject',TJSONObject,J.Objects[0].ClassType);
TestAsInteger(J.Objects[0][A],0);
TestAsInteger(J.Objects[0][B],1);
+ TestAsInt64(J.Objects[0][A],0);
+ TestAsInt64(J.Objects[0][B],1);
TestJSON(J,'[{ "a" : 0, "b" : 1 }]');
finally
FreeAndNil(J);
@@ -1137,6 +1261,8 @@ begin
TestItemCount(J,2);
TestAsInteger(J[0],0);
TestAsInteger(J[1],2);
+ TestAsInt64(J[0],0);
+ TestAsInt64(J[1],2);
finally
FreeAndNil(J);
end;
@@ -1158,6 +1284,7 @@ begin
TestIsNull(J,False);
TestAsBoolean(J,False,True);
TestAsInteger(J,1,True);
+ TestAsInt64(J,1,True);
TestAsString(J,'',True);
TestAsFloat(J,0.0,True);
finally
@@ -1176,13 +1303,39 @@ Var
begin
J:=TJSonObject.Create;
try
- J.Add(A,0);
+ J.Add(A,Integer(0));
TestItemCount(J,1);
TestJSONType(J[A],jtNumber);
AssertEquals('J[''a''] is TJSONIntegerNumber',J[A].ClassType,TJSONIntegerNumber);
AssertEquals('j.Types[''a'']=jtNumber',ord(J.Types[A]),Ord(jtNumber));
AssertEquals('J.Integers[''a'']=0',0,J.integers[A]);
TestAsInteger(J[A],0);
+ TestAsInt64(J[A],0);
+ TestJSON(J,'{ "'+A+'" : 0 }');
+ finally
+ FreeAndNil(J);
+ end;
+end;
+
+procedure TTestObject.TestAddInt64;
+
+Const
+ A = 'a';
+
+Var
+ J : TJSONObject;
+
+begin
+ J:=TJSonObject.Create;
+ try
+ J.Add(A,Int64(0));
+ TestItemCount(J,1);
+ TestJSONType(J[A],jtNumber);
+ AssertEquals('J[''a''] is TJSONInt64Number',J[A].ClassType,TJSONInt64Number);
+ AssertEquals('j.Types[''a'']=jtNumber',ord(J.Types[A]),Ord(jtNumber));
+ AssertEquals('J.Int64s[''a'']=0',0,J.Int64s[A]);
+ TestAsInteger(J[A],0);
+ TestAsInt64(J[A],0);
TestJSON(J,'{ "'+A+'" : 0 }');
finally
FreeAndNil(J);
@@ -1330,6 +1483,8 @@ begin
AssertEquals('J.Objects[''a''] is TJSONObject',TJSONObject,J.Objects[A].ClassType);
TestAsInteger(J.Objects[A][B],0);
TestAsInteger(J.Objects[A][C],1);
+ TestAsInt64(J.Objects[A][B],0);
+ TestAsInt64(J.Objects[A][C],1);
TestJSON(J,'{ "a" : { "b" : 0, "c" : 1 } }');
finally
FreeAndNil(J);
@@ -1358,6 +1513,8 @@ begin
AssertEquals('J.Arrays[0] is TJSONArray',TJSONArray,J.Arrays[A].ClassType);
TestAsInteger(J.Arrays[A][0],0);
TestAsInteger(J.Arrays[A][1],1);
+ TestAsInt64(J.Arrays[A][0],0);
+ TestAsInt64(J.Arrays[A][1],1);
TestJSON(J,'{ "a" : [0, 1] }');
finally
FreeAndNil(J);
@@ -1418,6 +1575,8 @@ begin
TestItemCount(J,2);
TestAsInteger(J[a],1);
TestAsInteger(J[c],3);
+ TestAsInt64(J[a],1);
+ TestAsInt64(J[c],3);
finally
FreeAndNil(J);
end;
@@ -1541,12 +1700,10 @@ procedure TTestObject.TestCreateInt64;
Const
A = 'A';
- S : Int64 = $FFFFFF;
+ S : Int64 = $FFFFFFFFFFFFF;
Var
J : TJSONObject;
- r : String;
- F : TJSONFloat;
begin
J:=TJSONObject.Create([A,S]);
@@ -1554,9 +1711,7 @@ begin
TestJSONType(J,jtObject);
TestItemCount(J,1);
TestJSONType(J[A],jtNumber);
- F:=S;
- Str(F,R);
- TestJSON(J,'{ "A" : '+R+' }');
+ TestJSON(J,'{ "A" : '+IntToStr(S)+' }');
finally
FreeAndNil(J);
end;
@@ -1792,6 +1947,7 @@ initialization
RegisterTest(TTestNull);
RegisterTest(TTestBoolean);
RegisterTest(TTestInteger);
+ RegisterTest(TTestInt64);
RegisterTest(TTestFloat);
RegisterTest(TTestString);
RegisterTest(TTestArray);
diff --git a/packages/fcl-json/tests/testjsonparser.pp b/packages/fcl-json/tests/testjsonparser.pp
index 6c69e06f9d..522f403aa0 100644
--- a/packages/fcl-json/tests/testjsonparser.pp
+++ b/packages/fcl-json/tests/testjsonparser.pp
@@ -41,6 +41,7 @@ type
procedure TestFalse;
procedure TestFloat;
procedure TestInteger;
+ procedure TestInt64;
procedure TestString;
procedure TestArray;
procedure TestObject;
@@ -88,6 +89,26 @@ begin
end;
end;
+procedure TTestParser.TestInt64;
+
+Var
+ P : TJSONParser;
+ J : TJSONData;
+
+begin
+ P:=TJSONParser.Create('123456789012345');
+ Try
+ J:=P.Parse;
+ If (J=Nil) then
+ Fail('Parse of 123456789012345 fails');
+ TestJSONType(J,jtNumber);
+ TestAsInt64(J,123456789012345);
+ Finally
+ FreeAndNil(J);
+ FreeAndNil(P);
+ end;
+end;
+
procedure TTestParser.TestNull;
Var
@@ -185,6 +206,9 @@ begin
DoTestArray('[1]',1);
DoTestArray('[1, 2]',2);
DoTestArray('[1, 2, 3]',3);
+ DoTestArray('[1234567890123456]',1);
+ DoTestArray('[1234567890123456, 2234567890123456]',2);
+ DoTestArray('[1234567890123456, 2234567890123456, 3234567890123456]',3);
Str(1.2,S1);
Str(2.3,S2);
Str(3.4,S3);