123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835 |
- 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 }
- 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 TestFloatError;
- procedure TestInteger;
- procedure TestInt64;
- procedure TestString;
- procedure TestArray;
- procedure TestObject;
- procedure TestObjectError;
- procedure TestTrailingComma;
- procedure TestTrailingCommaErrorArray;
- procedure TestTrailingCommaErrorObject;
- procedure TestMixed;
- Procedure TestComment;
- procedure TestErrors;
- procedure TestGarbageOK;
- procedure TestGarbageFail;
- 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.TestFloatError;
- begin
- DoTestError('.12',[joStrict]);
- DoTestError('.12E',[]);
- DoTestError('0.12E+',[]);
- DoTestError('.12E+-1',[]);
- 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.TestGarbageOK;
- begin
- TestRead('"a"sss',['string:a']);
- TestRead('[null]xxx',['sa','null','ea']);
- end;
- procedure TBaseTestReader.TestGarbageFail;
- begin
- DoTestError('"a"sss',[joStrict]);
- DoTestError('[null]aaa',[joStrict]);
- 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.
|