* SAX JSON reader, rework JSONParser on top of that

git-svn-id: trunk@36580 -

.gitattributes

@@ -2543,6 +2543,7 @@ packages/fcl-json/src/fpjsonrtti.pp svneol=native#text/plain
 packages/fcl-json/src/fpjsontopas.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/jsonreader.pp svneol=native#text/plain
 packages/fcl-json/src/jsonscanner.pp svneol=native#text/plain
 packages/fcl-json/tests/jsonconftest.pp svneol=native#text/plain
 packages/fcl-json/tests/tcjsontocode.pp svneol=native#text/plain
@@ -2555,6 +2556,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/testjsonreader.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-json/src/jsonparser.pp

@@ -19,58 +19,47 @@ unit jsonparser;
 interface
 
 uses
-  Classes, SysUtils, fpJSON, jsonscanner;
+  Classes, SysUtils, fpJSON, jsonscanner, jsonreader;
   
 Type
 
   { TJSONParser }
 
-  TJSONParser = Class(TObject)
-  Private
-    FScanner : TJSONScanner;
-    function GetO(AIndex: TJSONOption): Boolean;
-    function GetOptions: TJSONOptions; inline;
-    function ParseNumber: TJSONNumber;
-    procedure SetO(AIndex: TJSONOption; AValue: Boolean);
-    procedure SetOptions(AValue: TJSONOptions);
+  TJSONParser = Class(TBaseJSONReader)
+  private
+    FStack : Array of TJSONData;
+    FStackPos : integer;
+    FStruct : TJSONData;
+    FValue : TJSONData;
+    FKey: TJSONStringType;
+    procedure Pop(aType: TJSONType);
+    Procedure Push(AValue : TJSONData);
+    Function NewValue(AValue : TJSONData) : TJSONData;
   Protected
-    procedure DoError(const Msg: String);
-    function DoParse(AtCurrent,AllowEOF: Boolean): TJSONData;
-    function GetNextToken: TJSONToken;
-    function CurrentTokenString: String;
-    function CurrentToken: TJSONToken; inline;
-    function ParseArray: TJSONArray;
-    function ParseObject: TJSONObject;
-    Property Scanner : TJSONScanner read FScanner;
+    Procedure KeyValue(Const AKey : TJSONStringType); override;
+    Procedure StringValue(Const AValue : TJSONStringType);override;
+    Procedure NullValue; override;
+    Procedure FloatValue(Const AValue : Double); override;
+    Procedure BooleanValue(Const AValue : Boolean); override;
+    Procedure NumberValue(Const AValue : TJSONStringType); override;
+    Procedure IntegerValue(Const AValue : integer); override;
+    Procedure Int64Value(Const AValue : int64); override;
+    Procedure QWordValue(Const AValue : QWord); override;
+    Procedure StartArray; override;
+    Procedure StartObject; override;
+    Procedure EndArray; override;
+    Procedure EndObject; override;
   Public
     function Parse: TJSONData;
