* Initial implementation

git-svn-id: trunk@8522 -

.gitattributes

@@ -4262,6 +4262,15 @@ packages/fcl-image/src/pixtools.pp svneol=native#text/plain
 packages/fcl-image/src/pngcomn.pp svneol=native#text/plain
 packages/fcl-image/src/pscanvas.pp svneol=native#text/plain
 packages/fcl-image/src/targacmn.pp svneol=native#text/plain
+packages/fcl-json/Makefile svneol=native#text/plain
+packages/fcl-json/Makefile.fpc svneol=native#text/plain
+packages/fcl-json/src/fpjson.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
+packages/fcl-json/tests/testjson.lpi svneol=native#text/plain
+packages/fcl-json/tests/testjson.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-net/Makefile svneol=native#text/plain
 packages/fcl-net/Makefile.fpc svneol=native#text/plain
 packages/fcl-net/src/fpmake.inc svneol=native#text/plain

packages/fcl-json/Makefile.fpc

@@ -0,0 +1,29 @@
+#
+#   Makefile.fpc for XML for FCL
+#
+
+[package]
+name=fcl-json
+version=2.2.0
+
+[target]
+units=fpjson jsonscanner jsonparser
+rsts=fpjson jsonscanner jsonparser
+
+[require]
+packages=fcl-base
+
+[compiler]
+options=-S2h
+sourcedir=src
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+
+[rules]
+.NOTPARALLEL:
+
+jsonparser$(PPUEXT): jsonparser.pp fpjson$(PPUEXT) jsonscanner$(PPUEXT)

packages/fcl-json/src/jsonparser.pp

