* Added Clone and extract methods

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@15339 3ad0048d-3df7-0310-abae-a5850022a9f2

4 files changed, 340 insertions, 24 deletions

diff --git a/packages/fcl-json/src/fpjson.pp b/packages/fcl-json/src/fpjson.pp
index fe73515721..b616a512b4 100644
--- a/packages/fcl-json/src/fpjson.pp
+++ b/packages/fcl-json/src/fpjson.pp
@@ -57,6 +57,7 @@ type
     Constructor Create; virtual;
     Class function JSONType: TJSONType; virtual;
     Procedure Clear;  virtual; Abstract;
+    Function Clone : TJSONData; virtual; abstract;
     property Count: Integer read GetCount;
     property Items[Index: Integer]: TJSONData read GetItem write SetItem;
     property Value: variant read GetValue write SetValue;
@@ -102,6 +103,7 @@ type
     Constructor Create(AValue : TJSONFloat); reintroduce;
     class function NumberType : TJSONNumberType; override;
     Procedure Clear;  override;
+    Function Clone : TJSONData; override;
   end;
   
   { TJSONIntegerNumber }
@@ -127,6 +129,7 @@ type
     Constructor Create(AValue : Integer); reintroduce;
     class function NumberType : TJSONNumberType; override;
     Procedure Clear;  override;
+    Function Clone : TJSONData; override;
   end;
 
   { TJSONInt64Number }
@@ -152,6 +155,7 @@ type
     Constructor Create(AValue : Int64); reintroduce;
     class function NumberType : TJSONNumberType; override;
     Procedure Clear;  override;
+    Function Clone : TJSONData; override;
   end;
 
   { TJSONString }
@@ -177,6 +181,7 @@ type
     Constructor Create(AValue : TJSONStringType); reintroduce;
     class function JSONType: TJSONType; override;
     Procedure Clear;  override;
+    Function Clone : TJSONData; override;
   end;
 
   { TJSONboolean }
@@ -202,6 +207,7 @@ type
     Constructor Create(AValue : Boolean); reintroduce;
     class function JSONType: TJSONType; override;
     Procedure Clear;  override;
+    Function Clone : TJSONData; override;
   end;
 
   { TJSONnull }
@@ -226,6 +232,7 @@ type
   public
     class function JSONType: TJSONType; override;
     Procedure Clear;  override;
+    Function Clone : TJSONData; override;
   end;
 
   TJSONArrayIterator = procedure(Item: TJSONData; Data: TObject; var Continue: Boolean) of object;
@@ -275,6 +282,7 @@ type
     Constructor Create(const Elements : Array of Const); overload;
     Destructor Destroy; override;
     class function JSONType: TJSONType; override;
+    Function Clone : TJSONData; override;
     // Examine
     procedure Iterate(Iterator : TJSONArrayIterator; Data: TObject);
     function IndexOf(obj: TJSONData): Integer;
@@ -354,6 +362,7 @@ type
     Constructor Create(const Elements : Array of Const); overload;
     destructor Destroy; override;
     class function JSONType: TJSONType; override;
+    Function Clone : TJSONData; override;
     // Examine
     procedure Iterate(Iterator : TJSONObjectIterator; Data: TObject);
     function IndexOf(Item: TJSONData): Integer;
@@ -370,6 +379,7 @@ type
     function Add(const AName: TJSONStringType; AValue : TJSONArray): Integer; overload;
     procedure Delete(Index : Integer);
     procedure Remove(Item : TJSONData);
+    Function Extract(Index : Integer) : TJSONData;
 
     // Easy access properties.
     property Names[Index : Integer] : TJSONStringType read GetNameOf;
@@ -551,6 +561,12 @@ begin
   FValue:='';
 end;
 
+function TJSONString.Clone: TJSONData;
+
+begin
+  Result:=TJSONString.Create(Self.FValue);
+end;
+
 function TJSONstring.GetValue: Variant;
 begin
   Result:=FValue;
@@ -647,6 +663,11 @@ begin
   FValue:=False;
 end;
 
