* Support for RTTI streaming

git-svn-id: trunk@16712 -

.gitattributes

@@ -2119,6 +2119,7 @@ packages/fcl-json/examples/simpledemo.pp svneol=native#text/plain
 packages/fcl-json/fpmake.pp svneol=native#text/plain
 packages/fcl-json/src/README.txt svneol=native#text/plain
 packages/fcl-json/src/fpjson.pp svneol=native#text/plain
+packages/fcl-json/src/fpjsonrtti.pp svneol=native#text/plain
 packages/fcl-json/src/jsonconf.pp svneol=native#text/plain
 packages/fcl-json/src/jsonparser.pp svneol=native#text/plain
 packages/fcl-json/src/jsonscanner.pp svneol=native#text/plain
@@ -2129,6 +2130,7 @@ packages/fcl-json/tests/testjsonconf.lpi svneol=native#text/plain
 packages/fcl-json/tests/testjsonconf.pp svneol=native#text/plain
 packages/fcl-json/tests/testjsondata.pp svneol=native#text/plain
 packages/fcl-json/tests/testjsonparser.pp svneol=native#text/plain
+packages/fcl-json/tests/testjsonrtti.pp svneol=native#text/plain
 packages/fcl-net/Makefile svneol=native#text/plain
 packages/fcl-net/Makefile.fpc svneol=native#text/plain
 packages/fcl-net/README.txt svneol=native#text/plain

packages/fcl-json/src/fpjson.pp

@@ -382,7 +382,7 @@ Type
     // Examine
     procedure Iterate(Iterator : TJSONObjectIterator; Data: TObject);
     function IndexOf(Item: TJSONData): Integer;
-    Function IndexOfName(const AName: TJSONStringType): Integer;
+    Function IndexOfName(const AName: TJSONStringType; CaseInsensitive : Boolean = False): Integer;
     // Manipulate
     Procedure Clear;  override;
     function Add(const AName: TJSONStringType; AValue: TJSONData): Integer; overload;
@@ -416,11 +416,13 @@ Type
   
 Function StringToJSONString(const S : TJSONStringType) : TJSONStringType;
 Function JSONStringToString(const S : TJSONStringType) : TJSONStringType;
-
+Function JSONTypeName(JSONType : TJSONType) : String;
 
 
 implementation
 
+Uses typinfo;
+
 Resourcestring
   SErrCannotConvertFromNull = 'Cannot convert data from Null value';
   SErrCannotConvertToNull = 'Cannot convert data to Null value';
@@ -521,6 +523,11 @@ begin
   Result:=Result+Copy(S,J,I-J+1);
 end;
 
+function JSONTypeName(JSONType: TJSONType): String;
+begin
+  Result:=GetEnumName(TypeInfo(TJSONType),Ord(JSONType));
+end;
+
 
 
 { TJSONData }
@@ -1316,6 +1323,8 @@ begin
     if not (foSingleLineArray in Options) then
       Result:=Result+sLineBreak
     end;
+ if not (foSingleLineArray in Options) then
+    Result:=Result+IndentString(Options, CurrentIndent);
   Result:=Result+']';
 end;
 
@@ -1870,9 +1879,16 @@ begin
   Result:=FHash.IndexOf(Item);
 end;
 
-function TJSONObject.IndexOfName(const AName: TJSONStringType): Integer;
+function TJSONObject.IndexOfName(const AName: TJSONStringType; CaseInsensitive : Boolean = False): Integer;
+
 begin
   Result:=FHash.FindIndexOf(AName);
+  if (Result=-1) and CaseInsensitive then
+    begin
+    Result:=Count-1;
+    While (Result>=0) and (CompareText(Names[Result],AName)<>0) do
+      Dec(Result);
+    end;
 end;
 
 procedure TJSONObject.Clear;

packages/fcl-json/tests/testjson.lpi

@@ -1,18 +1,20 @@
 <?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="8"/>
+    <Version Value="9"/>
     <General>
       <Flags>
         <LRSInOutputDirectory Value="False"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
-      <TargetFileExt Value=""/>
     </General>
     <VersionInfo>
-      <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
+      <StringTable ProductVersion=""/>
     </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
       <IgnoreBinaries Value="False"/>
@@ -22,6 +24,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
+        <CommandLineParams Value="--format=plain --suite=TCJSONStreamer"/>
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
@@ -39,7 +42,7 @@
         <PackageName Value="FCL"/>
       </Item4>
     </RequiredPackages>
-    <Units Count="3">
+    <Units Count="5">
       <Unit0>
         <Filename Value="testjson.pp"/>
         <IsPartOfProject Value="True"/>
@@ -55,19 +58,38 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="testjsondata"/>
       </Unit2>
+      <Unit3>
+        <Filename Value="testjsonrtti.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="testjsonrtti"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="../src/fpjsonrtti.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="fpjsonrtti"/>
+      </Unit4>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="9"/>
     <SearchPaths>
-      <OtherUnitFiles Value="../src/"/>
+      <OtherUnitFiles Value="../src"/>
     </SearchPaths>
     <Parsing>
       <SyntaxOptions>
         <UseAnsiStrings Value="False"/>
       </SyntaxOptions>
     </Parsing>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="True"/>
+        <UseHeaptrc Value="True"/>
+      </Debugging>
+    </Linking>
     <Other>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
       <CompilerPath Value="$(CompPath)"/>
     </Other>
   </CompilerOptions>

packages/fcl-json/tests/testjson.pp

@@ -18,7 +18,7 @@ program testjson;
 
 uses
   Classes, consoletestrunner, testjsondata, testjsonparser,
-  fpcunitconsolerunner;
+  fpcunitconsolerunner, testjsonrtti, fpjsonrtti;
 type
   { TLazTestRunner }
    TMyTestRunner = class(TTestRunner)

packages/fcl-json/tests/testjsondata.pp

@@ -194,6 +194,7 @@ type
     procedure TestExtract;
     Procedure TestNonExistingAccessError;
     Procedure TestFormat;
+    Procedure TestFind;
   end;
 
 
@@ -1968,6 +1969,41 @@ begin
   end;
 end;
 
+procedure TTestObject.TestFind;
+
+Const
+  A = 'A';
+  S = 'A string';
+  B = 'a';
+  S2 = 'Another string';
+  C = 'c';
+  S3 = 'Yet Another string';
+
+Var
+  J : TJSONObject;
+
+begin
+  J:=TJSONObject.Create([A,S,B,S2,C,S3]);
+  try
+    TestJSONType(J,jtObject);
+    TestIsNull(J,False);
+    TestItemCount(J,3);
+    TestJSONType(J[A],jtString);
+    TestJSONType(J[B],jtString);
+    TestJSON(J,'{ "A" : "'+S+'", "a" : "'+S2+'", "c" : "'+S3+'" }');
+    AssertEquals('Nonexisting, case sensitive',-1,J.IndexOfName('D'));
+    AssertEquals('Nonexisting, case insensitive',-1,J.IndexOfName('D',True));
+    AssertEquals('1 Existing , case sensitive',0,J.IndexOfName(A));
+    AssertEquals('2 Existing exact match, case insensitive',0,J.IndexOfName(A,true));
+    AssertEquals('3 Existing , case sensitive',1,J.IndexOfName(B));
+    AssertEquals('4 Existing exact match, case insensitive',1,J.IndexOfName(B,true));
+    AssertEquals('5 Existing , case sensitive again',2,J.IndexOfName(C));
+    AssertEquals('6 Existing case-insensitive match, case insensitive',2,J.IndexOfName(Uppercase(C),true));
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
 
 procedure TTestObject.TestCreateString;