mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 18:09:27 +02:00
* Factory methods
git-svn-id: trunk@25692 -
This commit is contained in:
michael
parent
644dd98ef5
commit
324845e07b
@ -27,6 +27,8 @@ uses
|
||||
type
|
||||
|
||||
TJSONtype = (jtUnknown, jtNumber, jtString, jtBoolean, jtNull, jtArray, jtObject);
|
||||
TJSONInstanceType = (jitUnknown, jitNumberInteger,jitNumberInt64,jitNumberFloat,
|
||||
jitString, jitBoolean, jitNull, jitArray, jitObject);
|
||||
TJSONFloat = Double;
|
||||
TJSONStringType = AnsiString;
|
||||
TJSONCharType = AnsiChar;
|
||||
@ -48,6 +50,8 @@ Type
|
||||
|
||||
TJSONData = class(TObject)
|
||||
protected
|
||||
Class Procedure DoError(Const Msg : String);
|
||||
Class Procedure DoError(Const Fmt : String; Args : Array of const);
|
||||
Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; virtual;
|
||||
function GetAsBoolean: Boolean; virtual; abstract;
|
||||
function GetAsFloat: TJSONFloat; virtual; abstract;
|
||||
@ -122,7 +126,8 @@ Type
|
||||
Procedure Clear; override;
|
||||
Function Clone : TJSONData; override;
|
||||
end;
|
||||
|
||||
TJSONFloatNumberClass = Class of TJSONFloatNumber;
|
||||
|
||||
{ TJSONIntegerNumber }
|
||||
|
||||
TJSONIntegerNumber = class(TJSONNumber)
|
||||
@ -148,6 +153,7 @@ Type
|
||||
Procedure Clear; override;
|
||||
Function Clone : TJSONData; override;
|
||||
end;
|
||||
TJSONIntegerNumberClass = Class of TJSONIntegerNumber;
|
||||
|
||||
{ TJSONInt64Number }
|
||||
|
||||
@ -174,6 +180,7 @@ Type
|
||||
Procedure Clear; override;
|
||||
Function Clone : TJSONData; override;
|
||||
end;
|
||||
TJSONInt64NumberClass = Class of TJSONInt64Number;
|
||||
|
||||
{ TJSONString }
|
||||
|
||||
@ -200,6 +207,7 @@ Type
|
||||
Procedure Clear; override;
|
||||
Function Clone : TJSONData; override;
|
||||
end;
|
||||
TJSONStringClass = Class of TJSONString;
|
||||
|
||||
{ TJSONboolean }
|
||||
|
||||
@ -226,6 +234,7 @@ Type
|
||||
Procedure Clear; override;
|
||||
Function Clone : TJSONData; override;
|
||||
end;
|
||||
TJSONBooleanClass = Class of TJSONBoolean;
|
||||
|
||||
{ TJSONnull }
|
||||
|
||||
@ -251,6 +260,7 @@ Type
|
||||
Procedure Clear; override;
|
||||
Function Clone : TJSONData; override;
|
||||
end;
|
||||
TJSONNullClass = Class of TJSONNull;
|
||||
|
||||
TJSONArrayIterator = procedure(Item: TJSONData; Data: TObject; var Continue: Boolean) of object;
|
||||
|
||||
@ -343,6 +353,7 @@ Type
|
||||
Property Arrays[Index : Integer] : TJSONArray Read GetArrays Write SetArrays;
|
||||
Property Objects[Index : Integer] : TJSONObject Read GetObjects Write SetObjects;
|
||||
end;
|
||||
TJSONArrayClass = Class of TJSONArray;
|
||||
|
||||
TJSONObjectIterator = procedure(Const AName : TJSONStringType; Item: TJSONData; Data: TObject; var Continue: Boolean) of object;
|
||||
|
||||
@ -441,13 +452,25 @@ Type
|
||||
Property Arrays[AName : String] : TJSONArray Read GetArrays Write SetArrays;
|
||||
Property Objects[AName : String] : TJSONObject Read GetObjects Write SetObjects;
|
||||
end;
|
||||
TJSONObjectClass = Class of TJSONObject;
|
||||
|
||||
EJSON = Class(Exception);
|
||||
|
||||
|
||||
Procedure SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass);
|
||||
Function GetJSONInstanceType(AType : TJSONInstanceType) : TJSONDataClass;
|
||||
|
||||
Function StringToJSONString(const S : TJSONStringType) : TJSONStringType;
|
||||
Function JSONStringToString(const S : TJSONStringType) : TJSONStringType;
|
||||
Function JSONTypeName(JSONType : TJSONType) : String;
|
||||
|
||||
Function CreateJSON : TJSONNull;
|
||||
Function CreateJSON(Data : Boolean) : TJSONBoolean;
|
||||
Function CreateJSON(Data : Integer) : TJSONIntegerNumber;
|
||||
Function CreateJSON(Data : Int64) : TJSONInt64Number;
|
||||
Function CreateJSON(Data : TJSONFloat) : TJSONFloatNumber;
|
||||
Function CreateJSON(Data : TJSONStringType) : TJSONString;
|
||||
Function CreateJSONArray(Data : Array of const) : TJSONArray;
|
||||
Function CreateJSONObject(Data : Array of const) : TJSONObject;
|
||||
|
||||
implementation
|
||||
|
||||
@ -472,6 +495,32 @@ Resourcestring
|
||||
SErrNameMustBeString = 'TJSONObject constructor element name at pos %d is not a string';
|
||||
SErrNonexistentElement = 'Unknown object member: "%s"';
|
||||
SErrPathElementNotFound = 'Path "%s" invalid: element "%s" not found.';
|
||||
SErrWrongInstanceClass = 'Cannot set instance class: %s does not descend from %s.';
|
||||
|
||||
Var
|
||||
DefaultJSONInstanceTypes :
|
||||
Array [TJSONInstanceType] of TJSONDataClass = (TJSONData, TJSONIntegerNumber,
|
||||
TJSONInt64Number,TJSONFloatNumber, TJSONString, TJSONBoolean, TJSONNull, TJSONArray,
|
||||
TJSONObject);
|
||||
Const
|
||||
MinJSONInstanceTypes :
|
||||
Array [TJSONInstanceType] of TJSONDataClass = (TJSONData, TJSONIntegerNumber,
|
||||
TJSONInt64Number,TJSONFloatNumber, TJSONString, TJSONBoolean, TJSONNull, TJSONArray,
|
||||
TJSONObject);
|
||||
|
||||
procedure SetJSONInstanceType(AType: TJSONInstanceType; AClass: TJSONDataClass);
|
||||
begin
|
||||
if AClass=Nil then
|
||||
TJSONData.DoError(SErrWrongInstanceClass,['Nil',MinJSONINstanceTypes[AType].ClassName]);
|
||||
if Not AClass.InheritsFrom(MinJSONINstanceTypes[AType]) then
|
||||
TJSONData.DoError(SErrWrongInstanceClass,[AClass.ClassName,MinJSONINstanceTypes[AType].ClassName]);
|
||||
DefaultJSONINstanceTypes[AType]:=AClass;
|
||||
end;
|
||||
|
||||
function GetJSONInstanceType(AType: TJSONInstanceType): TJSONDataClass;
|
||||
begin
|
||||
Result:=DefaultJSONInstanceTypes[AType]
|
||||
end;
|
||||
|
||||
Function StringToJSONString(const S : TJSONStringType) : TJSONStringType;
|
||||
|
||||
@ -559,6 +608,46 @@ begin
|
||||
Result:=GetEnumName(TypeInfo(TJSONType),Ord(JSONType));
|
||||
end;
|
||||
|
||||
function CreateJSON: TJSONNull;
|
||||
begin
|
||||
Result:=TJSONNullClass(DefaultJSONInstanceTypes[jitNull]).Create
|
||||
end;
|
||||
|
||||
function CreateJSON(Data: Boolean): TJSONBoolean;
|
||||
begin
|
||||
Result:=TJSONBooleanClass(DefaultJSONInstanceTypes[jitBoolean]).Create(Data);
|
||||
end;
|
||||
|
||||
function CreateJSON(Data: Integer): TJSONIntegerNumber;
|
||||
begin
|
||||
Result:=TJSONIntegerNumberCLass(DefaultJSONInstanceTypes[jitNumberInteger]).Create(Data);
|
||||
end;
|
||||
|
||||
function CreateJSON(Data: Int64): TJSONInt64Number;
|
||||
begin
|
||||
Result:=TJSONInt64NumberCLass(DefaultJSONInstanceTypes[jitNumberInt64]).Create(Data);
|
||||
end;
|
||||
|
||||
function CreateJSON(Data: TJSONFloat): TJSONFloatNumber;
|
||||
begin
|
||||
Result:=TJSONFloatNumberCLass(DefaultJSONInstanceTypes[jitNumberFloat]).Create(Data);
|
||||
end;
|
||||
|
||||
function CreateJSON(Data: TJSONStringType): TJSONString;
|
||||
begin
|
||||
Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
|
||||
end;
|
||||
|
||||
function CreateJSONArray(Data: array of const): TJSONArray;
|
||||
begin
|
||||
Result:=TJSONArrayCLass(DefaultJSONInstanceTypes[jitArray]).Create(Data);
|
||||
end;
|
||||
|
||||
function CreateJSONObject(Data: array of const): TJSONObject;
|
||||
begin
|
||||
Result:=TJSONObjectCLass(DefaultJSONInstanceTypes[jitObject]).Create(Data);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{ TJSONData }
|
||||
@ -579,6 +668,16 @@ begin
|
||||
Clear;
|
||||
end;
|
||||
|
||||
Class procedure TJSONData.DoError(const Msg: String);
|
||||
begin
|
||||
Raise EJSON.Create(Msg);
|
||||
end;
|
||||
|
||||
Class procedure TJSONData.DoError(const Fmt: String; Args: array of const);
|
||||
begin
|
||||
Raise EJSON.CreateFmt(Fmt,Args);
|
||||
end;
|
||||
|
||||
function TJSONData.DoFindPath(const APath: TJSONStringType; out
|
||||
NotFound: TJSONStringType): TJSONdata;
|
||||
begin
|
||||
@ -617,7 +716,7 @@ Var
|
||||
begin
|
||||
Result:=DoFindPath(APath,M);
|
||||
If Result=Nil then
|
||||
Raise EJSON.CreateFmt(SErrPathElementNotFound,[APath,M]);
|
||||
DoError(SErrPathElementNotFound,[APath,M]);
|
||||
end;
|
||||
|
||||
procedure TJSONData.SetItem(Index : Integer; const AValue:
|
||||
@ -663,7 +762,7 @@ end;
|
||||
function TJSONString.Clone: TJSONData;
|
||||
|
||||
begin
|
||||
Result:=TJSONString.Create(Self.FValue);
|
||||
Result:=TJSONStringClass(ClassType).Create(Self.FValue);
|
||||
end;
|
||||
|
||||
function TJSONstring.GetValue: Variant;
|
||||
@ -764,7 +863,7 @@ end;
|
||||
|
||||
function TJSONBoolean.Clone: TJSONData;
|
||||
begin
|
||||
Result:=TJSONBoolean.Create(Self.Fvalue);
|
||||
Result:=TJSONBooleanClass(Self.ClassType).Create(Self.Fvalue);
|
||||
end;
|
||||
|
||||
|
||||
@ -841,9 +940,9 @@ end;
|
||||
procedure TJSONnull.Converterror(From : Boolean);
|
||||
begin
|
||||
If From then
|
||||
Raise EJSON.Create(SErrCannotConvertFromNull)
|
||||
DoError(SErrCannotConvertFromNull)
|
||||
else
|
||||
Raise EJSON.Create(SErrCannotConvertToNull);
|
||||
DoError(SErrCannotConvertToNull);
|
||||
end;
|
||||
|
||||
{$warnings off}
|
||||
@ -929,7 +1028,7 @@ end;
|
||||
|
||||
function TJSONNull.Clone: TJSONData;
|
||||
begin
|
||||
Result:=TJSONNull.Create;
|
||||
Result:=TJSONNullClass(Self.ClassType).Create;
|
||||
end;
|
||||
|
||||
{$warnings on}
|
||||
@ -1030,7 +1129,7 @@ end;
|
||||
function TJSONFloatNumber.Clone: TJSONData;
|
||||
|
||||
begin
|
||||
Result:=TJSONFloatNumber.Create(Self.FValue);
|
||||
Result:=TJSONFloatNumberClass(ClassType).Create(Self.FValue);
|
||||
end;
|
||||
|
||||
{ TJSONIntegerNumber }
|
||||
@ -1118,7 +1217,7 @@ end;
|
||||
function TJSONIntegerNumber.Clone: TJSONData;
|
||||
|
||||
begin
|
||||
Result:=TJSONIntegerNumber.Create(Self.FValue);
|
||||
Result:=TJSONIntegerNumberClass(ClassType).Create(Self.FValue);
|
||||
end;
|
||||
|
||||
{ TJSONInt64Number }
|
||||
@ -1206,7 +1305,7 @@ end;
|
||||
function TJSONInt64Number.Clone: TJSONData;
|
||||
|
||||
begin
|
||||
Result:=TJSONInt64Number.Create(Self.FValue);
|
||||
Result:=TJSONInt64NumberClass(ClassType).Create(Self.FValue);
|
||||
end;
|
||||
|
||||
{ TJSONArray }
|
||||
@ -1264,22 +1363,22 @@ end;
|
||||
procedure TJSONArray.SetBooleans(Index : Integer; const AValue: Boolean);
|
||||
|
||||
begin
|
||||
Items[Index]:=TJSonBoolean.Create(AValue);
|
||||
Items[Index]:=CreateJSON(AValue);
|
||||
end;
|
||||
|
||||
procedure TJSONArray.SetFloats(Index : Integer; const AValue: TJSONFloat);
|
||||
begin
|
||||
Items[Index]:=TJSONFloatNumber.Create(AValue);
|
||||
Items[Index]:=CreateJSON(AValue);
|
||||
end;
|
||||
|
||||
procedure TJSONArray.SetIntegers(Index : Integer; const AValue: Integer);
|
||||
begin
|
||||
Items[Index]:=TJSONIntegerNumber.Create(AValue);
|
||||
Items[Index]:=CreateJSON(AValue);
|
||||
end;
|
||||
|
||||
procedure TJSONArray.SetInt64s(Index : Integer; const AValue: Int64);
|
||||
begin
|
||||
Items[Index]:=TJSONInt64Number.Create(AValue);
|
||||
Items[Index]:=CreateJSON(AValue);
|
||||
end;
|
||||
|
||||
procedure TJSONArray.SetObjects(Index : Integer; const AValue: TJSONObject);
|
||||
@ -1289,7 +1388,7 @@ end;
|
||||
|
||||
procedure TJSONArray.SetStrings(Index : Integer; const AValue: TJSONStringType);
|
||||
begin
|
||||
Items[Index]:=TJSONString.Create(AValue);
|
||||
Items[Index]:=CreateJSON(AValue);
|
||||
end;
|
||||
|
||||
function TJSONArray.DoFindPath(const APath: TJSONStringType; out
|
||||
@ -1328,9 +1427,9 @@ end;
|
||||
procedure TJSONArray.Converterror(From: Boolean);
|
||||
begin
|
||||
If From then
|
||||
Raise EJSON.Create(SErrCannotConvertFromArray)
|
||||
DoError(SErrCannotConvertFromArray)
|
||||
else
|
||||
Raise EJSON.Create(SErrCannotConvertToArray);
|
||||
DoError(SErrCannotConvertToArray);
|
||||
end;
|
||||
|
||||
{$warnings off}
|
||||
@ -1480,26 +1579,26 @@ begin
|
||||
Result:=Nil;
|
||||
With Element do
|
||||
case VType of
|
||||
vtInteger : Result:=TJSONIntegerNumber.Create(VInteger);
|
||||
vtBoolean : Result:=TJSONBoolean.Create(VBoolean);
|
||||
vtChar : Result:=TJSONString.Create(VChar);
|
||||
vtExtended : Result:=TJSONFloatNumber.Create(VExtended^);
|
||||
vtString : Result:=TJSONString.Create(vString^);
|
||||
vtAnsiString : Result:=TJSONString.Create(AnsiString(vAnsiString));
|
||||
vtPChar : Result:=TJSONString.Create(StrPas(VPChar));
|
||||
vtInteger : Result:=CreateJSON(VInteger);
|
||||
vtBoolean : Result:=CreateJSON(VBoolean);
|
||||
vtChar : Result:=CreateJSON(VChar);
|
||||
vtExtended : Result:=CreateJSON(VExtended^);
|
||||
vtString : Result:=CreateJSON(vString^);
|
||||
vtAnsiString : Result:=CreateJSON(AnsiString(vAnsiString));
|
||||
vtPChar : Result:=CreateJSON(StrPas(VPChar));
|
||||
vtPointer : If (VPointer<>Nil) then
|
||||
Raise EJSON.CreateFmt(SErrPointerNotNil,[SourceType])
|
||||
TJSONData.DoError(SErrPointerNotNil,[SourceType])
|
||||
else
|
||||
Result:=TJSONNull.Create;
|
||||
vtCurrency : Result:=TJSONFloatNumber.Create(vCurrency^);
|
||||
vtInt64 : Result:=TJSONInt64Number.Create(vInt64^);
|
||||
Result:=CreateJSON();
|
||||
vtCurrency : Result:=CreateJSON(vCurrency^);
|
||||
vtInt64 : Result:=CreateJSON(vInt64^);
|
||||
vtObject : if (VObject is TJSONData) then
|
||||
Result:=TJSONData(VObject)
|
||||
else
|
||||
Raise EJSON.CreateFmt(SErrNotJSONData,[VObject.ClassName,SourceType]);
|
||||
TJSONData.DoError(SErrNotJSONData,[VObject.ClassName,SourceType]);
|
||||
//vtVariant :
|
||||
else
|
||||
Raise EJSON.CreateFmt(SErrUnknownTypeInConstructor,[SourceType,VType])
|
||||
TJSONData.DoError(SErrUnknownTypeInConstructor,[SourceType,VType])
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1536,7 +1635,7 @@ Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
A:=TJSONArray.Create;
|
||||
A:=TJSONArrayClass(ClassType).Create;
|
||||
try
|
||||
For I:=0 to Count-1 do
|
||||
A.Add(Self.Items[I].Clone);
|
||||
@ -1580,45 +1679,45 @@ end;
|
||||
|
||||
function TJSONArray.Add(I: Integer): Integer;
|
||||
begin
|
||||
Result:=Add(TJSONIntegerNumber.Create(I));
|
||||
Result:=Add(CreateJSON(I));
|
||||
end;
|
||||
|
||||
function TJSONArray.Add(I: Int64): Int64;
|
||||
begin
|
||||
Result:=Add(TJSONInt64Number.Create(I));
|
||||
Result:=Add(CreateJSON(I));
|
||||
end;
|
||||
|
||||
function TJSONArray.Add(const S: String): Integer;
|
||||
begin
|
||||
Result:=Add(TJSONString.Create(S));
|
||||
Result:=Add(CreateJSON(S));
|
||||
end;
|
||||
|
||||
function TJSONArray.Add: Integer;
|
||||
begin
|
||||
Result:=Add(TJSONNull.Create);
|
||||
Result:=Add(CreateJSON);
|
||||
end;
|
||||
|
||||
function TJSONArray.Add(F: TJSONFloat): Integer;
|
||||
begin
|
||||
Result:=Add(TJSONFloatNumber.Create(F));
|
||||
Result:=Add(CreateJSON(F));
|
||||
end;
|
||||
|
||||
function TJSONArray.Add(B: Boolean): Integer;
|
||||
begin
|
||||
Result:=Add(TJSONBoolean.Create(B));
|
||||
Result:=Add(CreateJSON(B));
|
||||
end;
|
||||
|
||||
function TJSONArray.Add(AnArray: TJSONArray): Integer;
|
||||
begin
|
||||
If (IndexOf(AnArray)<>-1) then
|
||||
Raise EJSON.Create(SErrCannotAddArrayTwice);
|
||||
DoError(SErrCannotAddArrayTwice);
|
||||
Result:=Add(TJSONData(AnArray));
|
||||
end;
|
||||
|
||||
function TJSONArray.Add(AnObject: TJSONObject): Integer;
|
||||
begin
|
||||
If (IndexOf(AnObject)<>-1) then
|
||||
Raise EJSON.Create(SErrCannotAddObjectTwice);
|
||||
DoError(SErrCannotAddObjectTwice);
|
||||
Result:=Add(TJSONData(AnObject));
|
||||
end;
|
||||
|
||||
@ -1644,7 +1743,7 @@ end;
|
||||
|
||||
procedure TJSONArray.Insert(Index: Integer);
|
||||
begin
|
||||
Insert(Index,TJSONNull.Create);
|
||||
Insert(Index,CreateJSON);
|
||||
end;
|
||||
|
||||
procedure TJSONArray.Insert(Index: Integer; Item: TJSONData);
|
||||
@ -1654,40 +1753,40 @@ end;
|
||||
|
||||
procedure TJSONArray.Insert(Index: Integer; I: Integer);
|
||||
begin
|
||||
FList.Insert(Index, TJSONIntegerNumber.Create(I));
|
||||
FList.Insert(Index, CreateJSON(I));
|
||||
end;
|
||||
|
||||
procedure TJSONArray.Insert(Index: Integer; I: Int64);
|
||||
begin
|
||||
FList.Insert(Index, TJSONInt64Number.Create(I));
|
||||
FList.Insert(Index, CreateJSON(I));
|
||||
end;
|
||||
|
||||
procedure TJSONArray.Insert(Index: Integer; const S: String);
|
||||
begin
|
||||
FList.Insert(Index, TJSONString.Create(S));
|
||||
FList.Insert(Index, CreateJSON(S));
|
||||
end;
|
||||
|
||||
procedure TJSONArray.Insert(Index: Integer; F: TJSONFloat);
|
||||
begin
|
||||
FList.Insert(Index, TJSONFloatNumber.Create(F));
|
||||
FList.Insert(Index, CreateJSON(F));
|
||||
end;
|
||||
|
||||
procedure TJSONArray.Insert(Index: Integer; B: Boolean);
|
||||
begin
|
||||
FList.Insert(Index, TJSONBoolean.Create(B));
|
||||
FList.Insert(Index, CreateJSON(B));
|
||||
end;
|
||||
|
||||
procedure TJSONArray.Insert(Index: Integer; AnArray: TJSONArray);
|
||||
begin
|
||||
if (IndexOf(AnArray)<>-1) then
|
||||
raise EJSON.Create(SErrCannotAddArrayTwice);
|
||||
DoError(SErrCannotAddArrayTwice);
|
||||
FList.Insert(Index, AnArray);
|
||||
end;
|
||||
|
||||
procedure TJSONArray.Insert(Index: Integer; AnObject: TJSONObject);
|
||||
begin
|
||||
if (IndexOf(AnObject)<>-1) then
|
||||
raise EJSON.Create(SErrCannotAddObjectTwice);
|
||||
DoError(SErrCannotAddObjectTwice);
|
||||
FList.Insert(Index, AnObject);
|
||||
end;
|
||||
|
||||
@ -1717,7 +1816,7 @@ function TJSONObject.GetElements(const AName: string): TJSONData;
|
||||
begin
|
||||
Result:=TJSONData(FHash.Find(AName));
|
||||
If (Result=Nil) then
|
||||
Raise EJSON.CreateFmt(SErrNonexistentElement,[AName]);
|
||||
DoError(SErrNonexistentElement,[AName]);
|
||||
end;
|
||||
|
||||
function TJSONObject.GetFloats(const AName: String): TJSONFloat;
|
||||
@ -1768,7 +1867,7 @@ end;
|
||||
|
||||
procedure TJSONObject.SetBooleans(const AName : String; const AValue: Boolean);
|
||||
begin
|
||||
SetElements(AName,TJSONBoolean.Create(AVAlue));
|
||||
SetElements(AName,CreateJSON(AVAlue));
|
||||
end;
|
||||
|
||||
procedure TJSONObject.SetElements(const AName: string; const AValue: TJSONData);
|
||||
@ -1785,24 +1884,24 @@ end;
|
||||
|
||||
procedure TJSONObject.SetFloats(const AName : String; const AValue: TJSONFloat);
|
||||
begin
|
||||
SetElements(AName,TJSONFloatNumber.Create(AVAlue));
|
||||
SetElements(AName,CreateJSON(AVAlue));
|
||||
end;
|
||||
|
||||
procedure TJSONObject.SetIntegers(const AName : String; const AValue: Integer);
|
||||
begin
|
||||
SetElements(AName,TJSONIntegerNumber.Create(AVAlue));
|
||||
SetElements(AName,CreateJSON(AVAlue));
|
||||
end;
|
||||
|
||||
procedure TJSONObject.SetInt64s(const AName : String; const AValue: Int64);
|
||||
begin
|
||||
SetElements(AName,TJSONInt64Number.Create(AVAlue));
|
||||
SetElements(AName,CreateJSON(AVAlue));
|
||||
end;
|
||||
|
||||
procedure TJSONObject.SetIsNull(const AName : String; const AValue: Boolean);
|
||||
begin
|
||||
If Not AValue then
|
||||
Raise EJSON.Create(SErrCannotSetNotIsNull);
|
||||
SetElements(AName,TJSONNull.Create);
|
||||
DoError(SErrCannotSetNotIsNull);
|
||||
SetElements(AName,CreateJSON);
|
||||
end;
|
||||
|
||||
procedure TJSONObject.SetObjects(const AName : String; const AValue: TJSONObject);
|
||||
@ -1812,7 +1911,7 @@ end;
|
||||
|
||||
procedure TJSONObject.SetStrings(const AName : String; const AValue: TJSONStringType);
|
||||
begin
|
||||
SetElements(AName,TJSONString.Create(AVAlue));
|
||||
SetElements(AName,CreateJSON(AVAlue));
|
||||
end;
|
||||
|
||||
function TJSONObject.DoFindPath(const APath: TJSONStringType; out
|
||||
@ -1852,9 +1951,9 @@ end;
|
||||
procedure TJSONObject.Converterror(From: Boolean);
|
||||
begin
|
||||
If From then
|
||||
Raise EJSON.Create(SErrCannotConvertFromObject)
|
||||
DoError(SErrCannotConvertFromObject)
|
||||
else
|
||||
Raise EJSON.Create(SErrCannotConvertToObject);
|
||||
DoError(SErrCannotConvertToObject);
|
||||
end;
|
||||
|
||||
{$warnings off}
|
||||
@ -1972,7 +2071,7 @@ Var
|
||||
begin
|
||||
Create;
|
||||
If ((High(Elements)-Low(Elements)) mod 2)=0 then
|
||||
Raise EJSON.Create(SErrOddNumber);
|
||||
DoError(SErrOddNumber);
|
||||
I:=Low(Elements);
|
||||
While I<=High(Elements) do
|
||||
begin
|
||||
@ -1983,10 +2082,10 @@ begin
|
||||
vtAnsiString : AName:=(AnsiString(vAnsiString));
|
||||
vtPChar : AName:=StrPas(VPChar);
|
||||
else
|
||||
Raise EJSON.CreateFmt(SErrNameMustBeString,[I+1]);
|
||||
DoError(SErrNameMustBeString,[I+1]);
|
||||
end;
|
||||
If (ANAme='') then
|
||||
Raise EJSON.CreateFmt(SErrNameMustBeString,[I+1]);
|
||||
DoError(SErrNameMustBeString,[I+1]);
|
||||
Inc(I);
|
||||
J:=VarRecToJSON(Elements[i],'Object');
|
||||
Add(AName,J);
|
||||
@ -2013,7 +2112,7 @@ Var
|
||||
I: Integer;
|
||||
|
||||
begin
|
||||
O:=TJSONObject.Create;
|
||||
O:=TJSONObjectClass(ClassType).Create;
|
||||
try
|
||||
For I:=0 to Count-1 do
|
||||
O.Add(Self.Names[I],Self.Items[I].Clone);
|
||||
@ -2110,32 +2209,32 @@ end;
|
||||
function TJSONObject.Add(const AName: TJSONStringType; AValue: Boolean
|
||||
): Integer;
|
||||
begin
|
||||
Result:=Add(AName,TJSONBoolean.Create(AValue));
|
||||
Result:=Add(AName,CreateJSON(AValue));
|
||||
end;
|
||||
|
||||
function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer;
|
||||
begin
|
||||
Result:=Add(AName,TJSONFloatNumber.Create(AValue));
|
||||
Result:=Add(AName,CreateJSON(AValue));
|
||||
end;
|
||||
|
||||
function TJSONObject.Add(const AName, AValue: TJSONStringType): Integer;
|
||||
begin
|
||||
Result:=Add(AName,TJSONString.Create(AValue));
|
||||
Result:=Add(AName,CreateJSON(AValue));
|
||||
end;
|
||||
|
||||
function TJSONObject.Add(const AName: TJSONStringType; Avalue: Integer): Integer;
|
||||
begin
|
||||
Result:=Add(AName,TJSONIntegerNumber.Create(AValue));
|
||||
Result:=Add(AName,CreateJSON(AValue));
|
||||
end;
|
||||
|
||||
function TJSONObject.Add(const AName: TJSONStringType; Avalue: Int64): Integer;
|
||||
begin
|
||||
Result:=Add(AName,TJSONInt64Number.Create(AValue));
|
||||
Result:=Add(AName,CreateJSON(AValue));
|
||||
end;
|
||||
|
||||
function TJSONObject.Add(const AName: TJSONStringType): Integer;
|
||||
begin
|
||||
Result:=Add(AName,TJSONNull.Create);
|
||||
Result:=Add(AName,CreateJSON);
|
||||
end;
|
||||
|
||||
function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONArray
|
||||
|
||||
@ -116,10 +116,10 @@ begin
|
||||
Case T of
|
||||
tkEof : If Not AllowEof then
|
||||
DoError(SErrUnexpectedEOF);
|
||||
tkNull : Result:=TJSONNull.Create;
|
||||
tkNull : Result:=CreateJSON;
|
||||
tkTrue,
|
||||
tkFalse : Result:=TJSONBoolean.Create(t=tkTrue);
|
||||
tkString : Result:=TJSONString.Create(CurrentTokenString);
|
||||
tkFalse : Result:=CreateJSON(t=tkTrue);
|
||||
tkString : Result:=CreateJSON(CurrentTokenString);
|
||||
tkCurlyBraceOpen : Result:=ParseObject;
|
||||
tkCurlyBraceClose : DoError(SErrUnexpectedToken);
|
||||
tkSQuaredBraceOpen : Result:=ParseArray;
|
||||
@ -147,16 +147,20 @@ begin
|
||||
S:=CurrentTokenString;
|
||||
I:=0;
|
||||
If TryStrToInt64(S,I64) then
|
||||
Result:=TJSONInt64Number.Create(I64)
|
||||
Else If TryStrToInt(S,I) then
|
||||
Result:=TJSONIntegerNumber.Create(I)
|
||||
if (I64>Maxint) or (I64<-MaxInt) then
|
||||
Result:=CreateJSON(I64)
|
||||
Else
|
||||
begin
|
||||
I:=I64;
|
||||
Result:=CreateJSON(I);
|
||||
end
|
||||
else
|
||||
begin
|
||||
I:=0;
|
||||
Val(S,F,I);
|
||||
If (I<>0) then
|
||||
DoError(SErrInvalidNumber);
|
||||
Result:=TJSONFloatNumber.Create(F);
|
||||
Result:=CreateJSON(F);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -195,7 +199,7 @@ Var
|
||||
N : String;
|
||||
|
||||
begin
|
||||
Result:=TJSONObject.Create;
|
||||
Result:=CreateJSONObject([]);
|
||||
Try
|
||||
T:=GetNextToken;
|
||||
While T<>tkCurlyBraceClose do
|
||||
@ -229,7 +233,7 @@ Var
|
||||
LastComma : Boolean;
|
||||
|
||||
begin
|
||||
Result:=TJSONArray.Create;
|
||||
Result:=CreateJSONArray([]);
|
||||
LastComma:=False;
|
||||
Try
|
||||
Repeat
|
||||
|
||||
@ -24,7 +24,7 @@
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<CommandLineParams Value="--suite=TTestJSONPath.TestObjectRecursiveObject"/>
|
||||
<CommandLineParams Value="--suite=TTestParser.TestClasses"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
|
||||
@ -22,7 +22,14 @@ uses
|
||||
Classes, SysUtils, fpcunit, testutils, testregistry, fpjson;
|
||||
|
||||
type
|
||||
|
||||
TMyNull = Class(TJSONNull);
|
||||
TMyInteger = Class(TJSONIntegerNumber);
|
||||
TMyInt64 = Class(TJSONInt64Number);
|
||||
TMyFloat = Class(TJSONFloatNumber);
|
||||
TMyString = Class(TJSONString);
|
||||
TMyBoolean = Class(TJSONBoolean);
|
||||
TMyArray = Class(TJSONArray);
|
||||
TMyObject = Class(TJSONObject);
|
||||
|
||||
{ TTestJSONString }
|
||||
|
||||
@ -38,7 +45,11 @@ type
|
||||
{ TTestJSON }
|
||||
|
||||
TTestJSON = Class(TTestCase)
|
||||
private
|
||||
Protected
|
||||
procedure SetDefaultInstanceTypes;
|
||||
procedure SetMyInstanceTypes;
|
||||
Procedure SetUp; override;
|
||||
Procedure TestItemCount(J : TJSONData;Expected : Integer);
|
||||
Procedure TestJSONType(J : TJSONData;Expected : TJSONType);
|
||||
Procedure TestJSON(J : TJSONData;Expected : String);
|
||||
@ -56,6 +67,7 @@ type
|
||||
published
|
||||
procedure TestNull;
|
||||
Procedure TestClone;
|
||||
Procedure TestMyClone;
|
||||
Procedure TestFormat;
|
||||
end;
|
||||
|
||||
@ -66,6 +78,7 @@ type
|
||||
procedure TestTrue;
|
||||
procedure TestFalse;
|
||||
Procedure TestClone;
|
||||
Procedure TestMyClone;
|
||||
Procedure TestFormat;
|
||||
end;
|
||||
|
||||
@ -79,6 +92,7 @@ type
|
||||
procedure TestNegative;
|
||||
procedure TestZero;
|
||||
Procedure TestClone;
|
||||
Procedure TestMyClone;
|
||||
Procedure TestFormat;
|
||||
end;
|
||||
|
||||
@ -92,6 +106,7 @@ type
|
||||
procedure TestNegative;
|
||||
procedure TestZero;
|
||||
Procedure TestClone;
|
||||
Procedure TestMyClone;
|
||||
Procedure TestFormat;
|
||||
end;
|
||||
|
||||
@ -105,6 +120,7 @@ type
|
||||
procedure TestNegative;
|
||||
procedure TestZero;
|
||||
Procedure TestClone;
|
||||
Procedure TestMyClone;
|
||||
Procedure TestFormat;
|
||||
end;
|
||||
|
||||
@ -122,6 +138,7 @@ type
|
||||
Procedure TestBooleanTrue;
|
||||
Procedure TestBooleanFalse;
|
||||
Procedure TestClone;
|
||||
Procedure TestMyClone;
|
||||
Procedure TestFormat;
|
||||
end;
|
||||
|
||||
@ -168,6 +185,7 @@ type
|
||||
procedure TestDelete;
|
||||
procedure TestRemove;
|
||||
Procedure TestClone;
|
||||
Procedure TestMyClone;
|
||||
Procedure TestFormat;
|
||||
end;
|
||||
|
||||
@ -203,6 +221,7 @@ type
|
||||
procedure TestDelete;
|
||||
procedure TestRemove;
|
||||
procedure TestClone;
|
||||
procedure TestMyClone;
|
||||
procedure TestExtract;
|
||||
Procedure TestNonExistingAccessError;
|
||||
Procedure TestFormat;
|
||||
@ -250,8 +269,358 @@ type
|
||||
Procedure TestDeepRecursive;
|
||||
end;
|
||||
|
||||
{ TTestFactory }
|
||||
|
||||
TTestFactory = class(TTestJSON)
|
||||
Private
|
||||
FType : TJSONInstanceType;
|
||||
FClass : TJSONDataClass;
|
||||
FData: TJSONData;
|
||||
Protected
|
||||
Procedure DoSet;
|
||||
Procedure TearDown; override;
|
||||
Procedure AssertElement0(AClass : TJSONDataClass);
|
||||
Procedure AssertElementA(AClass : TJSONDataClass);
|
||||
Property Data : TJSONData read FData Write FData;
|
||||
Published
|
||||
Procedure TestSet;
|
||||
Procedure TestSetInvalid;
|
||||
Procedure CreateNull;
|
||||
Procedure CreateInteger;
|
||||
Procedure CreateInt64;
|
||||
Procedure CreateFloat;
|
||||
Procedure CreateBoolean;
|
||||
Procedure CreateString;
|
||||
Procedure CreateArray;
|
||||
Procedure CreateObject;
|
||||
Procedure ArrayAddNull;
|
||||
Procedure ArrayAddInteger;
|
||||
Procedure ArrayAddInt64;
|
||||
Procedure ArrayAddFloat;
|
||||
Procedure ArrayAddBoolean;
|
||||
Procedure ArrayAddString;
|
||||
Procedure ArrayCreateNull;
|
||||
Procedure ArrayCreateInteger;
|
||||
Procedure ArrayCreateInt64;
|
||||
Procedure ArrayCreateFloat;
|
||||
Procedure ArrayCreateBoolean;
|
||||
Procedure ArrayCreateString;
|
||||
Procedure ObjectAddNull;
|
||||
Procedure ObjectAddInteger;
|
||||
Procedure ObjectAddInt64;
|
||||
Procedure ObjectAddFloat;
|
||||
Procedure ObjectAddBoolean;
|
||||
Procedure ObjectAddString;
|
||||
Procedure ObjectCreateNull;
|
||||
Procedure ObjectCreateInteger;
|
||||
Procedure ObjectCreateInt64;
|
||||
Procedure ObjectCreateFloat;
|
||||
Procedure ObjectCreateBoolean;
|
||||
Procedure ObjectCreateString;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TTestFactory }
|
||||
|
||||
procedure TTestFactory.DoSet;
|
||||
begin
|
||||
SetJSONInstanceType(FType,FClass);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.TearDown;
|
||||
begin
|
||||
FreeAndNil(FData);
|
||||
inherited TearDown;
|
||||
end;
|
||||
|
||||
procedure TTestFactory.AssertElement0(AClass: TJSONDataClass);
|
||||
begin
|
||||
AssertEquals('Correct class',TMyArray,Data.ClassType);
|
||||
AssertEquals('Have 1 element',1,Data.Count);
|
||||
AssertEquals('Correct class',AClass,(Data as TJSONArray)[0].ClassType);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.AssertElementA(AClass: TJSONDataClass);
|
||||
begin
|
||||
AssertEquals('Correct class',TMyObject,Data.ClassType);
|
||||
AssertEquals('Have element a',0,TMyObject(Data).IndexOfName('a'));
|
||||
AssertEquals('Correct class',AClass,(Data as TJSONObject).Elements['a'].ClassType);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.TestSet;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
AssertEquals('Correct type for unknown',TJSONData,GetJSONInstanceType(jitUnknown));
|
||||
AssertEquals('Correct type for integer',TMyInteger,GetJSONInstanceType(jitNumberInteger));
|
||||
AssertEquals('Correct type for int64',TMyInt64,GetJSONInstanceType(jitNumberInt64));
|
||||
AssertEquals('Correct type for float',TMyFloat,GetJSONInstanceType(jitNumberFloat));
|
||||
AssertEquals('Correct type for boolean',TMyBoolean,GetJSONInstanceType(jitBoolean));
|
||||
AssertEquals('Correct type for null',TMyNull,GetJSONInstanceType(jitNUll));
|
||||
AssertEquals('Correct type for String',TMyString,GetJSONInstanceType(jitString));
|
||||
AssertEquals('Correct type for Array',TMyArray,GetJSONInstanceType(jitArray));
|
||||
AssertEquals('Correct type for Object',TMyObject,GetJSONInstanceType(jitObject));
|
||||
end;
|
||||
|
||||
procedure TTestFactory.TestSetInvalid;
|
||||
|
||||
Const
|
||||
MyJSONInstanceTypes :
|
||||
Array [TJSONInstanceType] of TJSONDataClass = (TJSONData, TMyInteger,
|
||||
TMyInt64,TMyFloat, TMyString, TMyBoolean, TMyNull, TMyArray,
|
||||
TMyObject);
|
||||
|
||||
Var
|
||||
Ti : TJSONInstanceType;
|
||||
|
||||
begin
|
||||
For ti:=Succ(Low(TJSONInstanceType)) to High(TJSONInstanceType) do
|
||||
begin
|
||||
FType:=Ti;
|
||||
FClass:=MyJSONInstanceTypes[Pred(ti)];
|
||||
AssertException('Set '+FClass.ClassName,EJSON,@DoSet);
|
||||
end;
|
||||
FType:=jitString;
|
||||
FClass:=Nil;
|
||||
AssertException('Set Nil',EJSON,@DoSet);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.CreateNull;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSON;
|
||||
AssertEquals('Correct class',TMyNull,Data.ClassType);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.CreateInteger;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSON(1);
|
||||
AssertEquals('Correct class',TMyInteger,Data.ClassType);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.CreateInt64;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSON(Int64(1));
|
||||
AssertEquals('Correct class',TMyInt64,Data.ClassType);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.CreateFloat;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSON(1.2);
|
||||
AssertEquals('Correct class',TMyFloat,Data.ClassType);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.CreateBoolean;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSON(True);
|
||||
AssertEquals('Correct class',TMyBoolean,Data.ClassType);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.CreateString;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSON('True');
|
||||
AssertEquals('Correct class',TMyString,Data.ClassType);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.CreateArray;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONArray(['True']);
|
||||
AssertEquals('Correct class',TMyArray,Data.ClassType);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.CreateObject;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONObject(['a','True']);
|
||||
AssertEquals('Correct class',TMyObject,Data.ClassType);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ArrayAddNull;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONArray([]);
|
||||
TJSONArray(Data).Add();
|
||||
AssertElement0(TMyNull);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ArrayAddInteger;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONArray([]);
|
||||
TJSONArray(Data).Add(1);
|
||||
AssertElement0(TMyInteger);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ArrayAddInt64;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONArray([]);
|
||||
TJSONArray(Data).Add(Int64(1));
|
||||
AssertElement0(TMyInt64);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ArrayAddFloat;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONArray([]);
|
||||
TJSONArray(Data).Add(1.2);
|
||||
AssertElement0(TMyFloat);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ArrayAddBoolean;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONArray([]);
|
||||
TJSONArray(Data).Add(True);
|
||||
AssertElement0(TMyBoolean);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ArrayAddString;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONArray([]);
|
||||
TJSONArray(Data).Add('True');
|
||||
AssertElement0(TMyString);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ArrayCreateNull;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONArray([Nil]);
|
||||
AssertElement0(TMyNull);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ArrayCreateInteger;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONArray([1]);
|
||||
AssertElement0(TMyInteger);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ArrayCreateInt64;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONArray([int64(1)]);
|
||||
AssertElement0(TMyInt64);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ArrayCreateFloat;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONArray([1.2]);
|
||||
AssertElement0(TMyFloat);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ArrayCreateBoolean;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONArray([True]);
|
||||
AssertElement0(TMyBoolean);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ArrayCreateString;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONArray(['true']);
|
||||
AssertElement0(TMyString);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ObjectAddNull;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONObject([]);
|
||||
TJSONObject(Data).Add('a');
|
||||
AssertElementA(TMyNull);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ObjectAddInteger;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONObject([]);
|
||||
TJSONObject(Data).Add('a',1);
|
||||
AssertElementA(TMyInteger);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ObjectAddInt64;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONObject([]);
|
||||
TJSONObject(Data).Add('a',Int64(1));
|
||||
AssertElementA(TMyInt64);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ObjectAddFloat;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONObject([]);
|
||||
TJSONObject(Data).Add('a',1.2);
|
||||
AssertElementA(TMyFloat);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ObjectAddBoolean;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONObject([]);
|
||||
TJSONObject(Data).Add('a',True);
|
||||
AssertElementA(TMyBoolean);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ObjectAddString;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONObject([]);
|
||||
TJSONObject(Data).Add('a','True');
|
||||
AssertElementA(TMyString);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ObjectCreateNull;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONObject(['a',Nil]);
|
||||
AssertElementA(TMyNull);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ObjectCreateInteger;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONObject(['a',1]);
|
||||
AssertElementA(TMyInteger);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ObjectCreateInt64;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONObject(['a',int64(1)]);
|
||||
AssertElementA(TMyInt64);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ObjectCreateFloat;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONObject(['a',1.2]);
|
||||
AssertElementA(TMyFloat);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ObjectCreateBoolean;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONObject(['a',True]);
|
||||
AssertElementA(TMyBoolean);
|
||||
end;
|
||||
|
||||
procedure TTestFactory.ObjectCreateString;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
Data:=CreateJSONObject(['a','true']);
|
||||
AssertElementA(TMyString);
|
||||
end;
|
||||
|
||||
{ TTestJSONPath }
|
||||
|
||||
procedure TTestJSONPath.TearDown;
|
||||
@ -504,6 +873,43 @@ end;
|
||||
|
||||
{ TTestJSON }
|
||||
|
||||
procedure TTestJSON.SetDefaultInstanceTypes;
|
||||
|
||||
Const
|
||||
DefJSONInstanceTypes :
|
||||
Array [TJSONInstanceType] of TJSONDataClass = (TJSONData, TJSONIntegerNumber,
|
||||
TJSONInt64Number,TJSONFloatNumber, TJSONString, TJSONBoolean, TJSONNull, TJSONArray,
|
||||
TJSONObject);
|
||||
Var
|
||||
Ti : TJSONInstanceType;
|
||||
|
||||
begin
|
||||
For ti:=Low(TJSONInstanceType) to High(TJSONInstanceType) do
|
||||
SetJSONInstanceType(Ti,DefJSONInstanceTypes[ti]);
|
||||
end;
|
||||
|
||||
procedure TTestJSON.SetMyInstanceTypes;
|
||||
Const
|
||||
MyJSONInstanceTypes :
|
||||
Array [TJSONInstanceType] of TJSONDataClass = (TJSONData, TMyInteger,
|
||||
TMyInt64,TMyFloat, TMyString, TMyBoolean, TMyNull, TMyArray,
|
||||
TMyObject);
|
||||
Var
|
||||
Ti : TJSONInstanceType;
|
||||
|
||||
begin
|
||||
For ti:=Low(TJSONInstanceType) to High(TJSONInstanceType) do
|
||||
SetJSONInstanceType(Ti,MyJSONInstanceTypes[ti]);
|
||||
end;
|
||||
|
||||
procedure TTestJSON.SetUp;
|
||||
|
||||
|
||||
begin
|
||||
inherited SetUp;
|
||||
SetDefaultInstanceTypes;
|
||||
end;
|
||||
|
||||
procedure TTestJSON.TestItemCount(J: TJSONData; Expected: Integer);
|
||||
begin
|
||||
AssertEquals(J.ClassName+'.ItemCount',Expected,J.Count);
|
||||
@ -760,6 +1166,27 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestBoolean.TestMyClone;
|
||||
Var
|
||||
B : TMyBoolean;
|
||||
D : TJSONData;
|
||||
|
||||
begin
|
||||
B:=TMyBoolean.Create(true);
|
||||
try
|
||||
D:=B.Clone;
|
||||
try
|
||||
TestJSONType(D,jtBoolean);
|
||||
AssertEquals('Correct class',TMyBoolean,D.ClassType);
|
||||
TestAsBoolean(D,true);
|
||||
finally
|
||||
D.Free;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(B);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestBoolean.TestFormat;
|
||||
|
||||
Var
|
||||
@ -820,6 +1247,26 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestNull.TestMyClone;
|
||||
Var
|
||||
J : TMyNull;
|
||||
D : TJSONData;
|
||||
|
||||
begin
|
||||
J:=TMyNull.Create;
|
||||
try
|
||||
D:=J.Clone;
|
||||
try
|
||||
TestIsNull(D,True);
|
||||
AssertEquals('Correct class',TMyNull,D.ClassType);
|
||||
finally
|
||||
D.Free;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(J);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestNull.TestFormat;
|
||||
Var
|
||||
J : TJSONNull;
|
||||
@ -1000,6 +1447,27 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestString.TestMyClone;
|
||||
Var
|
||||
S : TMyString;
|
||||
D : TJSONData;
|
||||
|
||||
begin
|
||||
S:=TMyString.Create('aloha');
|
||||
try
|
||||
D:=S.Clone;
|
||||
try
|
||||
AssertEquals('Correct class',TMyString,D.ClassType);
|
||||
TestJSONType(D,jtString);
|
||||
TestAsString(D,'aloha');
|
||||
finally
|
||||
D.Free;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(S);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestString.TestFormat;
|
||||
Var
|
||||
S : TJSONString;
|
||||
@ -1099,6 +1567,27 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestInteger.TestMyClone;
|
||||
Var
|
||||
I : TMyInteger;
|
||||
D : TJSONData;
|
||||
|
||||
begin
|
||||
I:=TMyInteger.Create(99);
|
||||
try
|
||||
D:=I.Clone;
|
||||
try
|
||||
AssertEquals('Correct class',TMyInteger,D.ClassType);
|
||||
TestJSONType(D,jtNumber);
|
||||
TestAsInteger(D,99);
|
||||
finally
|
||||
D.Free;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(I);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestInteger.TestFormat;
|
||||
|
||||
Var
|
||||
@ -1177,6 +1666,28 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestInt64.TestMyClone;
|
||||
Var
|
||||
I : TMyInt64;
|
||||
D : TJSONData;
|
||||
|
||||
begin
|
||||
I:=TMyInt64.Create(99);
|
||||
try
|
||||
D:=I.Clone;
|
||||
try
|
||||
AssertEquals('Correct class',TMyInt64,D.ClassType);
|
||||
TestJSONType(D,jtNumber);
|
||||
AssertEquals('Numbertype is ntInt64',ord(ntInt64),Ord(TMyInt64(D).NumberType));
|
||||
TestAsInteger(D,99);
|
||||
finally
|
||||
D.Free;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(I);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestInt64.TestFormat;
|
||||
Var
|
||||
I : TJSONInt64Number;
|
||||
@ -1200,6 +1711,8 @@ Var
|
||||
|
||||
begin
|
||||
Str(F,S);
|
||||
If S[1]=' ' then
|
||||
Delete(S,1,1);
|
||||
J:=TJSONFloatNumber.Create(F);
|
||||
try
|
||||
TestJSONType(J,jtNumber);
|
||||
@ -1265,6 +1778,29 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestFloat.TestMyClone;
|
||||
|
||||
Var
|
||||
F : TMyFloat;
|
||||
D : TJSONData;
|
||||
|
||||
begin
|
||||
F:=TMyFloat.Create(1.23);
|
||||
try
|
||||
D:=F.Clone;
|
||||
try
|
||||
AssertEquals('Correct class',TMyFloat,D.ClassType);
|
||||
TestJSONType(D,jtNumber);
|
||||
AssertEquals('Numbertype is ntFloat',ord(ntFloat),Ord(TMyFloat(D).NumberType));
|
||||
TestAsFloat(D,1.23);
|
||||
finally
|
||||
D.Free;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(F);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestFloat.TestFormat;
|
||||
|
||||
Var
|
||||
@ -1325,7 +1861,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestArray.TestCreatePChar;
|
||||
procedure TTestArray.TestCreatePchar;
|
||||
|
||||
Const
|
||||
S = 'A string';
|
||||
@ -1405,6 +1941,7 @@ begin
|
||||
TestItemCount(J,1);
|
||||
TestJSONType(J[0],jtNumber);
|
||||
Str(S,R);
|
||||
Delete(R,1,1);
|
||||
TestJSON(J,'['+R+']');
|
||||
finally
|
||||
FreeAndNil(J);
|
||||
@ -1489,15 +2026,18 @@ procedure TTestArray.TestCreateObject;
|
||||
|
||||
Var
|
||||
J : TJSONArray;
|
||||
O : TObject;
|
||||
|
||||
begin
|
||||
J:=Nil;
|
||||
try
|
||||
Try
|
||||
J:=TJSONArray.Create([TObject.Create]);
|
||||
O:=TObject.Create;
|
||||
J:=TJSONArray.Create([O]);
|
||||
Fail('Array constructor accepts only TJSONData');
|
||||
finally
|
||||
FreeAndNil(J);
|
||||
FreeAndNil(O);
|
||||
end;
|
||||
except
|
||||
// Should be OK.
|
||||
@ -1604,6 +2144,7 @@ begin
|
||||
AssertEquals('J.Floats[0]='+FloatToStr(F),F,J.Floats[0]);
|
||||
TestAsFloat(J[0],F);
|
||||
Str(F,S);
|
||||
Delete(S,1,1);
|
||||
TestJSON(J,'['+S+']');
|
||||
finally
|
||||
FreeAndNil(J);
|
||||
@ -1804,8 +2345,10 @@ begin
|
||||
AssertEquals('J.Floats[0]='+FloatToStr(F),F,J.Floats[0]);
|
||||
TestAsFloat(J[0],F);
|
||||
Str(F,S);
|
||||
Delete(S,1,1);
|
||||
F:=2.3;
|
||||
Str(F,S2);
|
||||
Delete(S2,1,1);
|
||||
TestJSON(J,'['+S+', '+S2+']');
|
||||
finally
|
||||
FreeAndNil(J);
|
||||
@ -2084,6 +2627,28 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestArray.TestMyClone;
|
||||
Var
|
||||
J,J2 : TMyArray;
|
||||
D : TJSONData;
|
||||
|
||||
begin
|
||||
J:=TMyArray.Create;
|
||||
try
|
||||
J.Add(1);
|
||||
J.Add('aloha');
|
||||
D:=J.Clone;
|
||||
try
|
||||
TestJSONType(D,jtArray);
|
||||
AssertEquals('Correct class',TMyArray,D.ClassType);
|
||||
finally
|
||||
D.Free;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(J);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestArray.TestFormat;
|
||||
Var
|
||||
J : TJSONArray;
|
||||
@ -2205,7 +2770,7 @@ begin
|
||||
AssertEquals('J.Floats[''a'']='+FloatToStr(F),F,J.Floats[a]);
|
||||
TestAsFloat(J[A],F);
|
||||
Str(F,S);
|
||||
TestJSON(J,'{ "'+a+'" : '+S+' }');
|
||||
TestJSON(J,'{ "'+a+'" :'+S+' }');
|
||||
finally
|
||||
FreeAndNil(J);
|
||||
end;
|
||||
@ -2466,6 +3031,28 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestObject.TestMyClone;
|
||||
Var
|
||||
J : TMyObject;
|
||||
D : TJSONData;
|
||||
|
||||
begin
|
||||
J:=TMyObject.Create;
|
||||
try
|
||||
J.Add('p1',1);
|
||||
J.Add('p2','aloha');
|
||||
D:=J.Clone;
|
||||
try
|
||||
TestJSONType(D,jtObject);
|
||||
AssertEquals('Correct class',TMYObject,D.ClassType);
|
||||
finally
|
||||
D.Free;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(J);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestObject.TestExtract;
|
||||
|
||||
Const
|
||||
@ -2584,7 +3171,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestObject.TestCreatePChar;
|
||||
procedure TTestObject.TestCreatePchar;
|
||||
|
||||
Const
|
||||
A = 'A';
|
||||
@ -2669,7 +3256,7 @@ begin
|
||||
TestItemCount(J,1);
|
||||
TestJSONType(J[A],jtNumber);
|
||||
Str(S,R);
|
||||
TestJSON(J,'{ "A" : '+R+' }');
|
||||
TestJSON(J,'{ "A" :'+R+' }');
|
||||
finally
|
||||
FreeAndNil(J);
|
||||
end;
|
||||
@ -2762,15 +3349,18 @@ Const
|
||||
|
||||
Var
|
||||
J : TJSONObject;
|
||||
O : TObject;
|
||||
|
||||
begin
|
||||
J:=Nil;
|
||||
try
|
||||
Try
|
||||
J:=TJSONObject.Create([A,TObject.Create]);
|
||||
O:=TObject.Create;
|
||||
J:=TJSONObject.Create([A,O]);
|
||||
Fail('Array constructor accepts only TJSONData');
|
||||
finally
|
||||
FreeAndNil(J);
|
||||
FreeAndNil(O);
|
||||
end;
|
||||
except
|
||||
// Should be OK.
|
||||
@ -2932,5 +3522,6 @@ initialization
|
||||
RegisterTest(TTestArray);
|
||||
RegisterTest(TTestObject);
|
||||
RegisterTest(TTestJSONPath);
|
||||
RegisterTest(TTestFactory);
|
||||
end.
|
||||
|
||||
|
||||
@ -34,6 +34,7 @@ type
|
||||
procedure DoTestObject(S: String; const ElNames: array of String; DoJSONTest : Boolean = True);
|
||||
procedure DoTestString(S : String);
|
||||
procedure DoTestArray(S: String; ACount: Integer);
|
||||
Procedure DoTestClass(S : String; AClass : TJSONDataClass);
|
||||
published
|
||||
procedure TestEmpty;
|
||||
procedure TestNull;
|
||||
@ -47,6 +48,7 @@ type
|
||||
procedure TestObject;
|
||||
procedure TestMixed;
|
||||
procedure TestErrors;
|
||||
Procedure TestClasses;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -210,8 +212,11 @@ begin
|
||||
DoTestArray('[1234567890123456, 2234567890123456]',2);
|
||||
DoTestArray('[1234567890123456, 2234567890123456, 3234567890123456]',3);
|
||||
Str(Double(1.2),S1);
|
||||
Delete(S1,1,1);
|
||||
Str(Double(2.3),S2);
|
||||
Delete(S2,1,1);
|
||||
Str(Double(3.4),S3);
|
||||
Delete(S3,1,1);
|
||||
DoTestArray('['+S1+']',1);
|
||||
DoTestArray('['+S1+', '+S2+']',2);
|
||||
DoTestArray('['+S1+', '+S2+', '+S3+']',3);
|
||||
@ -262,7 +267,8 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TTestParser.DoTestObject(S : String; Const ElNames : Array of String; DoJSONTest : Boolean = True);
|
||||
procedure TTestParser.DoTestObject(S: String; const ElNames: array of String;
|
||||
DoJSONTest: Boolean);
|
||||
|
||||
Var
|
||||
P : TJSONParser;
|
||||
@ -312,6 +318,26 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestParser.DoTestClass(S: String; AClass: TJSONDataClass);
|
||||
|
||||
Var
|
||||
P : TJSONParser;
|
||||
D : TJSONData;
|
||||
|
||||
begin
|
||||
P:=TJSONParser.Create(S);
|
||||
try
|
||||
D:=P.Parse;
|
||||
try
|
||||
AssertEquals('Correct class for '+S+' : ',AClass,D.ClassType);
|
||||
finally
|
||||
D.Free
|
||||
end;
|
||||
finally
|
||||
P.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestParser.TestErrors;
|
||||
|
||||
begin
|
||||
@ -328,6 +354,19 @@ begin
|
||||
DoTestError('[1,,]');
|
||||
end;
|
||||
|
||||
procedure TTestParser.TestClasses;
|
||||
begin
|
||||
SetMyInstanceTypes;
|
||||
DoTestClass('null',TMyNull);
|
||||
DoTestClass('true',TMyBoolean);
|
||||
DoTestClass('1',TMyInteger);
|
||||
DoTestClass('1.2',TMyFloat);
|
||||
DoTestClass('123456789012345',TMyInt64);
|
||||
DoTestClass('"tata"',TMyString);
|
||||
DoTestClass('{}',TMyObject);
|
||||
DoTestClass('[]',TMyArray);
|
||||
end;
|
||||
|
||||
procedure TTestParser.DoTestError(S : String);
|
||||
|
||||
Var
|
||||
|
||||
Loading…
Reference in New Issue
Block a user