+function TJSONBoolean.Clone: TJSONData;
+begin
+  Result:=TJSONBoolean.Create(Self.Fvalue);
+end;
+
 
 procedure TJSONboolean.SetValue(const AValue: Variant);
 begin
@@ -696,9 +717,9 @@ end;
 function TJSONboolean.GetAsJSON: TJSONStringType;
 begin
   If FValue then
-    Result:='True'
+    Result:='true'
   else
-    Result:='False';
+    Result:='false';
 end;
 
 function TJSONboolean.GetAsString: TJSONStringType;
@@ -806,6 +827,12 @@ procedure TJSONNull.Clear;
 begin
   // Do nothing
 end;
+
+function TJSONNull.Clone: TJSONData;
+begin
+  Result:=TJSONNull.Create;
+end;
+
 {$warnings on}
 
 
@@ -898,6 +925,12 @@ begin
   FValue:=0;
 end;
 
+function TJSONFloatNumber.Clone: TJSONData;
+
+begin
+  Result:=TJSONFloatNumber.Create(Self.FValue);
+end;
+
 { TJSONIntegerNumber }
 
 function TJSONIntegerNumber.GetAsBoolean: Boolean;
@@ -980,6 +1013,12 @@ begin
   FValue:=0;
 end;
 
+function TJSONIntegerNumber.Clone: TJSONData;
+
+begin
+  Result:=TJSONIntegerNumber.Create(Self.FValue);
+end;
+
 { TJSONInt64Number }
 
 function TJSONInt64Number.GetAsInt64: Int64;
@@ -1062,6 +1101,12 @@ begin
   FValue:=0;
 end;
 
+function TJSONInt64Number.Clone: TJSONData;
+
+begin
+  Result:=TJSONInt64Number.Create(Self.FValue);
+end;
+
 { TJSONArray }
 
 function TJSONArray.GetBooleans(Index : Integer): Boolean;
@@ -1310,6 +1355,24 @@ begin
   Result:=jtArray;
 end;
 
+function TJSONArray.Clone: TJSONData;
+
+Var
+  A : TJSONArray;
+  I : Integer;
+
+begin
+  A:=TJSONArray.Create;
+  try
+    For I:=0 to Count-1 do
+      A.Add(Self.Items[I].Clone);
+    Result:=A;
+  except
+    A.Free;
+    Raise;
+  end;
+end;
+
 procedure TJSONArray.Iterate(Iterator: TJSONArrayIterator; Data: TObject);
 
 Var
@@ -1664,6 +1727,25 @@ begin
   Result:=jtObject;
 end;
 
+function TJSONObject.Clone: TJSONData;
+
+Var
+  O : TJSONObject;
+  I: Integer;
+  N : TJSONStringType;
+
+begin
+  O:=TJSONObject.Create;
+  try
+    For I:=0 to Count-1 do
+      O.Add(Self.Names[I],Self.Items[I].Clone);
+    Result:=O;
+  except
+    FreeAndNil(O);
+    Raise;
+  end;
+end;
+
 procedure TJSONObject.Iterate(Iterator: TJSONObjectIterator; Data: TObject);
 
 Var
@@ -1748,5 +1830,11 @@ begin
   FHash.Remove(Item);
 end;
 
+function TJSONObject.Extract(Index: Integer): TJSONData;
+begin
+  Result:=Items[Index];
+  FHash.Extract(Result);
+end;
+
 end.
 
diff --git a/packages/fcl-json/tests/testjson.lpi b/packages/fcl-json/tests/testjson.lpi
index f64f5be43e..91b7ccebf1 100644
--- a/packages/fcl-json/tests/testjson.lpi
+++ b/packages/fcl-json/tests/testjson.lpi
@@ -1,16 +1,17 @@
 <?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
-    <PathDelim Value="/"/>
-    <Version Value="5"/>
+    <Version Value="7"/>
     <General>
+      <Flags>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
-      <IconPath Value="./"/>
       <TargetFileExt Value=""/>
     </General>
     <VersionInfo>