@@ -0,0 +1,237 @@
+unit jsonparser;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpJSON, jsonscanner;
+  
+Type
+
+  { TJSONParser }
+
+  TJSONParser = Class(TObject)
+  Private
+    FScanner : TJSONScanner;
+    function ParseNumber: TJSONNumber;
+  Protected
+    procedure DoError(Msg: String);
+    function DoParse(AtCurrent,AllowEOF: Boolean): TJSONData;
+    function GetNextToken: TJSONToken;
+    function CurrentTokenString: String;
+    function CurrentToken: TJSONToken;
+    function ParseArray: TJSONArray;
+    function ParseObject: TJSONObject;
+  Public
+    function Parse: TJSONData;
+    Constructor Create(Source : TStream); overload;
+    Constructor Create(Source : TJSONStringType); overload;
+  end;
+  
+  EJSONScanner = Class(Exception);
+  
+implementation
+
+Resourcestring
+  SErrUnexpectedEOF   = 'Unexpected EOF encountered.';
+  SErrUnexpectedToken = 'Unexpected token (%s) encountered.';
+  SErrExpectedColon   = 'Expected colon (:), got token "%s".';
+  SErrUnexpectedComma = 'Invalid comma encountered.';
+  SErrEmptyElement = 'Empty element encountered.';
+  SErrExpectedElementName    = 'Expected element name, got token "%s"';
+  SExpectedCommaorBraceClose = 'Expected , or ], got token "%s".';
+  SErrInvalidNumber          = 'Number is not an integer or real number: %s';
+  
+{ TJSONParser }
+
+Function TJSONParser.Parse : TJSONData;
+
+begin
+  Result:=DoParse(False,True);
+end;
+
+{
+  Consume next token and convert to JSON data structure.
+  If AtCurrent is true, the current token is used. If false,
+  a token is gotten from the scanner.
+  If AllowEOF is false, encountering a tkEOF will result in an exception.
+}
+
+Function TJSONParser.CurrentToken : TJSONToken;
+
+begin
+  Result:=FScanner.CurToken;
+end;
+
+Function TJSONParser.CurrentTokenString : String;
+
+begin
+  If CurrentToken in [tkString,tkNumber] then
+    Result:=FScanner.CurTokenString
+  else
+    Result:=TokenInfos[CurrentToken];
+end;
+
+Function TJSONParser.DoParse(AtCurrent,AllowEOF : Boolean) : TJSONData;
+
+var
+  T : TJSONToken;
+  
+begin
+  Result:=nil;
+  try
+    If not AtCurrent then
+      T:=GetNextToken
+    else
+      T:=FScanner.CurToken;
+    Case T of
+      tkEof : If Not AllowEof then
+                DoError(SErrUnexpectedEOF);
+      tkNull  : Result:=TJSONNull.Create;
+      tkTrue,
+      tkFalse : Result:=TJSONBoolean.Create(t=tkTrue);
+      tkString : Result:=TJSONString.Create(CurrentTokenString);
+      tkCurlyBraceOpen : Result:=ParseObject;
+      tkCurlyBraceClose : DoError(SErrUnexpectedToken);
+      tkSQuaredBraceOpen : Result:=ParseArray;
+      tkSQuaredBraceClose : DoError(SErrUnexpectedToken);
+      tkNumber : Result:=ParseNumber;
+      tkComma : DoError(SErrUnexpectedToken);
+    end;
+  except
+    if assigned(Result) then
+      FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+
+// Creates the correct JSON number type, based on the current token.
+Function TJSONParser.ParseNumber : TJSONNumber;
+
+Var
+  I : Integer;
+  F : TJSONFloat;
+  S : String;
+
+begin
+  S:=CurrentTokenString;
+  I:=0;
+  If TryStrToInt(S,I) then
+    Result:=TJSONIntegerNumber.Create(I)
+  else
+    begin
+    I:=0;
+    Val(S,F,I);
+    If (I<>0) then
+      DoError(SErrInvalidNumber);
+    Result:=TJSONFloatNumber.Create(F);
+    end;
+end;
+
+// Current token is {, on exit current token is }
+Function TJSONParser.ParseObject : TJSONObject;
+
+Var
+  T : TJSONtoken;
+  E : TJSONData;
+  N : String;
+  
+begin
+  Result:=TJSONObject.Create;
+  Try
+    T:=GetNextToken;
+    While T<>tkCurlyBraceClose do
+      begin
+      If T<>tkString then
+        DoError(SErrExpectedElementName);
+      N:=CurrentTokenString;
+      T:=GetNextToken;
+      If (T<>tkColon) then
+        DoError(SErrExpectedColon);
+      Writeln('Getting element');
+      E:=DoParse(False,False);
+      Result.Add(N,E);
+      T:=GetNextToken;
+      If Not (T in [tkComma,tkCurlyBraceClose]) then
+        DoError(SExpectedCommaorBraceClose);
+      If T=tkComma then
+        T:=GetNextToken;
+      end;
+  Except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+// Current token is [, on exit current token is ]
+Function TJSONParser.ParseArray : TJSONArray;
+
+Var
+  T : TJSONtoken;
+  E : TJSONData;
+  LastComma : Boolean;
+  
+begin
+  Result:=TJSONArray.Create;
+  LastComma:=False;
+  Try
+    Repeat
+      T:=GetNextToken;
+      If (T<>tkSquaredBraceClose) then
+        begin
+        E:=DoParse(True,False);
+        If (E<>Nil) then
+          Result.Add(E)
+        else if (Result.Count>0) then
+          DoError(SErrEmptyElement);
+        T:=GetNextToken;
+        If Not (T in [tkComma,tkSquaredBraceClose]) then
+          DoError(SExpectedCommaorBraceClose);
+        LastComma:=(t=TkComma);
+        end;
+    Until (T=tkSquaredBraceClose);
+    If LastComma then // Test for ,] case
+      DoError(SErrUnExpectedToken);
+  Except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+// Get next token, discarding whitespace
+Function TJSONParser.GetNextToken : TJSONToken ;
+
+begin
+  Repeat
+    Result:=FScanner.FetchToken;
+  Until (Result<>tkWhiteSpace);
+  Writeln('GetNextToken : ',CurrentTokenString);
+end;
+
+Procedure TJSONParser.DoError(Msg : String);
+
+Var
+  S : String;
+
+begin
+  S:=Format(Msg,[CurrentTokenString]);
+  S:=Format('Error at line %d, Pos %d:',[FScanner.CurRow,FSCanner.CurColumn])+S;
+  Raise EJSONScanner.Create(S);
+end;
+
+constructor TJSONParser.Create(Source: TStream);
+begin
+  Inherited Create;
+  FScanner:=TJSONScanner.Create(Source);
+end;
+
+constructor TJSONParser.Create(Source: TJSONStringType);
+begin
+  Inherited Create;
+  FScanner:=TJSONScanner.Create(Source);
+end;
+
+end.
+

packages/fcl-json/src/jsonscanner.pp

