testjsonreader.pas 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848
  1. unit testjsonreader;
  2. {$mode objfpc}
  3. interface
  4. uses
  5. Classes, SysUtils, fpcunit, testregistry,fpjson,jsonscanner,jsonreader, testjsondata;
  6. Const
  7. DefaultOpts = [joUTF8,joStrict];
  8. type
  9. { TMyJSONReader }
  10. TMyJSONReader = Class(TBaseJSONReader)
  11. Private
  12. FList : TStrings;
  13. function GetList: TStrings;
  14. procedure Push(const aType : String; const AValue: String='');
  15. protected
  16. procedure BooleanValue(const AValue: Boolean); override;
  17. procedure EndArray; override;
  18. procedure EndObject; override;
  19. procedure FloatValue(const AValue: Double); override;
  20. procedure Int64Value(const AValue: int64); override;
  21. procedure IntegerValue(const AValue: integer); override;
  22. procedure KeyValue(const AKey: TJSONStringType); override;
  23. procedure NullValue; override;
  24. procedure NumberValue(const AValue: TJSONStringType); override;
  25. procedure QWordValue(const AValue: QWord); override;
  26. procedure StartArray; override;
  27. procedure StartObject; override;
  28. procedure StringValue(const AValue: TJSONStringType); override;
  29. Public
  30. destructor Destroy; override;
  31. Property List : TStrings Read GetList;
  32. end;
  33. { TTestParser }
  34. { TTestReader }
  35. { TBaseTestReader }
  36. TBaseTestReader = class(TTestJSON)
  37. private
  38. FOptions : TJSONOptions;
  39. procedure CallNoHandlerStream;
  40. procedure DoTestFloat(F: TJSONFloat); overload;
  41. procedure DoTestFloat(F: TJSONFloat; S: String); overload;
  42. procedure DoTestString(S: String; AValue: String='');
  43. procedure DoTrailingCommaErrorArray;
  44. procedure DoTrailingCommaErrorObject;
  45. Protected
  46. procedure DoTestError(S: String; Options : TJSONOptions = DefaultOpts); virtual; abstract;
  47. Procedure TestRead(aJSON : String; AResult : Array of string); virtual; abstract;
  48. published
  49. procedure TestEmpty;
  50. procedure TestNull;
  51. procedure TestTrue;
  52. procedure TestFalse;
  53. procedure TestFloat;
  54. procedure TestFloatError;
  55. procedure TestInteger;
  56. procedure TestInt64;
  57. procedure TestString;
  58. procedure TestArray;
  59. procedure TestObject;
  60. procedure TestObjectError;
  61. procedure TestTrailingComma;
  62. procedure TestTrailingCommaErrorArray;
  63. procedure TestTrailingCommaErrorObject;
  64. procedure TestMixed;
  65. Procedure TestComment;
  66. procedure TestErrors;
  67. procedure TestGarbageOK;
  68. procedure TestGarbageFail;
  69. end;
  70. TTestReader = Class(TBaseTestReader)
  71. Private
  72. FReader: TMyJSONReader;
  73. Protected
  74. Procedure Teardown; override;
  75. Public
  76. procedure DoTestError(S: String; Options : TJSONOptions = DefaultOpts); override;
  77. Procedure TestRead(aJSON : String; AResult : Array of string); override;
  78. Property Reader : TMyJSONReader Read FReader;
  79. end;
  80. { TJSONConsumer }
  81. TJSONConsumer = Class(TInterfacedObject,IJSONConsumer)
  82. Private
  83. FList : TStrings;
  84. procedure Push(const aType : String; const AValue: String='');
  85. protected
  86. procedure BooleanValue(const AValue: Boolean);
  87. procedure EndArray;
  88. procedure EndObject;
  89. procedure FloatValue(const AValue: Double);
  90. procedure Int64Value(const AValue: int64);
  91. procedure IntegerValue(const AValue: integer);
  92. procedure KeyName(const AKey: TJSONStringType);
  93. procedure NullValue;
  94. procedure NumberValue(const AValue: TJSONStringType);
  95. procedure QWordValue(const AValue: QWord);
  96. procedure StartArray;
  97. procedure StartObject;
  98. procedure StringValue(const AValue: TJSONStringType);
  99. Public
  100. Constructor Create(AList : TStrings);
  101. Property List : TStrings Read FList;
  102. end;
  103. { TTestJSONConsumerReader }
  104. TTestJSONConsumerReader = Class(TBaseTestReader)
  105. Private
  106. FList : TStrings;
  107. FReader: TJSONConsumerReader;
  108. Protected
  109. Procedure Teardown; override;
  110. Public
  111. procedure DoTestError(S: String; Options : TJSONOptions = DefaultOpts); override;
  112. Procedure TestRead(aJSON : String; AResult : Array of string); override;
  113. Property Reader : TJSONConsumerReader Read FReader;
  114. end;
  115. { TTestJSONEventReader }
  116. TTestJSONEventReader = Class(TBaseTestReader)
  117. Private
  118. FList : TStrings;
  119. FReader: TJSONEventReader;
  120. Protected
  121. procedure Push(const aType : String; const AValue: String='');
  122. procedure BooleanValue(Sender: TObject; const AValue: Boolean);
  123. procedure EndArray(Sender: TObject);
  124. procedure EndObject(Sender: TObject);
  125. procedure FloatValue(Sender: TObject; const AValue: Double);
  126. procedure Int64Value(Sender: TObject; const AValue: int64);
  127. procedure IntegerValue(Sender: TObject; const AValue: integer);
  128. procedure KeyValue(Sender: TObject; const AKey: TJSONStringType);
  129. procedure NullValue(Sender: TObject);
  130. procedure NumberValue(Sender: TObject; const AValue: TJSONStringType);
  131. procedure QWordValue(Sender: TObject; const AValue: QWord);
  132. procedure StartArray(Sender: TObject);
  133. procedure StartObject(Sender: TObject);
  134. procedure StringValue(Sender: TObject; const AValue: TJSONStringType);
  135. Procedure HookupEvents(AReader: TJSONEventReader);
  136. Procedure Teardown; override;
  137. Public
  138. procedure DoTestError(S: String; Options : TJSONOptions = DefaultOpts); override;
  139. Procedure TestRead(aJSON : String; AResult : Array of string); override;
  140. Property Reader : TJSONEventReader Read FReader;
  141. end;
  142. implementation
  143. { TMyJSONReader }
  144. function TMyJSONReader.GetList: TStrings;
  145. begin
  146. If FList=Nil then
  147. FList:=TStringList.Create;
  148. Result:=Flist;
  149. end;
  150. procedure TMyJSONReader.Push(const aType : String; const AValue : String = '');
  151. begin
  152. if AValue<>'' then
  153. List.Add(aType+':'+AValue)
  154. else
  155. List.Add(aType);
  156. end;
  157. procedure TMyJSONReader.BooleanValue(const AValue: Boolean);
  158. begin
  159. Push('boolean',BoolToStr(AValue));
  160. end;
  161. procedure TMyJSONReader.EndArray;
  162. begin
  163. Push('ea');
  164. end;
  165. procedure TMyJSONReader.EndObject;
  166. begin
  167. Push('eo');
  168. end;
  169. procedure TMyJSONReader.FloatValue(const AValue: Double);
  170. begin
  171. List.Add('float:'+formatFloat('##.##',AVAlue));
  172. end;
  173. procedure TMyJSONReader.Int64Value(const AValue: int64);
  174. begin
  175. Push('int64',IntToStr(aValue));
  176. end;
  177. procedure TMyJSONReader.IntegerValue(const AValue: integer);
  178. begin
  179. Push('integer',IntToStr(aValue));
  180. end;
  181. procedure TMyJSONReader.KeyValue(const AKey: TJSONStringType);
  182. begin
  183. Push('key',akey);
  184. end;
  185. procedure TMyJSONReader.NullValue;
  186. begin
  187. Push('null');
  188. end;
  189. procedure TMyJSONReader.NumberValue(const AValue: TJSONStringType);
  190. begin
  191. Push('number',aValue);
  192. end;
  193. procedure TMyJSONReader.QWordValue(const AValue: QWord);
  194. begin
  195. Push('qword',IntToStr(AValue));
  196. end;
  197. procedure TMyJSONReader.StartArray;
  198. begin
  199. Push('sa');
  200. end;
  201. procedure TMyJSONReader.StartObject;
  202. begin
  203. Push('so');
  204. end;
  205. procedure TMyJSONReader.StringValue(const AValue: TJSONStringType);
  206. begin
  207. List.Add('string:'+AValue)
  208. end;
  209. destructor TMyJSONReader.Destroy;
  210. begin
  211. FreeAndNil(Flist);
  212. inherited Destroy;
  213. end;
  214. procedure TBaseTestReader.TestEmpty;
  215. begin
  216. TestRead('',[]);
  217. end;
  218. procedure TBaseTestReader.TestInteger;
  219. begin
  220. TestRead('1',['number:1','integer:1']);
  221. end;
  222. procedure TBaseTestReader.TestInt64;
  223. begin
  224. TestRead('123456789012345',['number:123456789012345','int64:123456789012345']);
  225. end;
  226. procedure TBaseTestReader.TestNull;
  227. begin
  228. TestRead('null',['null']);
  229. end;
  230. procedure TBaseTestReader.TestTrue;
  231. begin
  232. TestRead('true',['boolean:'+BoolToStr(true)]);
  233. end;
  234. procedure TBaseTestReader.TestFalse;
  235. begin
  236. TestRead('false',['boolean:'+BoolToStr(false)]);
  237. end;
  238. procedure TBaseTestReader.TestFloat;
  239. begin
  240. DoTestFloat(1.2);
  241. DoTestFloat(-1.2);
  242. DoTestFloat(0);
  243. DoTestFloat(1.2e1);
  244. DoTestFloat(-1.2e1);
  245. DoTestFloat(0);
  246. DoTestFloat(1.2,'1.2');
  247. DoTestFloat(-1.2,'-1.2');
  248. DoTestFloat(0,'0.0');
  249. end;
  250. procedure TBaseTestReader.TestFloatError;
  251. begin
  252. DoTestError('.12',[joStrict]);
  253. DoTestError('.12E',[]);
  254. DoTestError('0.12E+',[]);
  255. DoTestError('.12E+-1',[]);
  256. end;
  257. procedure TBaseTestReader.TestString;
  258. const
  259. GlowingStar = #$F0#$9F#$8C#$9F;
  260. Chinese = #$95e8#$88ab#$8111#$5b50#$6324#$574f#$4e86;
  261. Chinese4b = #$95e8#$d867#$de3d#$88ab#$8111#$5b50#$6324#$574f#$4e86;
  262. begin
  263. DoTestString('A string');
  264. DoTestString('');
  265. DoTestString('\"','"');
  266. DoTestString('\u00f8','ø'); // this is ø
  267. DoTestString('\u00f8\"','ø"'); // this is ø"
  268. DoTestString('\ud83c\udf1f',GlowingStar);
  269. DoTestString('\u0041\u0042','AB'); //issue #0038622
  270. DoTestString('\u0041\u0042\u0043','ABC');
  271. DoTestString('\u0041\u0042\u0043\u0044','ABCD');
  272. DoTestString('\u95e8\u88ab\u8111\u5b50\u6324\u574f\u4e86',Utf8Encode(Chinese));
  273. DoTestString('\u95e8\ud867\ude3d\u88ab\u8111\u5b50\u6324\u574f\u4e86',Utf8Encode(Chinese4b));
  274. end;
  275. procedure TBaseTestReader.TestArray;
  276. Var
  277. S1,S2,S3 : String;
  278. begin
  279. TestRead('[]',['sa','ea']);
  280. TestRead('[null]',['sa','null','ea']);
  281. TestRead('[true]',['sa','boolean:'+BoolToStr(true),'ea']);
  282. TestRead('[false]',['sa','boolean:'+BoolToStr(false),'ea']);
  283. TestRead('[1]',['sa','number:1','integer:1','ea']);
  284. TestRead('[1, 2]',['sa','number:1','integer:1','number:2','integer:2','ea']);
  285. TestRead('[1, 2, 3]',['sa','number:1','integer:1','number:2','integer:2','number:3','integer:3','ea']);
  286. TestRead('[1234567890123456]',['sa','number:1234567890123456','int64:1234567890123456','ea']);
  287. TestRead('[1234567890123456, 2234567890123456]',
  288. ['sa','number:1234567890123456','int64:1234567890123456','number:2234567890123456','int64:2234567890123456','ea']);
  289. TestRead('[1234567890123456, 2234567890123456, 3234567890123456]',
  290. ['sa','number:1234567890123456','int64:1234567890123456','number:2234567890123456','int64:2234567890123456',
  291. 'number:3234567890123456','int64:3234567890123456','ea']);
  292. Str(12/10,S1);
  293. Delete(S1,1,1);
  294. Str(34/10,S2);
  295. Delete(S2,1,1);
  296. Str(34/10,S3);
  297. Delete(S3,1,1);
  298. TestRead('['+S1+']',['sa','number:'+s1,'float:'+formatfloat('##.##',12/10),'ea']);
  299. {
  300. TestRead('['+S1+', '+S2+']',2,true);
  301. TestRead('['+S1+', '+S2+', '+S3+']',3,true);
  302. TestRead('["A string"]',1);
  303. TestRead('["A string", "Another string"]',2);
  304. TestRead('["A string", "Another string", "Yet another string"]',3);
  305. TestRead('[null, false]',2);
  306. TestRead('[true, false]',2);
  307. TestRead('[null, 1]',2);
  308. TestRead('[1, "A string"]',2);
  309. TestRead('[1, []]',2);
  310. TestRead('[1, [1, 2]]',2);}
  311. end;
  312. procedure TBaseTestReader.TestTrailingComma;
  313. begin
  314. FOptions:=[joIgnoreTrailingComma];
  315. TestRead('[1, 2, ]',['sa','number:1','integer:1','number:2','integer:2','ea']);
  316. TestRead('{ "a" : 1, }',['so','key:a', 'number:1','integer:1','eo']);
  317. end;
  318. procedure TBaseTestReader.TestTrailingCommaErrorArray;
  319. begin
  320. AssertException('Need joIgnoreTrailingComma in options to allow trailing comma',EJSONParser,@DoTrailingCommaErrorArray) ;
  321. end;
  322. procedure TBaseTestReader.TestTrailingCommaErrorObject;
  323. begin
  324. AssertException('Need joIgnoreTrailingComma in options to allow trailing comma',EJSONParser,@DoTrailingCommaErrorObject);
  325. end;
  326. procedure TBaseTestReader.DoTrailingCommaErrorArray;
  327. begin
  328. TestRead('[1, 2, ]',['sa','number:1','integer:1','number:2','integer:2','ea']);
  329. end;
  330. procedure TBaseTestReader.DoTrailingCommaErrorObject;
  331. begin
  332. TestRead('{ "a" : 1, }',['so','key:a', 'number:1','integer:1','eo']);
  333. end;
  334. procedure TBaseTestReader.TestMixed;
  335. begin
  336. TestRead('[1, {}]',['sa','number:1','integer:1','so','eo','ea']);
  337. TestRead('[1, { "a" : 1 }]',['sa','number:1','integer:1','so','key:a','number:1','integer:1','eo','ea']);
  338. TestRead('[1, { "a" : 1 }, 1]',['sa','number:1','integer:1','so','key:a','number:1','integer:1','eo','number:1','integer:1','ea']);
  339. TestRead('{ "a" : [1, 2] }',['so','key:a','sa','number:1','integer:1','number:2','integer:2','ea','eo']);
  340. TestRead('{ "a" : [1, 2], "B" : { "c" : "d" } }',
  341. ['so','key:a','sa','number:1','integer:1','number:2','integer:2','ea','key:B','so','key:c','string:d','eo','eo']);
  342. end;
  343. procedure TBaseTestReader.TestComment;
  344. begin
  345. FOptions:=[joComments];
  346. TestRead('/* */ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
  347. TestRead('//'+sLineBreak+' [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
  348. TestRead('/* '+sLineBreak+' */ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
  349. TestRead('/*'+sLineBreak+'*/ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
  350. TestRead('/*'+sLineBreak+'*'+sLineBreak+'*/ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
  351. TestRead('/**'+sLineBreak+'**'+sLineBreak+'**/ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
  352. TestRead('/* */ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
  353. TestRead('[1, {}]//',['sa','number:1','integer:1','so','eo','ea']);
  354. TestRead('[1, {}]/* '+sLineBreak+' */',['sa','number:1','integer:1','so','eo','ea']);
  355. TestRead('[1, {}]/* '+sLineBreak+' */ ',['sa','number:1','integer:1','so','eo','ea']);
  356. TestRead('[1, {}]/* '+sLineBreak+'*'+sLineBreak+'*/ ',['sa','number:1','integer:1','so','eo','ea']);
  357. TestRead('[1, {}]/**'+sLineBreak+'**'+sLineBreak+'**/ ',['sa','number:1','integer:1','so','eo','ea']);
  358. end;
  359. procedure TBaseTestReader.TestObject;
  360. begin
  361. TestRead('{}',['so','eo']);
  362. TestRead('{ "a" : 1 }',['so','key:a','number:1','integer:1','eo']);
  363. TestRead('{ "a" : 1, "B" : "String" }',['so','key:a','number:1','integer:1','key:B','string:String','eo']);
  364. TestRead('{ "a" : 1, "B" : {} }',['so','key:a','number:1','integer:1','key:B','so','eo','eo']);
  365. TestRead('{ "a" : 1, "B" : { "c" : "d" } }',['so','key:a','number:1','integer:1','key:B','so','key:c','string:d','eo','eo']);
  366. end;
  367. procedure TBaseTestReader.TestObjectError;
  368. begin
  369. DoTestError('{ "name" : value }',[joUTF8]);
  370. end;
  371. procedure TBaseTestReader.TestErrors;
  372. begin
  373. DoTestError('a');
  374. DoTestError('"b');
  375. DoTestError('1Tru');
  376. DoTestError('b"');
  377. DoTestError('{"a" : }');
  378. DoTestError('{"a" : ""');
  379. DoTestError('{"a : ""');
  380. DoTestError('[1,]');
  381. DoTestError('[,]');
  382. DoTestError('[,,]');
  383. DoTestError('[1,,]');
  384. end;
  385. procedure TBaseTestReader.TestGarbageOK;
  386. begin
  387. TestRead('"a"sss',['string:a']);
  388. TestRead('[null]xxx',['sa','null','ea']);
  389. end;
  390. procedure TBaseTestReader.TestGarbageFail;
  391. begin
  392. DoTestError('"a"sss',[joStrict]);
  393. DoTestError('[null]aaa',[joStrict]);
  394. end;
  395. procedure TBaseTestReader.CallNoHandlerStream;
  396. Var
  397. S : TStringStream;
  398. begin
  399. S:=TstringStream.Create('1');
  400. try
  401. GetJSON(S,True).Free;
  402. finally
  403. S.Free;
  404. end;
  405. end;
  406. procedure TBaseTestReader.DoTestString(S: String; AValue : String = '');
  407. begin
  408. if AValue='' then
  409. AValue:=S;
  410. TestRead('"'+S+'"',['string:'+AValue]);
  411. end;
  412. procedure TBaseTestReader.DoTestFloat(F : TJSONFloat);
  413. Var
  414. S : String;
  415. begin
  416. Str(F,S);
  417. DoTestFloat(F,S);
  418. end;
  419. procedure TBaseTestReader.DoTestFloat(F : TJSONFloat; S : String);
  420. begin
  421. TestRead(S,['number:'+trim(S),'float:'+formatfloat('##.##',F)]);
  422. end;
  423. procedure TTestReader.Teardown;
  424. begin
  425. FreeAndNil(FReader);
  426. inherited Teardown;
  427. end;
  428. procedure TTestReader.TestRead(aJSON: String; AResult: array of string);
  429. Var
  430. I : Integer;
  431. begin
  432. FreeAndNil(FReader);
  433. FReader:=TMyJSONReader.Create(aJSON,Foptions);
  434. TMyJSONReader(FReader).DoExecute;
  435. AssertEquals(aJSON+': Number of events',Length(AResult),FReader.List.Count);
  436. For I:=0 to Length(AResult)-1 do
  437. AssertEquals(aJSON+': Event number '+IntToStr(I),AResult[i],FReader.List[I]);
  438. end;
  439. procedure TTestReader.DoTestError(S : String; Options : TJSONOptions = DefaultOpts);
  440. Var
  441. P:TMyJSONReader;
  442. ParseOK : Boolean;
  443. begin
  444. ParseOK:=False;
  445. P:=TMyJSONReader.Create(S,FOptions);
  446. P.OPtions:=Options;
  447. Try
  448. Try
  449. P.DoExecute;
  450. ParseOk:=True;
  451. Finally
  452. FreeAndNil(P);
  453. end;
  454. except
  455. ParseOk:=False;
  456. end;
  457. If ParseOK then
  458. Fail('Parse of JSON string "'+S+'" should fail, but succeeded');
  459. end;
  460. { TJSONConsumer }
  461. procedure TJSONConsumer.Push(const aType : String; const AValue : String = '');
  462. begin
  463. if AValue<>'' then
  464. List.Add(aType+':'+AValue)
  465. else
  466. List.Add(aType);
  467. end;
  468. procedure TJSONConsumer.BooleanValue(const AValue: Boolean);
  469. begin
  470. Push('boolean',BoolToStr(AValue));
  471. end;
  472. procedure TJSONConsumer.EndArray;
  473. begin
  474. Push('ea');
  475. end;
  476. procedure TJSONConsumer.EndObject;
  477. begin
  478. Push('eo');
  479. end;
  480. procedure TJSONConsumer.FloatValue(const AValue: Double);
  481. begin
  482. List.Add('float:'+formatFloat('##.##',AVAlue));
  483. end;
  484. procedure TJSONConsumer.Int64Value(const AValue: int64);
  485. begin
  486. Push('int64',IntToStr(aValue));
  487. end;
  488. procedure TJSONConsumer.IntegerValue(const AValue: integer);
  489. begin
  490. Push('integer',IntToStr(aValue));
  491. end;
  492. procedure TJSONConsumer.KeyName(const AKey: TJSONStringType);
  493. begin
  494. Push('key',akey);
  495. end;
  496. procedure TJSONConsumer.NullValue;
  497. begin
  498. Push('null');
  499. end;
  500. procedure TJSONConsumer.NumberValue(const AValue: TJSONStringType);
  501. begin
  502. Push('number',aValue);
  503. end;
  504. procedure TJSONConsumer.QWordValue(const AValue: QWord);
  505. begin
  506. Push('qword',IntToStr(AValue));
  507. end;
  508. procedure TJSONConsumer.StartArray;
  509. begin
  510. Push('sa');
  511. end;
  512. procedure TJSONConsumer.StartObject;
  513. begin
  514. Push('so');
  515. end;
  516. procedure TJSONConsumer.StringValue(const AValue: TJSONStringType);
  517. begin
  518. List.Add('string:'+AValue)
  519. end;
  520. constructor TJSONConsumer.Create(AList: TStrings);
  521. begin
  522. FList:=AList;
  523. end;
  524. procedure TTestJSONConsumerReader.TestRead(aJSON: String; AResult: array of string);
  525. Var
  526. I : Integer;
  527. begin
  528. FreeAndNil(FReader);
  529. FreeAndNil(Flist);
  530. FList:=TStringList.Create;
  531. FReader:=TJSONConsumerReader.Create(aJSON,Foptions);
  532. FReader.Consumer:=TJSONConsumer.Create(FList);
  533. TJSONConsumerReader(FReader).Execute;
  534. AssertEquals(aJSON+': Number of events',Length(AResult),FList.Count);
  535. For I:=0 to Length(AResult)-1 do
  536. AssertEquals(aJSON+': Event number '+IntToStr(I),AResult[i],FList[I]);
  537. end;
  538. procedure TTestJSONConsumerReader.Teardown;
  539. begin
  540. FreeAndNil(FReader);
  541. FreeAndNil(FList);
  542. inherited Teardown;
  543. end;
  544. procedure TTestJSONConsumerReader.DoTestError(S : String; Options : TJSONOptions = DefaultOpts);
  545. Var
  546. P:TJSONConsumerReader;
  547. ParseOK : Boolean;
  548. begin
  549. ParseOK:=False;
  550. FreeAndNil(FReader);
  551. FreeAndNil(Flist);
  552. FList:=TStringList.Create;
  553. P:=TJSONConsumerReader.Create(S,Options);
  554. P.Consumer:=TJSONConsumer.Create(FList);
  555. P.OPtions:=Options;
  556. Try
  557. Try
  558. P.Execute;
  559. ParseOk:=True;
  560. Finally
  561. FreeAndNil(P);
  562. end;
  563. except
  564. ParseOk:=False;
  565. end;
  566. If ParseOK then
  567. Fail('Parse of JSON string "'+S+'" should fail, but succeeded');
  568. end;
  569. { TTestJSONEventReader }
  570. procedure TTestJSONEventReader.Teardown;
  571. begin
  572. FreeAndNil(Freader);
  573. FreeAndNil(Flist);
  574. inherited Teardown;
  575. end;
  576. procedure TTestJSONEventReader.DoTestError(S: String; Options: TJSONOptions);
  577. Var
  578. P:TJSONEventReader;
  579. ParseOK : Boolean;
  580. begin
  581. ParseOK:=False;
  582. FreeAndNil(FReader);
  583. FreeAndNil(Flist);
  584. FList:=TStringList.Create;
  585. P:=TJSONEventReader.Create(S,Options);
  586. HookupEvents(P);
  587. P.OPtions:=Options;
  588. Try
  589. Try
  590. P.Execute;
  591. ParseOk:=True;
  592. Finally
  593. FreeAndNil(P);
  594. end;
  595. except
  596. ParseOk:=False;
  597. end;
  598. If ParseOK then
  599. Fail('Parse of JSON string "'+S+'" should fail, but succeeded');
  600. end;
  601. procedure TTestJSONEventReader.TestRead(aJSON: String; AResult: array of string);
  602. Var
  603. I : Integer;
  604. begin
  605. FreeAndNil(FReader);
  606. FreeAndNil(Flist);
  607. FList:=TStringList.Create;
  608. FReader:=TJSONEventReader.Create(aJSON,Foptions);
  609. HookupEvents(FReader);
  610. FReader.Execute;
  611. AssertEquals(aJSON+': Number of events',Length(AResult),FList.Count);
  612. For I:=0 to Length(AResult)-1 do
  613. AssertEquals(aJSON+': Event number '+IntToStr(I),AResult[i],FList[I]);
  614. end;
  615. procedure TTestJSONEventReader.Push(const aType: String; const AValue: String);
  616. begin
  617. if AValue<>'' then
  618. FList.Add(aType+':'+AValue)
  619. else
  620. FList.Add(aType);
  621. end;
  622. procedure TTestJSONEventReader.BooleanValue(Sender: TObject; const AValue: Boolean);
  623. begin
  624. Push('boolean',BoolToStr(AValue));
  625. end;
  626. procedure TTestJSONEventReader.EndArray(Sender: TObject);
  627. begin
  628. Push('ea');
  629. end;
  630. procedure TTestJSONEventReader.EndObject(Sender: TObject);
  631. begin
  632. Push('eo');
  633. end;
  634. procedure TTestJSONEventReader.FloatValue(Sender: TObject; const AValue: Double);
  635. begin
  636. FList.Add('float:'+formatFloat('##.##',AVAlue));
  637. end;
  638. procedure TTestJSONEventReader.Int64Value(Sender: TObject; const AValue: int64);
  639. begin
  640. Push('int64',IntToStr(aValue));
  641. end;
  642. procedure TTestJSONEventReader.IntegerValue(Sender: TObject; const AValue: integer);
  643. begin
  644. Push('integer',IntToStr(aValue));
  645. end;
  646. procedure TTestJSONEventReader.KeyValue(Sender: TObject; const AKey: TJSONStringType);
  647. begin
  648. Push('key',akey);
  649. end;
  650. procedure TTestJSONEventReader.NullValue(Sender: TObject);
  651. begin
  652. Push('null');
  653. end;
  654. procedure TTestJSONEventReader.NumberValue(Sender: TObject; const AValue: TJSONStringType);
  655. begin
  656. Push('number',aValue);
  657. end;
  658. procedure TTestJSONEventReader.QWordValue(Sender: TObject; const AValue: QWord);
  659. begin
  660. Push('qword',IntToStr(AValue));
  661. end;
  662. procedure TTestJSONEventReader.StartArray(Sender: TObject);
  663. begin
  664. Push('sa');
  665. end;
  666. procedure TTestJSONEventReader.StartObject(Sender: TObject);
  667. begin
  668. Push('so');
  669. end;
  670. procedure TTestJSONEventReader.StringValue(Sender: TObject; const AValue: TJSONStringType);
  671. begin
  672. FList.Add('string:'+AValue)
  673. end;
  674. procedure TTestJSONEventReader.HookupEvents(AReader: TJSONEventReader);
  675. begin
  676. With Areader do
  677. begin
  678. OnNullValue:=@NullValue;
  679. OnBooleanValue:=@BooleanValue;
  680. OnNumberValue:=@NumberValue;
  681. OnFloatValue:=@FloatValue;
  682. OnIntegerValue:=@IntegerValue;
  683. OnInt64Value:=@Int64Value;
  684. OnQWordValue:=@QWordValue;
  685. OnStringValue:=@StringValue;
  686. OnKeyName:=@KeyValue;
  687. OnStartObject:=@StartObject;
  688. OnEndObject:=@EndObject;
  689. OnStartArray:=@StartArray;
  690. OnEndArray:=@EndArray;
  691. end;
  692. end;
  693. initialization
  694. RegisterTests([TTestReader,TTestJSONConsumerReader,TTestJSONEventReader]);
  695. end.