-      <ProjectVersion Value=""/>
+      <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
     </VersionInfo>
     <PublishOptions>
       <Version Value="2"/>
@@ -57,13 +58,10 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="5"/>
+    <Version Value="8"/>
     <SearchPaths>
       <OtherUnitFiles Value="../src/"/>
     </SearchPaths>
-    <CodeGeneration>
-      <Generate Value="Faster"/>
-    </CodeGeneration>
     <Other>
       <CompilerPath Value="$(CompPath)"/>
     </Other>
diff --git a/packages/fcl-json/tests/testjsondata.pp b/packages/fcl-json/tests/testjsondata.pp
index d8d863504e..e158609185 100644
--- a/packages/fcl-json/tests/testjsondata.pp
+++ b/packages/fcl-json/tests/testjsondata.pp
@@ -55,6 +55,7 @@ type
   TTestNull = class(TTestJSON)
   published
     procedure TestNull;
+    Procedure TestClone;
   end;
   
   { TTestBoolean }
@@ -63,6 +64,7 @@ type
   published
     procedure TestTrue;
     procedure TestFalse;
+    Procedure TestClone;
   end;
   
   { TTestInteger }
@@ -74,6 +76,7 @@ type
     procedure TestPositive;
     procedure TestNegative;
     procedure TestZero;
+    Procedure TestClone;
   end;
 
   { TTestInt64 }
@@ -85,6 +88,7 @@ type
     procedure TestPositive;
     procedure TestNegative;
     procedure TestZero;
+    Procedure TestClone;
   end;
   
   { TTestFloat }
@@ -96,6 +100,7 @@ type
     procedure TestPositive;
     procedure TestNegative;
     procedure TestZero;
+    Procedure TestClone;
   end;
 
   { TTestString }
@@ -111,6 +116,7 @@ type
     procedure TestNegativeFloat;
     Procedure TestBooleanTrue;
     Procedure TestBooleanFalse;
+    Procedure TestClone;
   end;
   
   { TTestArray }
@@ -143,6 +149,7 @@ type
     procedure TestAddArray;
     procedure TestDelete;
     procedure TestRemove;
+    Procedure TestClone;
   end;
   
   { TTestObject }
@@ -175,6 +182,8 @@ type
     procedure TestAddArray;
     procedure TestDelete;
     procedure TestRemove;
+    procedure TestClone;
+    procedure TestExtract;
   end;
 
 
@@ -383,7 +392,7 @@ begin
   try
     TestJSONType(J,jtBoolean);
     TestItemCount(J,0);
-    TestJSON(J,'True');
+    TestJSON(J,'true');
     TestIsNull(J,False);
     TestAsBoolean(J,True);
     TestAsInteger(J,1);
@@ -405,7 +414,7 @@ begin
   try
     TestJSONType(J,jtBoolean);
     TestItemCount(J,0);
-    TestJSON(J,'False');
+    TestJSON(J,'false');
     TestIsNull(J,False);
     TestAsBoolean(J,False);
     TestAsInteger(J,0);
@@ -417,6 +426,27 @@ begin
   end;
 end;
 
+procedure TTestBoolean.TestClone;
+
+Var
+  B : TJSONBoolean;
+  D : TJSONData;
+
+begin
+  B:=TJSONBoolean.Create(true);
+  try
+    D:=B.Clone;
+    try
+     TestJSONType(D,jtBoolean);
+     TestAsBoolean(D,true);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(B);
+  end;
+end;
+
 
 
 { TTestNull }
@@ -443,6 +473,26 @@ begin
   end;
 end;
 
+procedure TTestNull.TestClone;
+
+Var
+  J : TJSONNull;
+  D : TJSONData;
+
+begin
+  J:=TJSONNull.Create;
+  try
+    D:=J.Clone;
+    try
+      TestIsNull(D,True);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
 
 { TTestString }
 
@@ -543,7 +593,7 @@ end;
 procedure TTestString.TestBooleanTrue;
 
 Const