-    Constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
-    Constructor Create(Source : TJSONStringType; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
-    constructor Create(Source: TStream; AOptions: TJSONOptions); overload;
-    constructor Create(const Source: String; AOptions: TJSONOptions); overload;
-    destructor Destroy();override;
-    // Use strict JSON: " for strings, object members are strings, not identifiers
-    Property Strict : Boolean Index joStrict Read GetO Write SetO ; deprecated 'use options instead';
-    // if set to TRUE, then strings will be converted to UTF8 ansistrings, not system codepage ansistrings.
-    Property UseUTF8 : Boolean index joUTF8 Read GetO Write SetO; deprecated 'Use options instead';
-    // Parsing options
-    Property Options : TJSONOptions Read GetOptions Write SetOptions;
   end;
   
-  EJSONParser = Class(EParserError);
+  EJSONParser = jsonReader.EJSONParser;
   
 implementation
 
 Resourcestring
-  SErrUnexpectedEOF   = 'Unexpected EOF encountered.';
-  SErrUnexpectedToken = 'Unexpected token (%s) encountered.';
-  SErrExpectedColon   = 'Expected colon (:), got token "%s".';
-  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';
-  SErrNoScanner = 'No scanner. No source specified ?';
-  
+  SErrStructure = 'Structural error';
+
 { TJSONParser }
 
 procedure DefJSONParserHandler(AStream: TStream; const AUseUTF8: Boolean; out
@@ -89,277 +78,142 @@ begin
   end;
 end;
 
-function TJSONParser.Parse: TJSONData;
+procedure TJSONParser.Pop(aType: TJSONType);
 
 begin
-  if (FScanner=Nil) then
-    DoError(SErrNoScanner);
-  Result:=DoParse(False,True);
+  if (FStackPos=0) then
+    DoError(SErrStructure);
+  If (FStruct.JSONType<>aType) then
+    DoError(SErrStructure);
+  Dec(FStackPos);
+  FStruct:=FStack[FStackPos];
 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;
+procedure TJSONParser.Push(AValue: TJSONData);
 
 begin
-  Result:=FScanner.CurToken;
+  if (FStackPos=Length(FStack)) then
+    SetLength(FStack,FStackPos+10);
+  FStack[FStackPos]:=FStruct;
+  Inc(FStackPos);
+  FStruct:=AValue;
 end;
 
-function TJSONParser.CurrentTokenString: String;
+function TJSONParser.NewValue(AValue: TJSONData): TJSONData;
+begin
+  Result:=AValue;
+  // Add to existing structural type
+  if (FStruct is TJSONObject) then
+    begin
+    TJSONObject(FStruct).Add(FKey,AValue);
+    FKey:='';
+    end
+  else if (FStruct is TJSONArray) then
+    TJSONArray(FStruct).Add(AValue);
+  // The first actual value is our result
+  if (FValue=Nil) then
+    FValue:=AValue;
+end;
 
+procedure TJSONParser.KeyValue(const AKey: TJSONStringType);
 begin
-  If CurrentToken in [tkString,tkIdentifier,tkNumber,tkComment] then
-    Result:=FScanner.CurTokenString
+  if (FStruct is TJSONObject) and (FKey='') then
+    FKey:=Akey
   else
-    Result:=TokenInfos[CurrentToken];
+    DoError('Duplicatekey or no object')
 end;
 
-function TJSONParser.DoParse(AtCurrent, AllowEOF: Boolean): TJSONData;
-
-var
-  T : TJSONToken;
-  
+procedure TJSONParser.StringValue(const AValue: TJSONStringType);
 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:=CreateJSON;
-      tkTrue,
-      tkFalse : Result:=CreateJSON(t=tkTrue);
-      tkString : if joUTF8 in Options then
-                   Result:=CreateJSON(UTF8Decode(CurrentTokenString))
-                     else
-                       Result:=CreateJSON(CurrentTokenString);
-      tkCurlyBraceOpen : Result:=ParseObject;
-      tkCurlyBraceClose : DoError(SErrUnexpectedToken);
-      tkSQuaredBraceOpen : Result:=ParseArray;
-      tkSQuaredBraceClose : DoError(SErrUnexpectedToken);
-      tkNumber : Result:=ParseNumber;
-      tkComma : DoError(SErrUnexpectedToken);
-      tkIdentifier : DoError(SErrUnexpectedToken);
-    end;
-  except
-    FreeAndNil(Result);
-    Raise;
-  end;
+  NewValue(CreateJSON(AValue))
 end;
 
-
-// Creates the correct JSON number type, based on the current token.
-function TJSONParser.ParseNumber: TJSONNumber;
-
-Var
-  I : Integer;
-  I64 : Int64;
-  QW  : QWord;
-  F : TJSONFloat;
-  S : String;
-
+procedure TJSONParser.NullValue;
 begin
-  S:=CurrentTokenString;
-  I:=0;
-  if TryStrToQWord(S,QW) then
-    begin
-    if QW>qword(high(Int64)) then
-      Result:=CreateJSON(QW)
-    else
-      if QW>MaxInt then
-      begin
-        I64 := QW;
-        Result:=CreateJSON(I64);
-      end
-      else
-      begin
-        I := QW;
-        Result:=CreateJSON(I);
-      end
-    end
-  else
-    begin
-    If TryStrToInt64(S,I64) then
-      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:=CreateJSON(F);
-      end;
-    end;
-
+  NewValue(CreateJSON);
 end;
 
-function TJSONParser.GetO(AIndex: TJSONOption): Boolean;
+procedure TJSONParser.FloatValue(const AValue: Double);
 begin
-  Result:=AIndex in Options;
+  NewValue(CreateJSON(AValue));
 end;
 
-function TJSONParser.GetOptions: TJSONOptions;
+procedure TJSONParser.BooleanValue(const AValue: Boolean);
 begin
-  Result:=FScanner.Options
+  NewValue(CreateJSON(AValue));
 end;
 
-procedure TJSONParser.SetO(AIndex: TJSONOption; AValue: Boolean);
+procedure TJSONParser.NumberValue(const AValue: TJSONStringType);
 begin
-  if aValue then
-    FScanner.Options:=FScanner.Options+[AINdex]
-  else
-    FScanner.Options:=FScanner.Options-[AINdex]
+  // Do nothing
 end;
 
-procedure TJSONParser.SetOptions(AValue: TJSONOptions);
+procedure TJSONParser.IntegerValue(const AValue: integer);
 begin
-  FScanner.Options:=AValue;
+  NewValue(CreateJSON(AValue));
 end;
 
-
-// Current token is {, on exit current token is }
-function TJSONParser.ParseObject: TJSONObject;
-
-Var
-  T : TJSONtoken;
-  E : TJSONData;
-  N : String;
-  LastComma : Boolean;
-
+procedure TJSONParser.Int64Value(const AValue: int64);
 begin
-  LastComma:=False;
-  Result:=CreateJSONObject([]);
-  Try
-    T:=GetNextToken;
-    While T<>tkCurlyBraceClose do
-      begin
-      If (T<>tkString) and (T<>tkIdentifier) then
-        DoError(SErrExpectedElementName);
-      N:=CurrentTokenString;
-      T:=GetNextToken;
-      If (T<>tkColon) then
-        DoError(SErrExpectedColon);
-      E:=DoParse(False,False);
-      Result.Add(N,E);
-      T:=GetNextToken;
-      If Not (T in [tkComma,tkCurlyBraceClose]) then
-        DoError(SExpectedCommaorBraceClose);
-      If T=tkComma then
-        begin
-        T:=GetNextToken;
-        LastComma:=(t=tkCurlyBraceClose);
-        end;
-      end;
-    If LastComma and ((joStrict in Options) or not (joIgnoreTrailingComma in Options))  then // Test for ,} case
-      DoError(SErrUnExpectedToken);
-  Except
-    FreeAndNil(Result);
-    Raise;
-  end;
+  NewValue(CreateJSON(AValue));
 end;
 
-// Current token is [, on exit current token is ]
-function TJSONParser.ParseArray: TJSONArray;
-
-Var
-  T : TJSONtoken;
-  E : TJSONData;
-  LastComma : Boolean;
-  S : TJSONOPTions;
+procedure TJSONParser.QWordValue(const AValue: QWord);
 begin
-  Result:=CreateJSONArray([]);
-  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);
-    S:=Options;
-    If LastComma and ((joStrict in S) or not (joIgnoreTrailingComma in S))  then // Test for ,] case
-      DoError(SErrUnExpectedToken);
-  Except
-    FreeAndNil(Result);
-    Raise;
-  end;
+  NewValue(CreateJSON(AValue));
 end;
 
-// Get next token, discarding whitespace
-function TJSONParser.GetNextToken: TJSONToken;
-
+procedure TJSONParser.StartArray;
 begin
-  Repeat
-    Result:=FScanner.FetchToken;
-  Until (Not (Result in [tkComment,tkWhiteSpace]));
+  Push(NewValue(CreateJSONArray([])))
 end;
 
-procedure TJSONParser.DoError(const Msg: String);
-
-Var
-  S : String;
 
+procedure TJSONParser.StartObject;
 begin
-  S:=Format(Msg,[CurrentTokenString]);
-  S:=Format('Error at line %d, Pos %d:',[FScanner.CurRow,FSCanner.CurColumn])+S;
-  Raise EJSONParser.Create(S);
+  Push(NewValue(CreateJSONObject([])));
 end;
 
-constructor TJSONParser.Create(Source: TStream; AUseUTF8 : Boolean = True);
+procedure TJSONParser.EndArray;
 begin
-  Inherited Create;
-  FScanner:=TJSONScanner.Create(Source,[joUTF8]);
-  if AUseUTF8 then
-   Options:=Options + [joUTF8];
+  Pop(jtArray);
 end;
 
-constructor TJSONParser.Create(Source: TJSONStringType; AUseUTF8 : Boolean = True);
+procedure TJSONParser.EndObject;
 begin
-  Inherited Create;
-  FScanner:=TJSONScanner.Create(Source,[joUTF8]);
-  if AUseUTF8 then
-   Options:=Options + [joUTF8];
+  Pop(jtObject);
 end;
 
-constructor TJSONParser.Create(Source: TStream; AOptions: TJSONOptions);
-begin
-  FScanner:=TJSONScanner.Create(Source,AOptions);
-end;
 
-constructor TJSONParser.Create(const Source: String; AOptions: TJSONOptions);
-begin
-  FScanner:=TJSONScanner.Create(Source,AOptions);
-end;
+function TJSONParser.Parse: TJSONData;
 
-destructor TJSONParser.Destroy();
 begin
-  FreeAndNil(FScanner);
-  inherited Destroy();
+  SetLength(FStack,0);
+  FStackPos:=0;
+  FValue:=Nil;
+  FStruct:=Nil;
+  try
+    DoExecute;
+    Result:=FValue;
+  except
+    On E : exception do
+      begin
+      FreeAndNil(FValue);
+      FStackPos:=0;
+      SetLength(FStack,0);
+      Raise;
+      end;
+  end;
 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.
+}
+
+
 Procedure InitJSONHandler;
 
 begin

packages/fcl-json/src/jsonreader.pp

