* Factory methods

git-svn-id: trunk@25692 -

packages/fcl-json/src/fpjson.pp

@@ -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);
+      vtInteger    : Result:=CreateJSON(VInteger);
-      vtBoolean    : Result:=TJSONBoolean.Create(VBoolean);
+      vtBoolean    : Result:=CreateJSON(VBoolean);
-      vtChar       : Result:=TJSONString.Create(VChar);
+      vtChar       : Result:=CreateJSON(VChar);
-      vtExtended   : Result:=TJSONFloatNumber.Create(VExtended^);
+      vtExtended   : Result:=CreateJSON(VExtended^);
-      vtString     : Result:=TJSONString.Create(vString^);
+      vtString     : Result:=CreateJSON(vString^);
-      vtAnsiString : Result:=TJSONString.Create(AnsiString(vAnsiString));
+      vtAnsiString : Result:=CreateJSON(AnsiString(vAnsiString));
-      vtPChar      : Result:=TJSONString.Create(StrPas(VPChar));
+      vtPChar      : Result:=CreateJSON(StrPas(VPChar));
       vtPointer    : If (VPointer<>Nil) then
-                       Raise EJSON.CreateFmt(SErrPointerNotNil,[SourceType])
+                       TJSONData.DoError(SErrPointerNotNil,[SourceType])
                      else
-                       Result:=TJSONNull.Create;
+                       Result:=CreateJSON();
-      vtCurrency   : Result:=TJSONFloatNumber.Create(vCurrency^);
+      vtCurrency   : Result:=CreateJSON(vCurrency^);
-      vtInt64      : Result:=TJSONInt64Number.Create(vInt64^);
+      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);
+    DoError(SErrCannotSetNotIsNull);
-  SetElements(AName,TJSONNull.Create);
+  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

packages/fcl-json/src/jsonparser.pp

@@ -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);
+      tkFalse : Result:=CreateJSON(t=tkTrue);
-      tkString : Result:=TJSONString.Create(CurrentTokenString);
+      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)
+    if (I64>Maxint) or (I64<-MaxInt) then
-  Else If TryStrToInt(S,I) then
+      Result:=CreateJSON(I64)
-    Result:=TJSONIntegerNumber.Create(I)
+    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

packages/fcl-json/tests/testjson.lpi

@@ -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>

packages/fcl-json/tests/testjsondata.pp

@@ -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.
 

packages/fcl-json/tests/testjsonparser.pp

@@ -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