-  S = 'True';
+  S = 'true';
 
 Var
   J : TJSONString;
@@ -568,7 +618,7 @@ end;
 procedure TTestString.TestBooleanFalse;
 
 Const
-  S = 'False';
+  S = 'false';
 
 Var
   J : TJSONString;
@@ -590,6 +640,27 @@ begin
   end;
 end;
 
+procedure TTestString.TestClone;
+
+Var
+  S : TJSONString;
+  D : TJSONData;
+
+begin
+  S:=TJSONString.Create('aloha');
+  try
+    D:=S.Clone;
+    try
+     TestJSONType(D,jtString);
+     TestAsString(D,'aloha');
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(S);
+  end;
+end;
+
 procedure TTestString.DoTestFloat(F : TJSOnFloat;S : String; OK : Boolean);
 
 Var
@@ -654,6 +725,28 @@ begin
   DoTest(0);
 end;
 
+procedure TTestInteger.TestClone;
+
+Var
+  I : TJSONIntegerNumber;
+  D : TJSONData;
+
+begin
+  I:=TJSONIntegerNumber.Create(99);
+  try
+    D:=I.Clone;
+    try
+     TestJSONType(D,jtNumber);
+     TestAsInteger(D,99);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(I);
+  end;
+
+end;
+
 { TTestInt64 }
 
 procedure TTestInt64.DoTest(I: Int64);
@@ -695,6 +788,29 @@ begin
   DoTest(0);
 end;
 
+procedure TTestInt64.TestClone;
+
+Var
+  I : TJSONInt64Number;
+  D : TJSONData;
+
+begin
+  I:=TJSONInt64Number.Create(99);
+  try
+    D:=I.Clone;
+    try
+     TestJSONType(D,jtNumber);
+     AssertEquals('Numbertype is ntInt64',ord(ntInt64),Ord(TJSONInt64Number(D).NumberType));
+     TestAsInteger(D,99);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(I);
+  end;
+
+end;
+
 { TTestFloat }
 
 procedure TTestFloat.DoTest(F: TJSONFloat);
@@ -747,6 +863,29 @@ begin
   DoTest(0.0);
 end;
 
+procedure TTestFloat.TestClone;
+
+Var
+  F : TJSONFloatNumber;
+  D : TJSONData;
+
+begin
+  F:=TJSONFloatNumber.Create(1.23);
+  try
+    D:=F.Clone;
+    try
+     TestJSONType(D,jtNumber);
+     AssertEquals('Numbertype is ntFloat',ord(ntFloat),Ord(TJSONFloatNumber(D).NumberType));
+     TestAsFloat(D,1.23);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(F);
+  end;
+
+end;
+
 { TTestArray }
 
 procedure TTestArray.TestCreate;
@@ -912,7 +1051,7 @@ begin
     TestJSONType(J,jtArray);
     TestItemCount(J,1);
     TestJSONType(J[0],jtBoolean);
-    TestJSON(J,'[True]');
+    TestJSON(J,'[true]');
   finally
     FreeAndNil(J);
   end;
@@ -1093,9 +1232,9 @@ begin
     TestAsBoolean(J[0],B);
     AssertEquals('J.Booleans[0]='+BoolToStr(B)+'"',B,J.Booleans[0]);
     If B then
-      TestJSON(J,'[True]')
+      TestJSON(J,'[true]')
     else
-      TestJSON(J,'[False]');
+      TestJSON(J,'[false]');
   finally
     FreeAndNil(J);
   end;
@@ -1268,6 +1407,34 @@ begin
   end;
 end;
 
+procedure TTestArray.TestClone;
+
+Var
+  J,J2 : TJSONArray;
+  D : TJSONData;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(1);
+    J.Add('aloha');
+    D:=J.Clone;
+    try
+      TestJSONType(D,jtArray);
+      J2:=TJSonArray(D);
+      TestItemCount(J2,2);
+      TestJSONType(J2[0],jtNumber);
+      TestJSONType(J2[1],jtString);
+      TestAsInteger(J2[0],1);
+      TestAsString(J2[1],'aloha');
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
 { TTestObject }
 
 procedure TTestObject.TestCreate;