@@ -0,0 +1,355 @@
+{
+    This file is part of the Free Component Library
+
+    JSON source lexical scanner
+    Copyright (c) 2007 by Michael Van Canneyt michael@freepascal.org
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$h+}
+
+unit jsonscanner;
+
+interface
+
+uses SysUtils, Classes;
+
+resourcestring
+  SErrInvalidCharacter = 'Invalid character ''%s''';
+  SErrOpenString = 'string exceeds end of line';
+
+type
+
+  TJSONToken = (
+    tkEOF,
+    tkWhitespace,
+    tkString,
+    tkNumber,
+    tkTrue,
+    tkFalse,
+    tkNull,
+    // Simple (one-character) tokens
+    tkComma,                 // ','
+    tkColon,                 // ':'
+    tkCurlyBraceOpen,        // '{'
+    tkCurlyBraceClose,       // '}'
+    tkSquaredBraceOpen,       // '['
+    tkSquaredBraceClose,      // ']'
+    tkUnknown
+    );
+
+  EScannerError       = class(Exception);
+
+
+  TJSONScanner = class
+  private
+    FSource : TStringList;
+    FCurRow: Integer;
+    FCurToken: TJSONToken;
+    FCurTokenString: string;
+    FCurLine: string;
+    TokenStr: PChar;
+    function GetCurColumn: Integer;
+  protected
+    procedure Error(const Msg: string);overload;
+    procedure Error(const Msg: string; Args: array of Const);overload;
+    function DoFetchToken: TJSONToken;
+  public
+    constructor Create(Source : TStream); overload;
+    constructor Create(Source : String); overload;
+    destructor Destroy; override;
+    function FetchToken: TJSONToken;
+
+
+    property CurLine: string read FCurLine;
+    property CurRow: Integer read FCurRow;
+    property CurColumn: Integer read GetCurColumn;
+
+    property CurToken: TJSONToken read FCurToken;
+    property CurTokenString: string read FCurTokenString;
+  end;
+
+const
+  TokenInfos: array[TJSONToken] of string = (
+    'EOF',
+    'Whitespace',
+    'String',
+    'Number',
+    'True',
+    'False',
+    'Null',
+    ',',
+    ':',
+    '{',
+    '}',
+    '[',
+    ']',
+    ''
+  );
+
+
+implementation
+
+constructor TJSONScanner.Create(Source : TStream);
+
+begin
+  FSource:=TStringList.Create;
+  FSource.LoadFromStream(Source);
+end;
+
+constructor TJSONScanner.Create(Source : String);
+begin
+  FSource:=TStringList.Create;
+  FSource.Text:=Source;
+end;
+
+destructor TJSONScanner.Destroy;
+begin
+  FreeAndNil(FSource);
+  Inherited;
+end;
+
+
+function TJSONScanner.FetchToken: TJSONToken;
+  
+begin
+  Result:=DoFetchToken;
+end;
+
+procedure TJSONScanner.Error(const Msg: string);
+begin
+  raise EScannerError.Create(Msg);
+end;
+
+procedure TJSONScanner.Error(const Msg: string; Args: array of Const);
+begin
+  raise EScannerError.CreateFmt(Msg, Args);
+end;
+
+function TJSONScanner.DoFetchToken: TJSONToken;
+
+  function FetchLine: Boolean;
+  begin
+    Result:=FCurRow<FSource.Count;
+    if Result then
+      begin
+      FCurLine:=FSource[FCurRow];
+      TokenStr:=PChar(FCurLine);
+      Inc(FCurRow);
+      end
+    else             
+      begin
+      FCurLine:='';
+      TokenStr:=nil;
+      end;
+  end;
+
+var
+  TokenStart, CurPos: PChar;
+  it : TJSONToken;
+  I : Integer;
+  OldLength, SectionLength, Index: Integer;
+  S : String;
+  
+begin
+  if TokenStr = nil then
+    if not FetchLine then
+      begin
+      Result := tkEOF;
+      FCurToken := Result;
+      exit;
+      end;
+
+  FCurTokenString := '';
+
+  case TokenStr[0] of
+    #0:         // Empty line
+      begin
+      FetchLine;
+      Result := tkWhitespace;
+      end;
+    #9, ' ':
+      begin
+      Result := tkWhitespace;
+      repeat
+        Inc(TokenStr);
+        if TokenStr[0] = #0 then
+          if not FetchLine then
+          begin
+            FCurToken := Result;
+            exit;
+          end;
+      until not (TokenStr[0] in [#9, ' ']);
+      end;
+    '"':
+      begin
+        Inc(TokenStr);
+        TokenStart := TokenStr;
+        OldLength := 0;
+        FCurTokenString := '';
+
+        while not (TokenStr[0] in [#0,'"']) do
+          begin
+          if (TokenStr[0]='\') then
+            begin
+            // Save length
+            SectionLength := TokenStr - TokenStart;
+            Inc(TokenStr);
+            // Read escaped token
+            Case TokenStr[0] of
+              '"' : S:='"';
+              't' : S:=#9;
+              'b' : S:=#8;
+              'n' : S:=#10;
+              'r' : S:=#13;
+              'f' : S:=#12;
+              '\' : S:='\';
+              '/' : S:='/';
+              'u' : begin
+                    S:='0000';
+                    For I:=1 to 4 do
+                      begin
+                      Inc(TokenStr);
+                      Case TokenStr[0] of
+                        '0'..'9','A'..'F','a'..'f' :
+                          S[i]:=Upcase(TokenStr[0]);
+                      else
+                        Error(SErrInvalidCharacter, [TokenStr[0]]);
+                      end;
+                      end;
+                    // Takes care of conversion...  
+                    S:=WideChar(StrToInt('$'+S));  
+                    end;
+              #0  : Error(SErrOpenString);
+            else
+              Error(SErrInvalidCharacter, [TokenStr[0]]);  
+            end;
+            SetLength(FCurTokenString, OldLength + SectionLength+1+Length(S));
+            if SectionLength > 0 then
+              Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
+            Move(S[1],FCurTokenString[OldLength + SectionLength+1],Length(S));
+            Inc(OldLength, SectionLength+Length(S));
+            // Next char
+            // Inc(TokenStr);
+            TokenStart := TokenStr+1;
+            end;
+          if TokenStr[0] = #0 then
+            Error(SErrOpenString);
+          Inc(TokenStr);
+          end;
+        if TokenStr[0] = #0 then
+          Error(SErrOpenString);
+        SectionLength := TokenStr - TokenStart;
+        SetLength(FCurTokenString, OldLength + SectionLength);
+        if SectionLength > 0 then
+          Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
+        Inc(TokenStr);
+        Result := tkString;
+      end;
+    ',':
+      begin
+        Inc(TokenStr);
+        Result := tkComma;
+      end;
+    '0'..'9','-':
+      begin
+        TokenStart := TokenStr;
+        while true do
+        begin
+          Inc(TokenStr);
+          case TokenStr[0] of
+            '.':
+              begin
+                if TokenStr[1] in ['0'..'9', 'e', 'E'] then
+                begin
+                  Inc(TokenStr);
+                  repeat
+                    Inc(TokenStr);
+                  until not (TokenStr[0] in ['0'..'9', 'e', 'E','-','+']);
+                end;
+                break;
+              end;
+            '0'..'9': ;
+            'e', 'E':
+              begin
+                Inc(TokenStr);
+                if TokenStr[0] in ['-','+']  then
+                  Inc(TokenStr);
+                while TokenStr[0] in ['0'..'9'] do
+                  Inc(TokenStr);
+                break;
+              end;
+            else
+              break;
+          end;
+        end;
+        SectionLength := TokenStr - TokenStart;
+        SetLength(FCurTokenString, SectionLength);
+        if SectionLength > 0 then
+          Move(TokenStart^, FCurTokenString[1], SectionLength);
+        Result := tkNumber;
+      end;
+    ':':
+      begin
+        Inc(TokenStr);
+        Result := tkColon;
+      end;
+    '{':
+      begin
+        Inc(TokenStr);
+        Result := tkCurlyBraceOpen;
+      end;
+    '}':
+      begin
+        Inc(TokenStr);
+        Result := tkCurlyBraceClose;
+      end;  
+    '[':
+      begin
+        Inc(TokenStr);
+        Result := tkSquaredBraceOpen;
+      end;
+    ']':
+      begin
+        Inc(TokenStr);
+        Result := tkSquaredBraceClose;
+      end;
+    'T','t','F','f','N','n' :
+      begin
+        TokenStart := TokenStr;
+        repeat
+          Inc(TokenStr);
+        until not (TokenStr[0] in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
+        SectionLength := TokenStr - TokenStart;
+        SetLength(FCurTokenString, SectionLength);
+        if SectionLength > 0 then
+          Move(TokenStart^, FCurTokenString[1], SectionLength);
+        for it := tkTrue to tkNull do
+          if CompareText(CurTokenString, TokenInfos[it]) = 0 then
+            begin
+            Result := it;
+            FCurToken := Result;
+            exit;
+            end;
+        Error(SErrInvalidCharacter, [TokenStart[0]]);
+      end;
+  else
+    Error(SErrInvalidCharacter, [TokenStr[0]]);
+  end;
+
+  FCurToken := Result;
+end;
+
+function TJSONScanner.GetCurColumn: Integer;
+begin
+  Result := TokenStr - PChar(CurLine);
+end;
+
+end.

packages/fcl-json/tests/testjson.lpi

@@ -0,0 +1,65 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="5"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="3">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="FPCUnitTestRunner"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="FCL"/>
+      </Item3>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="testjson.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="testjson"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="testjsonparser.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="testjsonparser"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="testjsondata.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="testjsondata"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

packages/fcl-json/tests/testjson.pp

@@ -0,0 +1,21 @@
+program testjson;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, consoletestrunner, testjsondata, testjsonparser;
+type
+  { TLazTestRunner }
+   TMyTestRunner = class(TTestRunner)
+   protected
+     // override the protected methods of TTestRunner to customize its behavior
+   end;
+      
+var
+  Application: TMyTestRunner;
+begin
+  Application := TMyTestRunner.Create(nil); 
+  Application.Initialize;
+  Application.Run;  
+  Application.Free;
+end.

packages/fcl-json/tests/testjsonparser.pp

@@ -0,0 +1,364 @@
+unit testjsonparser;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry,fpjson,
+  jsonParser,testjsondata;
+
+type
+
+  { TTestParser }
+
+  TTestParser= class(TTestJSON)
+  private
+    procedure DoTestError(S: String);
+    procedure DoTestFloat(F: TJSONFloat); overload;
+    procedure DoTestFloat(F: TJSONFloat; S: String); overload;
+    procedure DoTestObject(S: String; const ElNames: array of String);
+    procedure DoTestString(S : String);
+    procedure DoTestArray(S: String; ACount: Integer);
+  published
+    procedure TestEmpty;
+    procedure TestNull;
+    procedure TestTrue;
+    procedure TestFalse;
+    procedure TestFloat;
+    procedure TestInteger;
+    procedure TestString;
+    procedure TestArray;
+    procedure TestObject;
+    procedure TestMixed;
+    procedure TestErrors;
+  end;
+
+implementation
+
+procedure TTestParser.TestEmpty;
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+  
+begin
+  P:=TJSONParser.Create('');
+  Try
+    J:=P.Parse;
+    If (J<>Nil) then
+      Fail('Empty returns Nil');
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+procedure TTestParser.TestInteger;
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  P:=TJSONParser.Create('1');
+  Try
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of 1 fails');
+    TestJSONType(J,jtNumber);
+    TestAsInteger(J,1);
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+procedure TTestParser.TestNull;
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  P:=TJSONParser.Create('Null');
+  Try
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of Null fails');
+    TestJSONType(J,jtNull);
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+procedure TTestParser.TestTrue;
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  P:=TJSONParser.Create('True');
+  Try
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of True fails');
+    TestJSONType(J,jtBoolean);
+    TestAsBoolean(J,True);
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+procedure TTestParser.TestFalse;
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  P:=TJSONParser.Create('False');
+  Try
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of False fails');
+    TestJSONType(J,jtBoolean);
+    TestAsBoolean(J,False);
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+procedure TTestParser.TestFloat;
+
+
+begin
+  DoTestFloat(1.2);
+  DoTestFloat(-1.2);
+  DoTestFloat(0);
+  DoTestFloat(1.2e1);
+  DoTestFloat(-1.2e1);
+  DoTestFloat(0);
+  DoTestFloat(1.2,'1.2');
+  DoTestFloat(-1.2,'-1.2');
+  DoTestFloat(0,'0.0');
+end;
+
+procedure TTestParser.TestString;
+
+begin
+  DoTestString('A string');
+  DoTestString('');
+  DoTestString('\"');
+end;
+
+
+procedure TTestParser.TestArray;
+
+Var
+  S1,S2,S3 : String;
+
+
+begin
+  DoTestArray('[]',0);
+  DoTestArray('[Null]',1);
+  DoTestArray('[True]',1);
+  DoTestArray('[False]',1);
+  DoTestArray('[1]',1);
+  DoTestArray('[1, 2]',2);
+  DoTestArray('[1, 2, 3]',3);
+  Str(1.2,S1);
+  Str(2.3,S2);
+  Str(3.4,S3);
+  DoTestArray('['+S1+']',1);
+  DoTestArray('['+S1+', '+S2+']',2);
+  DoTestArray('['+S1+', '+S2+', '+S3+']',3);
+  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, 1]',2);
+  DoTestArray('[1, "A string"]',2);
+  DoTestArray('[1, []]',2);
+  DoTestArray('[1, [1, 2]]',2);
+end;
+
+procedure TTestParser.TestMixed;
+
+begin
+  DoTestArray('[1, {}]',2);
+  DoTestArray('[1, { "a" : 1 }]',2);
+  DoTestArray('[1, { "a" : 1 }, 1]',3);
+  DoTestObject('{ "a" : [1, 2] }',['a']);
+  DoTestObject('{ "a" : [1, 2], "B" : { "c" : "d" } }',['a','B']);
+end;
+
+procedure TTestParser.TestObject;
+begin
+  DoTestObject('{}',[]);
+  DoTestObject('{ "a" : 1 }',['a']);
+  DoTestObject('{ "a" : 1, "B" : "String" }',['a','B']);
+  DoTestObject('{ "a" : 1, "B" : {} }',['a','B']);
+  DoTestObject('{ "a" : 1, "B" : { "c" : "d" } }',['a','B']);
+end;
+
+
+procedure TTestParser.DoTestObject(S : String; Const ElNames : Array of String);
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+  O : TJSONObject;
+  I : Integer;
+
+begin
+  P:=TJSONParser.Create(S);
+  Try
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of object "'+S+'" fails');
+    TestJSONType(J,jtObject);
+    TestItemCount(J,High(ElNames)-Low(ElNames)+1);
+    O:=TJSONObject(J);
+    For I:=Low(ElNames) to High(ElNames) do
+      AssertEquals(Format('Element %d name',[I-Low(Elnames)])
+                   ,ElNames[i], O.Names[I-Low(ElNames)]);
+    TestJSON(J,S);
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+
+procedure TTestParser.DoTestArray(S : String; ACount : Integer);
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  P:=TJSONParser.Create(S);
+  Try
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of array "'+S+'" fails');
+    TestJSONType(J,jtArray);
+    TestItemCount(J,ACount);
+    TestJSON(J,S);
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+procedure TTestParser.TestErrors;
+
+begin
+  DoTestError('a');
+  DoTestError('"b');
+  DoTestError('1Tru');
+  DoTestError('b"');
+  DoTestError('{"a" : }');
+  DoTestError('{"a" : ""');
+  DoTestError('{"a : ""');
+  DoTestError('[1,]');
+  DoTestError('[,]');
+  DoTestError('[,,]');
+  DoTestError('[1,,]');
+end;
+
+procedure TTestParser.DoTestError(S : String);
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+  ParseOK : Boolean;
+  N : String;
+
+begin
+  ParseOK:=False;
+  P:=TJSONParser.Create(S);
+  J:=Nil;
+  Try
+    Try
+      Repeat
+        FreeAndNil(J);
+        J:=P.Parse;
+        ParseOK:=True;
+        If (J<>Nil) then
+          N:=J.ClassName;
+      Until (J=Nil)
+    Finally
+      FreeAndNil(J);
+      FreeAndNil(P);
+    end;
+  except
+    ParseOk:=False;
+  end;
+  If ParseOK then
+    Fail('Parse of JSON string "'+S+'" should fail, but returned '+N);
+end;
+
+procedure TTestParser.DoTestString(S: String);
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  P:=TJSONParser.Create('"'+S+'"');
+  Try
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of string "'+S+'" fails');
+    TestJSONType(J,jtString);
+    TestAsString(J,JSONStringToString(S));
+    TestJSON(J,'"'+S+'"');
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+
+end;
+
+procedure TTestParser.DoTestFloat(F : TJSONFloat);
+
+Var
+  S : String;
+
+begin
+  Str(F,S);
+  DoTestFloat(F,S);
+end;
+
+procedure TTestParser.DoTestFloat(F : TJSONFloat; S : String);
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  P:=TJSONParser.Create(S);
+  Try
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of float '+S+' fails');
+    TestJSONType(J,jtNumber);
+    TestAsFloat(J,F);
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+
+initialization
+  RegisterTest(TTestParser);
+end.
+