@@ -0,0 +1,616 @@
+{
+    This file is part of the Free Component Library
+
+    JSON SAX-like Reader
+    Copyright (c) 2007 by Michael Van Canneyt [email protected]
+
+    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 jsonreader;
+
+interface
+
+uses
+  Classes, SysUtils, fpJSON, jsonscanner;
+  
+Type
+
+  { TBaseJSONReader }
+
+  TBaseJSONReader = Class(TObject)
+  Private
+    FScanner : TJSONScanner;
+    function GetO(AIndex: TJSONOption): Boolean;
+    function GetOptions: TJSONOptions; inline;
+    procedure SetO(AIndex: TJSONOption; AValue: Boolean);
+    procedure SetOptions(AValue: TJSONOptions);
+  Protected
+    procedure DoError(const Msg: String);
+    Procedure DoParse(AtCurrent,AllowEOF: Boolean);
+    function GetNextToken: TJSONToken;
+    function CurrentTokenString: String;
+    function CurrentToken: TJSONToken; inline;
+
+    Procedure KeyValue(Const AKey : TJSONStringType); virtual; abstract;
+    Procedure StringValue(Const AValue : TJSONStringType);virtual; abstract;
+    Procedure NullValue; virtual; abstract;
+    Procedure FloatValue(Const AValue : Double); virtual; abstract;
+    Procedure BooleanValue(Const AValue : Boolean); virtual; abstract;
+    Procedure NumberValue(Const AValue : TJSONStringType); virtual; abstract;
+    Procedure IntegerValue(Const AValue : integer); virtual; abstract;
+    Procedure Int64Value(Const AValue : int64); virtual; abstract;
+    Procedure QWordValue(Const AValue : QWord); virtual; abstract;
+    Procedure StartArray; virtual; abstract;
+    Procedure StartObject; virtual; abstract;
+    Procedure EndArray; virtual; abstract;
+    Procedure EndObject; virtual; abstract;
+
+    Procedure ParseArray;
+    Procedure ParseObject;
+    Procedure ParseNumber;
+    Procedure DoExecute;
+    Property Scanner : TJSONScanner read FScanner;
+  Public
+    Constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
+    Constructor Create(Source : TJSONStringType; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
+    constructor Create(Source: TStream; AOptions: TJSONOptions); overload;
+    constructor Create(const Source: String; AOptions: TJSONOptions); overload;
+    destructor Destroy();override;
+    // Parsing options
+    Property Options : TJSONOptions Read GetOptions Write SetOptions;
+  end;
+
+  TOnJSONBoolean = Procedure (Sender : TObject; Const AValue : Boolean) of object;
+  TOnJSONFloat = Procedure (Sender : TObject; Const AValue : TJSONFloat) of object;
+  TOnJSONInt64 = Procedure (Sender : TObject; Const AValue : Int64) of object;
+  TOnJSONQWord = Procedure (Sender : TObject; Const AValue : QWord) of object;
+  TOnJSONInteger = Procedure (Sender : TObject; Const AValue : Integer) of object;
+  TOnJSONString = Procedure (Sender : TObject; Const AValue : TJSONStringType) of Object;
+  TOnJSONKey = Procedure (Sender : TObject; Const AKey : TJSONStringType) of Object;
+
+
+  { TJSONEventReader }
+
+  TJSONEventReader = Class(TBaseJSONReader)
+  Private
+    FOnBooleanValue: TOnJSONBoolean;
+    FOnEndArray: TNotifyEvent;
+    FOnEndObject: TNotifyEvent;
+    FOnFloatValue: TOnJSONFloat;
+    FOnInt64Value: TOnJSONInt64;
+    FOnIntegerValue: TOnJSONInteger;
+    FOnKeyName: TOnJSONKey;
+    FOnNullValue: TNotifyEvent;
+    FOnNumberValue: TOnJSONString;
+    FOnQWordValue: TOnJSONQWord;
+    FOnStartArray: TNotifyEvent;
+    FOnStartObject: TNotifyEvent;
+    FOnStringValue: TOnJSONString;
+  Protected
+    Procedure KeyValue(Const AKey : TJSONStringType); override;
+    Procedure StringValue(Const AValue : TJSONStringType);override;
+    Procedure NullValue; override;
+    Procedure FloatValue(Const AValue : Double); override;
+    Procedure BooleanValue(Const AValue : Boolean); override;
+    Procedure NumberValue(Const AValue : TJSONStringType); override;
+    Procedure IntegerValue(Const AValue : integer); override;
+    Procedure Int64Value(Const AValue : int64); override;
+    Procedure QWordValue(Const AValue : QWord); override;
+    Procedure StartArray; override;
+    Procedure StartObject; override;
+    Procedure EndArray; override;
+    Procedure EndObject; override;
+  Public
+    Procedure Execute;
+    Property OnNullValue : TNotifyEvent Read FOnNullValue Write FOnNullValue;
+    Property OnBooleanValue : TOnJSONBoolean Read FOnBooleanValue Write FOnBooleanValue;
+    Property OnNumberValue : TOnJSONString Read FOnNumberValue Write FOnNumberValue;
+    Property OnFloatValue : TOnJSONFloat Read FOnFloatValue Write FOnFloatValue;
+    Property OnIntegerValue : TOnJSONInteger Read FOnIntegerValue Write FOnIntegerValue;
+    Property OnInt64Value : TOnJSONInt64 Read FOnInt64Value Write FOnInt64Value;
+    Property OnQWordValue : TOnJSONQWord Read FOnQWordValue Write FOnQWordValue;
+    Property OnStringValue : TOnJSONString Read FOnStringValue Write FOnStringValue;
+    Property OnKeyName : TOnJSONKey Read FOnKeyName Write FOnKeyName;
+    Property OnStartObject : TNotifyEvent Read FOnStartObject Write FOnStartObject;
+    Property OnEndObject : TNotifyEvent Read FOnEndObject Write FOnEndObject;
+    Property OnStartArray : TNotifyEvent Read FOnStartArray Write FOnStartArray;
+    Property OnEndArray : TNotifyEvent Read FOnEndArray Write FOnEndArray;
+  end;
+
+  IJSONConsumer = Interface ['{60F9D640-2A69-4AAB-8EE1-0DB6DC614D27}']
+    Procedure NullValue;
+    Procedure BooleanValue (const AValue : Boolean);
+    Procedure NumberValue (const AValue : TJSONStringType);
+    Procedure FloatValue (const AValue : TJSONFloat);
+    Procedure Int64Value (const AValue : Int64);
+    Procedure QWordValue (const AValue : QWord);
+    Procedure IntegerValue(const AValue : Integer) ;
+    Procedure StringValue(const AValue : TJSONStringType) ;
+    Procedure KeyName(const AKey : TJSONStringType);
+    Procedure StartObject;
+    Procedure EndObject;
+    Procedure StartArray;
+    Procedure EndArray;
+  end;
+
+  { TJSONConsumerReader }
+
+  TJSONConsumerReader = Class(TBaseJSONReader)
+  Private
+    FConsumer: IJSONConsumer;
+  Protected
+    Procedure KeyValue(Const AKey : TJSONStringType); override;
+    Procedure StringValue(Const AValue : TJSONStringType);override;
+    Procedure NullValue; override;
+    Procedure FloatValue(Const AValue : Double); override;
+    Procedure BooleanValue(Const AValue : Boolean); override;
+    Procedure NumberValue(Const AValue : TJSONStringType); override;
+    Procedure IntegerValue(Const AValue : integer); override;
+    Procedure Int64Value(Const AValue : int64); override;
+    Procedure QWordValue(Const AValue : QWord); override;
+    Procedure StartArray; override;
+    Procedure StartObject; override;
+    Procedure EndArray; override;
+    Procedure EndObject; override;
+  Public
+    Procedure Execute;
+    Property Consumer : IJSONConsumer Read FConsumer Write FConsumer;
+  end;
+
+  EJSONParser = Class(EParserError);
+  
+implementation
+
+Resourcestring
+  SErrUnexpectedEOF   = 'Unexpected EOF encountered.';
+  SErrUnexpectedToken = 'Unexpected token (%s) encountered.';
+  SErrExpectedColon   = 'Expected colon (:), got token "%s".';
+  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';
+  SErrNoScanner = 'No scanner. No source specified ?';
+  
+{ TBaseJSONReader }
+
+
+Procedure TBaseJSONReader.DoExecute;
+
+begin
+  if (FScanner=Nil) then
+    DoError(SErrNoScanner);
+  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 TBaseJSONReader.CurrentToken: TJSONToken;
+
+begin
+  Result:=FScanner.CurToken;
+end;
+
+function TBaseJSONReader.CurrentTokenString: String;
+
+begin
+  If CurrentToken in [tkString,tkIdentifier,tkNumber,tkComment] then
+    Result:=FScanner.CurTokenString
+  else
+    Result:=TokenInfos[CurrentToken];
+end;
+
+procedure TBaseJSONReader.DoParse(AtCurrent, AllowEOF: Boolean);
+
+var
+  T : TJSONToken;
+  
+begin
+  If not AtCurrent then
+    T:=GetNextToken
+  else
+    T:=FScanner.CurToken;
+  Case T of
+    tkEof : If Not AllowEof then
+              DoError(SErrUnexpectedEOF);
+    tkNull  : NullValue;
+    tkTrue,
+    tkFalse : BooleanValue(t=tkTrue);
+    tkString : if joUTF8 in Options then
+                 StringValue(UTF8Decode(CurrentTokenString))
+               else
+                 StringValue(CurrentTokenString);
+    tkCurlyBraceOpen :
+        ParseObject;
+    tkCurlyBraceClose :
+        DoError(SErrUnexpectedToken);
+    tkSQuaredBraceOpen :
+        ParseArray;
+    tkSQuaredBraceClose :
+        DoError(SErrUnexpectedToken);
+    tkNumber :
+        ParseNumber;
+    tkComma :
+        DoError(SErrUnexpectedToken);
+    tkIdentifier :
+        DoError(SErrUnexpectedToken);
+  end;
+end;
+
+
+// Creates the correct JSON number type, based on the current token.
+procedure TBaseJSONReader.ParseNumber;
+
+Var
+  I : Integer;
+  I64 : Int64;
+  QW  : QWord;
+  F : TJSONFloat;
+  S : String;
+
+begin
+  S:=CurrentTokenString;
+  NumberValue(S);
+  I:=0;
+  if TryStrToQWord(S,QW) then
+    begin
+    if QW>qword(high(Int64)) then
+      QWordValue(QW)
+    else
+      if QW>MaxInt then
+      begin
+        I64 := QW;
+        Int64Value(I64);
+      end
+      else
+      begin
+        I:=QW;
+        IntegerValue(I);
+      end
+    end
+  else
+    begin
+    If TryStrToInt64(S,I64) then
+      if (I64>Maxint) or (I64<-MaxInt) then
+        Int64Value(I64)
+      Else
+        begin
+        I:=I64;
+        IntegerValue(I);
+        end
+    else
+      begin
+      I:=0;
+      Val(S,F,I);
+      If (I<>0) then
+        DoError(SErrInvalidNumber);
+      FloatValue(F);
+      end;
+    end;
+end;
+
+function TBaseJSONReader.GetO(AIndex: TJSONOption): Boolean;
+begin
+  Result:=AIndex in Options;
+end;
+
+function TBaseJSONReader.GetOptions: TJSONOptions;
+begin
+  Result:=FScanner.Options
+end;
+
+procedure TBaseJSONReader.SetO(AIndex: TJSONOption; AValue: Boolean);
+begin
+  if aValue then
+    FScanner.Options:=FScanner.Options+[AINdex]
+  else
+    FScanner.Options:=FScanner.Options-[AINdex]
+end;
+
+procedure TBaseJSONReader.SetOptions(AValue: TJSONOptions);
+begin
+  FScanner.Options:=AValue;
+end;
+
+
+// Current token is {, on exit current token is }
+Procedure TBaseJSONReader.ParseObject;
+
+Var
+  T : TJSONtoken;
+  LastComma : Boolean;
+
+begin
+  LastComma:=False;
+  StartObject;
+  T:=GetNextToken;
+  While T<>tkCurlyBraceClose do
+    begin
+    If (T<>tkString) and (T<>tkIdentifier) then
+      DoError(SErrExpectedElementName);
+    KeyValue(CurrentTokenString);
+    T:=GetNextToken;
+    If (T<>tkColon) then
+      DoError(SErrExpectedColon);
+    DoParse(False,False);
+    T:=GetNextToken;
+    If Not (T in [tkComma,tkCurlyBraceClose]) then
+      DoError(SExpectedCommaorBraceClose);
+    If T=tkComma then
+      begin
+      T:=GetNextToken;
+      LastComma:=(t=tkCurlyBraceClose);
+      end;
+    end;
+  If LastComma and ((joStrict in Options) or not (joIgnoreTrailingComma in Options))  then // Test for ,} case
+    DoError(SErrUnExpectedToken);
+  EndObject;
+end;
+
+// Current token is [, on exit current token is ]
+Procedure TBaseJSONReader.ParseArray;
+
+Var
+  T : TJSONtoken;
+  LastComma : Boolean;
+  S : TJSONOPTions;
+
+begin
+  StartArray;
+  LastComma:=False;
+  Repeat
+    T:=GetNextToken;
+    If (T<>tkSquaredBraceClose) then
+      begin
+      DoParse(True,False);
+      T:=GetNextToken;
+      If Not (T in [tkComma,tkSquaredBraceClose]) then
+        DoError(SExpectedCommaorBraceClose);
+      LastComma:=(t=TkComma);
+      end;
+  Until (T=tkSquaredBraceClose);
+  S:=Options;
+  If LastComma and ((joStrict in S) or not (joIgnoreTrailingComma in S))  then // Test for ,] case
+    DoError(SErrUnExpectedToken);
+  EndArray;
+end;
+
+// Get next token, discarding whitespace
+function TBaseJSONReader.GetNextToken: TJSONToken;
+
+begin
+  Repeat
+    Result:=FScanner.FetchToken;
+  Until (Not (Result in [tkComment,tkWhiteSpace]));
+end;
+
+procedure TBaseJSONReader.DoError(const Msg: String);
+
+Var
+  S : String;
+
+begin
+  S:=Format(Msg,[CurrentTokenString]);
+  S:=Format('Error at line %d, Pos %d:',[FScanner.CurRow,FSCanner.CurColumn])+S;
+  Raise EJSONParser.Create(S);
+end;
+
+constructor TBaseJSONReader.Create(Source: TStream; AUseUTF8 : Boolean = True);
+begin
+  Inherited Create;
+  FScanner:=TJSONScanner.Create(Source,[joUTF8]);
+  if AUseUTF8 then
+   Options:=Options + [joUTF8];
+end;
+
+constructor TBaseJSONReader.Create(Source: TJSONStringType; AUseUTF8 : Boolean = True);
+begin
+  Inherited Create;
+  FScanner:=TJSONScanner.Create(Source,[joUTF8]);
+  if AUseUTF8 then
+   Options:=Options + [joUTF8];
+end;
+
+constructor TBaseJSONReader.Create(Source: TStream; AOptions: TJSONOptions);
+begin
+  FScanner:=TJSONScanner.Create(Source,AOptions);
+end;
+
+constructor TBaseJSONReader.Create(const Source: String; AOptions: TJSONOptions);
+begin
+  FScanner:=TJSONScanner.Create(Source,AOptions);
+end;
+
+destructor TBaseJSONReader.Destroy();
+begin
+  FreeAndNil(FScanner);
+  inherited Destroy();
+end;
+
+{ TJSONReader }
+
+procedure TJSONEventReader.KeyValue(const AKey: TJSONStringType);
+begin
+  if Assigned(FOnKeyName) then
+    FOnKeyName(Self,AKey);
+end;
+
+procedure TJSONEventReader.StringValue(const AValue: TJSONStringType);
+begin
+  if Assigned(FOnStringValue) then
+    FOnStringValue(Self,AValue);
+end;
+
+procedure TJSONEventReader.NullValue;
+begin
+  if Assigned(FOnNullValue) then
+    FOnNullValue(Self);
+end;
+
+procedure TJSONEventReader.FloatValue(const AValue: Double);
+begin
+  if Assigned(FOnFloatValue) then
+    FOnFloatValue(Self,AValue);
+end;
+
+procedure TJSONEventReader.BooleanValue(const AValue: Boolean);
+begin
+  if Assigned(FOnBooleanValue) then
+    FOnBooleanValue(Self,AValue);
+end;
+
+procedure TJSONEventReader.NumberValue(const AValue: TJSONStringType);
+begin
+  if Assigned(FOnNumberValue) then
+    FOnNumberValue(Self,AValue);
+end;
+
+procedure TJSONEventReader.IntegerValue(const AValue: integer);
+begin
+  if Assigned(FOnIntegerValue) then
+    FOnIntegerValue(Self,AValue);
+
+end;
+
+procedure TJSONEventReader.Int64Value(const AValue: int64);
+begin
+  if Assigned(FOnInt64Value) then
+    FOnInt64Value(Self,AValue);
+
+end;
+
+procedure TJSONEventReader.QWordValue(const AValue: QWord);
+begin
+  if Assigned(FOnQWordValue) then
+    FOnQWordValue(Self,AValue);
+end;
+
+procedure TJSONEventReader.StartArray;
+begin
+  If Assigned(FOnStartArray) then
+    FOnStartArray(Self);
+end;
+
+procedure TJSONEventReader.StartObject;
+begin
+  if Assigned(FOnStartObject) then
+    FOnStartObject(Self);
+end;
+
+procedure TJSONEventReader.EndArray;
+begin
+  If Assigned(FOnEndArray) then
+    FOnEndArray(Self);
+end;
+
+procedure TJSONEventReader.EndObject;
+begin
+  If Assigned(FOnEndObject) then
+   FOnEndObject(Self);
+end;
+
+procedure TJSONEventReader.Execute;
+begin
+  DoExecute;
+end;
+
+{ TJSONConsumerReader }
+
+procedure TJSONConsumerReader.KeyValue(const AKey: TJSONStringType);
+begin
+  If Assigned(FConsumer) then
+    FConsumer.KeyName(Akey)
+end;
+
+procedure TJSONConsumerReader.StringValue(const AValue: TJSONStringType);
+begin
+  If Assigned(FConsumer) then
+    FConsumer.StringValue(AValue);
+end;
+
+procedure TJSONConsumerReader.NullValue;
+begin
+  If Assigned(FConsumer) then
+    FConsumer.NullValue;
+end;
+
+procedure TJSONConsumerReader.FloatValue(const AValue: Double);
+begin
+  If Assigned(FConsumer) then
+    FConsumer.FloatValue(AValue);
+end;
+
+procedure TJSONConsumerReader.BooleanValue(const AValue: Boolean);
+begin
+  If Assigned(FConsumer) then
+    FConsumer.BooleanValue(AValue);
+end;
+
+procedure TJSONConsumerReader.NumberValue(const AValue: TJSONStringType);
+begin
+  If Assigned(FConsumer) then
+    FConsumer.NumberValue(AValue);
+end;
+
+procedure TJSONConsumerReader.IntegerValue(const AValue: integer);
+begin
+  If Assigned(FConsumer) then
+    FConsumer.IntegerValue(AValue);
+end;
+
+procedure TJSONConsumerReader.Int64Value(const AValue: int64);
+begin
+  If Assigned(FConsumer) then
+    FConsumer.Int64Value(AValue);
+end;
+
+procedure TJSONConsumerReader.QWordValue(const AValue: QWord);
+begin
+  If Assigned(FConsumer) then
+    FConsumer.QWordValue(AValue);
+end;
+
+procedure TJSONConsumerReader.StartArray;
+begin
+  if Assigned(FConsumer) then
+    FConsumer.StartArray;
+end;
+
+procedure TJSONConsumerReader.StartObject;
+begin
+  if Assigned(FConsumer) then
+    FConsumer.StartObject;
+end;
+
+procedure TJSONConsumerReader.EndArray;
+begin
+  if Assigned(FConsumer) then
+    FConsumer.EndArray;
+end;
+
+procedure TJSONConsumerReader.EndObject;
+begin
+  if Assigned(FConsumer) then
+    FConsumer.EndObject;
+end;
+
+procedure TJSONConsumerReader.Execute;
+begin
+  DoExecute;
+end;
+
+
+end.
+

packages/fcl-json/src/jsonscanner.pp

@@ -347,8 +347,10 @@ begin
                   Inc(TokenStr);
                 break;
               end;
-            else
-              break;
+          else
+            if not (TokenStr[0] in [#0,'}',']',',',#9,' ']) then
+               Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
+            break;
           end;
         end;
         SectionLength := TokenStr - TokenStart;

packages/fcl-json/tests/testjson.lpi

@@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <General>
       <Flags>
         <SaveOnlyProjectUnits Value="True"/>
@@ -10,9 +10,6 @@
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
     </General>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="1">
       <Item1 Name="default" Default="True"/>
     </BuildModes>
@@ -25,7 +22,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestParser.TestObjectError"/>
+        <CommandLineParams Value="--suite=TTestParser.TestArray"/>
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
@@ -34,7 +31,7 @@
         <PackageName Value="FCL"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="5">
+    <Units Count="6">
       <Unit0>
         <Filename Value="testjson.pp"/>
         <IsPartOfProject Value="True"/>
@@ -55,6 +52,10 @@
         <Filename Value="../src/fpjsonrtti.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit4>
+      <Unit5>
+        <Filename Value="testjsonreader.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit5>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

packages/fcl-json/tests/testjson.pp

@@ -17,7 +17,7 @@
 program testjson;
 
 uses
-  Classes, testjsondata, testjsonparser, testjsonrtti, consoletestrunner;
+  Classes, testjsondata, testjsonparser, testjsonrtti, consoletestrunner, testjsonreader;
 
 type
   { TLazTestRunner }

packages/fcl-json/tests/testjsonparser.pp

@@ -417,9 +417,9 @@ procedure TTestParser.TestErrors;
 
 begin
 
+  DoTestError('1Tru');
   DoTestError('a');
   DoTestError('"b');
-  DoTestError('1Tru');
 
   DoTestError('b"');
   DoTestError('{"a" : }');

packages/fcl-json/tests/testjsonreader.pp

@@ -0,0 +1,810 @@
+unit testjsonreader;
+
+{$mode objfpc}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,fpjson,jsonscanner,jsonreader, testjsondata;
+
+Const
+  DefaultOpts = [joUTF8,joStrict];
+
+type
+  
+  { TMyJSONReader }
+
+  TMyJSONReader = Class(TBaseJSONReader)
+  Private
+    FList : TStrings;
+    function GetList: TStrings;
+    procedure Push(const aType : String; const AValue: String='');
+  protected
+    procedure BooleanValue(const AValue: Boolean); override;
+    procedure EndArray; override;
+    procedure EndObject; override;
+    procedure FloatValue(const AValue: Double); override;
+    procedure Int64Value(const AValue: int64); override;
+    procedure IntegerValue(const AValue: integer); override;
+    procedure KeyValue(const AKey: TJSONStringType); override;
+    procedure NullValue; override;
+    procedure NumberValue(const AValue: TJSONStringType); override;
+    procedure QWordValue(const AValue: QWord); override;
+    procedure StartArray; override;
+    procedure StartObject; override;
+    procedure StringValue(const AValue: TJSONStringType); override;
+  Public
+    destructor Destroy; override;
+    Property List : TStrings Read GetList;
+  end;
+
+  { TTestParser }
+
+  { TTestReader }
+
+  TBaseTestReader = class(TTestJSON)
+  private
+    FOptions : TJSONOptions;
+    procedure CallNoHandlerStream;
+    procedure DoTestFloat(F: TJSONFloat); overload;
+    procedure DoTestFloat(F: TJSONFloat; S: String); overload;
+    procedure DoTestString(S: String; AValue: String='');
+    procedure DoTrailingCommaErrorArray;
+    procedure DoTrailingCommaErrorObject;
+  Protected
+    procedure DoTestError(S: String; Options : TJSONOptions = DefaultOpts); virtual; abstract;
+    Procedure TestRead(aJSON : String; AResult : Array of string); virtual; abstract;
+  published
+    procedure TestEmpty;
+    procedure TestNull;
+    procedure TestTrue;
+    procedure TestFalse;
+    procedure TestFloat;
+    procedure TestInteger;
+    procedure TestInt64;
+    procedure TestString;
+    procedure TestArray;
+    procedure TestObject;
+    procedure TestObjectError;
+    procedure TestTrailingComma;
+    procedure TestTrailingCommaErrorArray;
+    procedure TestTrailingCommaErrorObject;
+    procedure TestMixed;
+    Procedure TestComment;
+    procedure TestErrors;
+  end;
+
+  TTestReader = Class(TBaseTestReader)
+  Private
+    FReader: TMyJSONReader;
+  Protected
+    Procedure Teardown; override;
+  Public
+    procedure DoTestError(S: String; Options : TJSONOptions = DefaultOpts); override;
+    Procedure TestRead(aJSON : String; AResult : Array of string); override;
+    Property Reader : TMyJSONReader Read FReader;
+  end;
+
+  { TJSONConsumer }
+
+  TJSONConsumer = Class(TInterfacedObject,IJSONConsumer)
+  Private
+    FList : TStrings;
+    procedure Push(const aType : String; const AValue: String='');
+  protected
+    procedure BooleanValue(const AValue: Boolean);
+    procedure EndArray;
+    procedure EndObject;
+    procedure FloatValue(const AValue: Double);
+    procedure Int64Value(const AValue: int64);
+    procedure IntegerValue(const AValue: integer);
+    procedure KeyName(const AKey: TJSONStringType);
+    procedure NullValue;
+    procedure NumberValue(const AValue: TJSONStringType);
+    procedure QWordValue(const AValue: QWord);
+    procedure StartArray;
+    procedure StartObject;
+    procedure StringValue(const AValue: TJSONStringType);
+  Public
+    Constructor Create(AList : TStrings);
+    Property List : TStrings Read FList;
+  end;
+
+  { TTestJSONConsumerReader }
+
+  TTestJSONConsumerReader = Class(TBaseTestReader)
+  Private
+    FList : TStrings;
+    FReader: TJSONConsumerReader;
+  Protected
+    Procedure Teardown; override;
+  Public
+    procedure DoTestError(S: String; Options : TJSONOptions = DefaultOpts); override;
+    Procedure TestRead(aJSON : String; AResult : Array of string); override;
+    Property Reader : TJSONConsumerReader Read FReader;
+  end;
+
+  { TTestJSONEventReader }
+
+  TTestJSONEventReader = Class(TBaseTestReader)
+  Private
+    FList : TStrings;
+    FReader: TJSONEventReader;
+  Protected
+    procedure Push(const aType : String; const AValue: String='');
+    procedure BooleanValue(Sender: TObject; const AValue: Boolean);
+    procedure EndArray(Sender: TObject);
+    procedure EndObject(Sender: TObject);
+    procedure FloatValue(Sender: TObject; const AValue: Double);
+    procedure Int64Value(Sender: TObject; const AValue: int64);
+    procedure IntegerValue(Sender: TObject; const AValue: integer);
+    procedure KeyValue(Sender: TObject; const AKey: TJSONStringType);
+    procedure NullValue(Sender: TObject);
+    procedure NumberValue(Sender: TObject; const AValue: TJSONStringType);
+    procedure QWordValue(Sender: TObject; const AValue: QWord);
+    procedure StartArray(Sender: TObject);
+    procedure StartObject(Sender: TObject);
+    procedure StringValue(Sender: TObject; const AValue: TJSONStringType);
+    Procedure HookupEvents(AReader: TJSONEventReader);
+    Procedure Teardown; override;
+  Public
+    procedure DoTestError(S: String; Options : TJSONOptions = DefaultOpts); override;
+    Procedure TestRead(aJSON : String; AResult : Array of string); override;
+    Property Reader : TJSONEventReader Read FReader;
+  end;
+
+
+implementation
+
+
+{ TMyJSONReader }
+
+function TMyJSONReader.GetList: TStrings;
+begin
+  If FList=Nil then
+    FList:=TStringList.Create;
+  Result:=Flist;
+end;
+
+procedure TMyJSONReader.Push(const aType : String; const AValue : String = '');
+
+begin
+  if AValue<>'' then
+    List.Add(aType+':'+AValue)
+  else
+    List.Add(aType);
+end;
+
+procedure TMyJSONReader.BooleanValue(const AValue: Boolean);
+begin
+  Push('boolean',BoolToStr(AValue));
+end;
+
+procedure TMyJSONReader.EndArray;
+begin
+  Push('ea');
+end;
+
+procedure TMyJSONReader.EndObject;
+begin
+  Push('eo');
+end;
+
+procedure TMyJSONReader.FloatValue(const AValue: Double);
+begin
+  List.Add('float:'+formatFloat('##.##',AVAlue));
+end;
+
+procedure TMyJSONReader.Int64Value(const AValue: int64);
+begin
+  Push('int64',IntToStr(aValue));
+end;
+
+procedure TMyJSONReader.IntegerValue(const AValue: integer);
+begin
+  Push('integer',IntToStr(aValue));
+end;
+
+procedure TMyJSONReader.KeyValue(const AKey: TJSONStringType);
+begin
+  Push('key',akey);
+end;
+
+procedure TMyJSONReader.NullValue;
+begin
+  Push('null');
+end;
+
+procedure TMyJSONReader.NumberValue(const AValue: TJSONStringType);
+begin
+  Push('number',aValue);
+end;
+
+procedure TMyJSONReader.QWordValue(const AValue: QWord);
+begin
+  Push('qword',IntToStr(AValue));
+end;
+
+procedure TMyJSONReader.StartArray;
+begin
+  Push('sa');
+end;
+
+procedure TMyJSONReader.StartObject;
+begin
+  Push('so');
+end;
+
+procedure TMyJSONReader.StringValue(const AValue: TJSONStringType);
+begin
+  List.Add('string:'+AValue)
+end;
+
+destructor TMyJSONReader.Destroy;
+begin
+  FreeAndNil(Flist);
+  inherited Destroy;
+end;
+
+procedure TBaseTestReader.TestEmpty;
+
+begin
+  TestRead('',[]);
+end;
+
+procedure TBaseTestReader.TestInteger;
+
+
+begin
+  TestRead('1',['number:1','integer:1']);
+end;
+
+procedure TBaseTestReader.TestInt64;
+
+begin
+  TestRead('123456789012345',['number:123456789012345','int64:123456789012345']);
+end;
+
+procedure TBaseTestReader.TestNull;
+
+
+begin
+  TestRead('null',['null']);
+end;
+
+procedure TBaseTestReader.TestTrue;
+
+begin
+  TestRead('true',['boolean:'+BoolToStr(true)]);
+end;
+
+procedure TBaseTestReader.TestFalse;
+
+begin
+  TestRead('false',['boolean:'+BoolToStr(false)]);
+end;
+
+procedure TBaseTestReader.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 TBaseTestReader.TestString;
+
+begin
+  DoTestString('A string');
+  DoTestString('');
+  DoTestString('\"','"');
+end;
+
+
+procedure TBaseTestReader.TestArray;
+
+Var
+  S1,S2,S3 : String;
+
+begin
+  TestRead('[]',['sa','ea']);
+  TestRead('[null]',['sa','null','ea']);
+  TestRead('[true]',['sa','boolean:'+BoolToStr(true),'ea']);
+  TestRead('[false]',['sa','boolean:'+BoolToStr(false),'ea']);
+  TestRead('[1]',['sa','number:1','integer:1','ea']);
+  TestRead('[1, 2]',['sa','number:1','integer:1','number:2','integer:2','ea']);
+  TestRead('[1, 2, 3]',['sa','number:1','integer:1','number:2','integer:2','number:3','integer:3','ea']);
+  TestRead('[1234567890123456]',['sa','number:1234567890123456','int64:1234567890123456','ea']);
+  TestRead('[1234567890123456, 2234567890123456]',
+    ['sa','number:1234567890123456','int64:1234567890123456','number:2234567890123456','int64:2234567890123456','ea']);
+  TestRead('[1234567890123456, 2234567890123456, 3234567890123456]',
+    ['sa','number:1234567890123456','int64:1234567890123456','number:2234567890123456','int64:2234567890123456',
+     'number:3234567890123456','int64:3234567890123456','ea']);
+  Str(12/10,S1);
+  Delete(S1,1,1);
+  Str(34/10,S2);
+  Delete(S2,1,1);
+  Str(34/10,S3);
+  Delete(S3,1,1);
+  TestRead('['+S1+']',['sa','number:'+s1,'float:'+formatfloat('##.##',12/10),'ea']);
+  {
+  TestRead('['+S1+', '+S2+']',2,true);
+  TestRead('['+S1+', '+S2+', '+S3+']',3,true);
+  TestRead('["A string"]',1);
+  TestRead('["A string", "Another string"]',2);
+  TestRead('["A string", "Another string", "Yet another string"]',3);
+  TestRead('[null, false]',2);
+  TestRead('[true, false]',2);
+  TestRead('[null, 1]',2);
+  TestRead('[1, "A string"]',2);
+  TestRead('[1, []]',2);
+  TestRead('[1, [1, 2]]',2);}
+end;
+
+procedure TBaseTestReader.TestTrailingComma;
+begin
+  FOptions:=[joIgnoreTrailingComma];
+  TestRead('[1, 2, ]',['sa','number:1','integer:1','number:2','integer:2','ea']);
+  TestRead('{ "a" : 1, }',['so','key:a', 'number:1','integer:1','eo']);
+end;
+
+procedure TBaseTestReader.TestTrailingCommaErrorArray;
+begin
+  AssertException('Need joIgnoreTrailingComma in options to allow trailing comma',EJSONParser,@DoTrailingCommaErrorArray) ;
+end;
+
+procedure TBaseTestReader.TestTrailingCommaErrorObject;
+begin
+  AssertException('Need joIgnoreTrailingComma in options to allow trailing comma',EJSONParser,@DoTrailingCommaErrorObject);
+end;
+
+procedure TBaseTestReader.DoTrailingCommaErrorArray;
+begin
+  TestRead('[1, 2, ]',['sa','number:1','integer:1','number:2','integer:2','ea']);
+end;
+
+procedure TBaseTestReader.DoTrailingCommaErrorObject;
+begin
+  TestRead('{ "a" : 1, }',['so','key:a', 'number:1','integer:1','eo']);
+end;
+
+
+procedure TBaseTestReader.TestMixed;
+
+begin
+  TestRead('[1, {}]',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('[1, { "a" : 1 }]',['sa','number:1','integer:1','so','key:a','number:1','integer:1','eo','ea']);
+  TestRead('[1, { "a" : 1 }, 1]',['sa','number:1','integer:1','so','key:a','number:1','integer:1','eo','number:1','integer:1','ea']);
+  TestRead('{ "a" : [1, 2] }',['so','key:a','sa','number:1','integer:1','number:2','integer:2','ea','eo']);
+  TestRead('{ "a" : [1, 2], "B" : { "c" : "d" } }',
+    ['so','key:a','sa','number:1','integer:1','number:2','integer:2','ea','key:B','so','key:c','string:d','eo','eo']);
+end;
+
+procedure TBaseTestReader.TestComment;
+begin
+  FOptions:=[joComments];
+  TestRead('/* */ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('//'+sLineBreak+' [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('/* '+sLineBreak+' */ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('/*'+sLineBreak+'*/ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('/*'+sLineBreak+'*'+sLineBreak+'*/ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('/**'+sLineBreak+'**'+sLineBreak+'**/ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('/* */ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('[1, {}]//',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('[1, {}]/* '+sLineBreak+' */',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('[1, {}]/* '+sLineBreak+' */ ',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('[1, {}]/* '+sLineBreak+'*'+sLineBreak+'*/ ',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('[1, {}]/**'+sLineBreak+'**'+sLineBreak+'**/ ',['sa','number:1','integer:1','so','eo','ea']);
+end;
+
+procedure TBaseTestReader.TestObject;
+begin
+  TestRead('{}',['so','eo']);
+  TestRead('{ "a" : 1 }',['so','key:a','number:1','integer:1','eo']);
+  TestRead('{ "a" : 1, "B" : "String" }',['so','key:a','number:1','integer:1','key:B','string:String','eo']);
+  TestRead('{ "a" : 1, "B" : {} }',['so','key:a','number:1','integer:1','key:B','so','eo','eo']);
+  TestRead('{ "a" : 1, "B" : { "c" : "d" } }',['so','key:a','number:1','integer:1','key:B','so','key:c','string:d','eo','eo']);
+end;
+
+procedure TBaseTestReader.TestObjectError;
+begin
+  DoTestError('{ "name" : value }',[joUTF8]);
+end;
+
+
+procedure TBaseTestReader.TestErrors;
+
+begin
+
+  DoTestError('a');
+  DoTestError('"b');
+  DoTestError('1Tru');
+
+  DoTestError('b"');
+  DoTestError('{"a" : }');
+  DoTestError('{"a" : ""');
+  DoTestError('{"a : ""');
+
+  DoTestError('[1,]');
+  DoTestError('[,]');
+  DoTestError('[,,]');
+  DoTestError('[1,,]');
+
+end;
+
+
+procedure TBaseTestReader.CallNoHandlerStream;
+
+Var
+  S : TStringStream;
+
+begin
+  S:=TstringStream.Create('1');
+  try
+    GetJSON(S,True).Free;
+  finally
+    S.Free;
+  end;
+end;
+
+procedure TBaseTestReader.DoTestString(S: String; AValue : String = '');
+
+begin
+  if AValue='' then
+    AValue:=S;
+  TestRead('"'+S+'"',['string:'+AValue]);
+end;
+
+procedure TBaseTestReader.DoTestFloat(F : TJSONFloat);
+
+Var
+  S : String;
+
+begin
+  Str(F,S);
+  DoTestFloat(F,S);
+end;
+
+procedure TBaseTestReader.DoTestFloat(F : TJSONFloat; S : String);
+
+begin
+  TestRead(S,['number:'+trim(S),'float:'+formatfloat('##.##',F)]);
+end;
+
+procedure TTestReader.Teardown;
+begin
+  FreeAndNil(FReader);
+  inherited Teardown;
+end;
+
+procedure TTestReader.TestRead(aJSON: String; AResult: array of string);
+
+Var
+  I : Integer;
+
+begin
+  FreeAndNil(FReader);
+  FReader:=TMyJSONReader.Create(aJSON,Foptions);
+  TMyJSONReader(FReader).DoExecute;
+  AssertEquals(aJSON+': Number of events',Length(AResult),FReader.List.Count);
+  For I:=0 to Length(AResult)-1 do
+    AssertEquals(aJSON+': Event number '+IntToStr(I),AResult[i],FReader.List[I]);
+end;
+
+procedure TTestReader.DoTestError(S : String; Options : TJSONOptions = DefaultOpts);
+
+Var
+  P:TMyJSONReader;
+  ParseOK : Boolean;
+
+begin
+  ParseOK:=False;
+  P:=TMyJSONReader.Create(S,FOptions);
+  P.OPtions:=Options;
+  Try
+    Try
+      P.DoExecute;
+      ParseOk:=True;
+    Finally
+      FreeAndNil(P);
+    end;
+  except
+    ParseOk:=False;
+  end;
+  If ParseOK then
+    Fail('Parse of JSON string "'+S+'" should fail, but succeeded');
+end;
+
+
+{ TJSONConsumer }
+
+procedure TJSONConsumer.Push(const aType : String; const AValue : String = '');
+
+begin
+  if AValue<>'' then
+    List.Add(aType+':'+AValue)
+  else
+    List.Add(aType);
+end;
+
+procedure TJSONConsumer.BooleanValue(const AValue: Boolean);
+begin
+  Push('boolean',BoolToStr(AValue));
+end;
+
+procedure TJSONConsumer.EndArray;
+begin
+  Push('ea');
+end;
+
+procedure TJSONConsumer.EndObject;
+begin
+  Push('eo');
+end;
+
+procedure TJSONConsumer.FloatValue(const AValue: Double);
+begin
+  List.Add('float:'+formatFloat('##.##',AVAlue));
+end;
+
+procedure TJSONConsumer.Int64Value(const AValue: int64);
+begin
+  Push('int64',IntToStr(aValue));
+end;
+
+procedure TJSONConsumer.IntegerValue(const AValue: integer);
+begin
+  Push('integer',IntToStr(aValue));
+end;
+
+procedure TJSONConsumer.KeyName(const AKey: TJSONStringType);
+begin
+  Push('key',akey);
+end;
+
+procedure TJSONConsumer.NullValue;
+begin
+  Push('null');
+end;
+
+procedure TJSONConsumer.NumberValue(const AValue: TJSONStringType);
+begin
+  Push('number',aValue);
+end;
+
+procedure TJSONConsumer.QWordValue(const AValue: QWord);
+begin
+  Push('qword',IntToStr(AValue));
+end;
+
+procedure TJSONConsumer.StartArray;
+begin
+  Push('sa');
+end;
+
+procedure TJSONConsumer.StartObject;
+begin
+  Push('so');
+end;
+
+procedure TJSONConsumer.StringValue(const AValue: TJSONStringType);
+begin
+  List.Add('string:'+AValue)
+end;
+
+constructor TJSONConsumer.Create(AList: TStrings);
+begin
+  FList:=AList;
+end;
+
+procedure TTestJSONConsumerReader.TestRead(aJSON: String; AResult: array of string);
+
+Var
+  I : Integer;
+
+begin
+  FreeAndNil(FReader);
+  FreeAndNil(Flist);
+  FList:=TStringList.Create;
+  FReader:=TJSONConsumerReader.Create(aJSON,Foptions);
+  FReader.Consumer:=TJSONConsumer.Create(FList);
+  TJSONConsumerReader(FReader).Execute;
+  AssertEquals(aJSON+': Number of events',Length(AResult),FList.Count);
+  For I:=0 to Length(AResult)-1 do
+    AssertEquals(aJSON+': Event number '+IntToStr(I),AResult[i],FList[I]);
+end;
+
+procedure TTestJSONConsumerReader.Teardown;
+begin
+  FreeAndNil(FReader);
+  FreeAndNil(FList);
+  inherited Teardown;
+end;
+
+procedure TTestJSONConsumerReader.DoTestError(S : String; Options : TJSONOptions = DefaultOpts);
+
+Var
+  P:TJSONConsumerReader;
+  ParseOK : Boolean;
+
+begin
+  ParseOK:=False;
+  FreeAndNil(FReader);
+  FreeAndNil(Flist);
+  FList:=TStringList.Create;
+  P:=TJSONConsumerReader.Create(S,Options);
+  P.Consumer:=TJSONConsumer.Create(FList);
+  P.OPtions:=Options;
+  Try
+    Try
+      P.Execute;
+      ParseOk:=True;
+    Finally
+      FreeAndNil(P);
+    end;
+  except
+    ParseOk:=False;
+  end;
+  If ParseOK then
+    Fail('Parse of JSON string "'+S+'" should fail, but succeeded');
+end;
+
+{ TTestJSONEventReader }
+
+procedure TTestJSONEventReader.Teardown;
+begin
+  FreeAndNil(Freader);
+  FreeAndNil(Flist);
+  inherited Teardown;
+end;
+
+procedure TTestJSONEventReader.DoTestError(S: String; Options: TJSONOptions);
+
+Var
+  P:TJSONEventReader;
+  ParseOK : Boolean;
+
+begin
+  ParseOK:=False;
+  FreeAndNil(FReader);
+  FreeAndNil(Flist);
+  FList:=TStringList.Create;
+  P:=TJSONEventReader.Create(S,Options);
+  HookupEvents(P);
+  P.OPtions:=Options;
+  Try
+    Try
+      P.Execute;
+      ParseOk:=True;
+    Finally
+      FreeAndNil(P);
+    end;
+  except
+    ParseOk:=False;
+  end;
+  If ParseOK then
+    Fail('Parse of JSON string "'+S+'" should fail, but succeeded');
+end;
+
+procedure TTestJSONEventReader.TestRead(aJSON: String; AResult: array of string);
+
+Var
+  I : Integer;
+
+begin
+  FreeAndNil(FReader);
+  FreeAndNil(Flist);
+  FList:=TStringList.Create;
+  FReader:=TJSONEventReader.Create(aJSON,Foptions);
+  HookupEvents(FReader);
+  FReader.Execute;
+  AssertEquals(aJSON+': Number of events',Length(AResult),FList.Count);
+  For I:=0 to Length(AResult)-1 do
+    AssertEquals(aJSON+': Event number '+IntToStr(I),AResult[i],FList[I]);
+end;
+
+procedure TTestJSONEventReader.Push(const aType: String; const AValue: String);
+begin
+  if AValue<>'' then
+    FList.Add(aType+':'+AValue)
+  else
+    FList.Add(aType);
+end;
+
+procedure TTestJSONEventReader.BooleanValue(Sender: TObject; const AValue: Boolean);
+begin
+  Push('boolean',BoolToStr(AValue));
+end;
+
+procedure TTestJSONEventReader.EndArray(Sender: TObject);
+begin
+  Push('ea');
+end;
+
+procedure TTestJSONEventReader.EndObject(Sender: TObject);
+begin
+  Push('eo');
+end;
+
+procedure TTestJSONEventReader.FloatValue(Sender: TObject; const AValue: Double);
+begin
+  FList.Add('float:'+formatFloat('##.##',AVAlue));
+end;
+
+procedure TTestJSONEventReader.Int64Value(Sender: TObject; const AValue: int64);
+begin
+  Push('int64',IntToStr(aValue));
+end;
+
+procedure TTestJSONEventReader.IntegerValue(Sender: TObject; const AValue: integer);
+begin
+  Push('integer',IntToStr(aValue));
+end;
+
+procedure TTestJSONEventReader.KeyValue(Sender: TObject; const AKey: TJSONStringType);
+begin
+  Push('key',akey);
+end;
+
+procedure TTestJSONEventReader.NullValue(Sender: TObject);
+begin
+  Push('null');
+end;
+
+procedure TTestJSONEventReader.NumberValue(Sender: TObject; const AValue: TJSONStringType);
+begin
+  Push('number',aValue);
+end;
+
+procedure TTestJSONEventReader.QWordValue(Sender: TObject; const AValue: QWord);
+begin
+  Push('qword',IntToStr(AValue));
+end;
+
+procedure TTestJSONEventReader.StartArray(Sender: TObject);
+begin
+  Push('sa');
+end;
+
+procedure TTestJSONEventReader.StartObject(Sender: TObject);
+begin
+  Push('so');
+end;
+
+procedure TTestJSONEventReader.StringValue(Sender: TObject; const AValue: TJSONStringType);
+begin
+  FList.Add('string:'+AValue)
+end;
+
+procedure TTestJSONEventReader.HookupEvents(AReader: TJSONEventReader);
+begin
+  With Areader do
+    begin
+    OnNullValue:=@NullValue;
+    OnBooleanValue:=@BooleanValue;
+    OnNumberValue:=@NumberValue;
+    OnFloatValue:=@FloatValue;
+    OnIntegerValue:=@IntegerValue;
+    OnInt64Value:=@Int64Value;
+    OnQWordValue:=@QWordValue;
+    OnStringValue:=@StringValue;
+    OnKeyName:=@KeyValue;
+    OnStartObject:=@StartObject;
+    OnEndObject:=@EndObject;
+    OnStartArray:=@StartArray;
+    OnEndArray:=@EndArray;
+    end;
+end;
+
+initialization
+  RegisterTests([TTestReader,TTestJSONConsumerReader,TTestJSONEventReader]);
+
+end.
+