@@ -1388,9 +1555,9 @@ begin
     TestAsBoolean(J[a],B);
     AssertEquals('J.Booleans[''a'']='+BoolToStr(B)+'"',B,J.Booleans[a]);
     If B then
-      TestJSON(J,'{ "'+a+'" : True }')
+      TestJSON(J,'{ "'+a+'" : true }')
     else
-      TestJSON(J,'{ "'+a+'" : False }');
+      TestJSON(J,'{ "'+a+'" : false }');
   finally
     FreeAndNil(J);
   end;
@@ -1582,6 +1749,69 @@ begin
   end;
 end;
 
+procedure TTestObject.TestClone;
+
+Var
+  J,J2 : TJSONObject;
+  D : TJSONData;
+
+begin
+  J:=TJSonObject.Create;
+  try
+    J.Add('p1',1);
+    J.Add('p2','aloha');
+    D:=J.Clone;
+    try
+      TestJSONType(D,jtObject);
+      J2:=TJSonObject(D);
+      TestItemCount(J2,2);
+      TestJSONType(J2['p1'],jtNumber);
+      TestJSONType(J2['p2'],jtString);
+      TestAsInteger(J2['p1'],1);
+      TestAsString(J2['p2'],'aloha');
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestObject.TestExtract;
+
+Const
+  A = 'a';
+  B = 'b';
+
+Var
+  J : TJSONObject;
+  JA,JB : TJSONData;
+  E : TJSONData;
+begin
+  J:=TJSonObject.Create;
+  try
+    J.Add(A,0);
+    J.Add(B,1);
+    TestItemCount(J,2);
+    JA:=J[A];
+    JB:=J[B];
+    TestJSONType(JA,jtNumber);
+    TestJSONType(JB,jtNumber);
+    TestJSON(J,'{ "a" : 0, "b" : 1 }');
+    E:=J.Extract(1);
+    AssertSame('Extracted JA',JB,E);
+    E.Free;
+    TestItemCount(J,1);
+    E:=J.Extract(0);
+    AssertSame('Extracted JB',JA,E);
+    E.Free;
+    TestItemCount(J,0);
+  finally
+    FreeAndNil(J);
+  end;
+
+end;
+
 
 procedure TTestObject.TestCreateString;
 
@@ -1732,7 +1962,7 @@ begin
     TestJSONType(J,jtObject);
     TestItemCount(J,1);
     TestJSONType(J[A],jtBoolean);
-    TestJSON(J,'{ "A" : True }');
+    TestJSON(J,'{ "A" : true }');
   finally
     FreeAndNil(J);
   end;
diff --git a/packages/fcl-json/tests/testjsonparser.pp b/packages/fcl-json/tests/testjsonparser.pp
index 522f403aa0..0877a7906c 100644
--- a/packages/fcl-json/tests/testjsonparser.pp
+++ b/packages/fcl-json/tests/testjsonparser.pp
@@ -201,8 +201,8 @@ Var
 begin
   DoTestArray('[]',0);
   DoTestArray('[Null]',1);
-  DoTestArray('[True]',1);
-  DoTestArray('[False]',1);
+  DoTestArray('[true]',1);
+  DoTestArray('[false]',1);
   DoTestArray('[1]',1);
   DoTestArray('[1, 2]',2);
   DoTestArray('[1, 2, 3]',3);
@@ -218,8 +218,8 @@ begin
   DoTestArray('["A string"]',1);
   DoTestArray('["A string", "Another string"]',2);
   DoTestArray('["A string", "Another string", "Yet another string"]',3);
-  DoTestArray('[Null, False]',2);
-  DoTestArray('[True, False]',2);
+  DoTestArray('[Null, false]',2);
+  DoTestArray('[true, false]',2);
   DoTestArray('[Null, 1]',2);
   DoTestArray('[1, "A string"]',2);
   DoTestArray('[1, []]',2);