testjsonreader.pp 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847
  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. begin
  262. DoTestString('A string');
  263. DoTestString('');
  264. DoTestString('\"','"');
  265. DoTestString('\u00f8','ø'); // this is ø
  266. DoTestString('\u00f8\"','ø"'); // this is ø"
  267. DoTestString('\ud83c\udf1f',GlowingStar);
  268. DoTestString('\u0041\u0042','AB'); //issue #0038622
  269. DoTestString('\u0041\u0042\u0043','ABC');
  270. DoTestString('\u0041\u0042\u0043\u0044','ABCD');
  271. DoTestString('\u95e8\u88ab\u8111\u5b50\u6324\u574f\u4e86',Utf8Encode(Chinese));
  272. end;
  273. procedure TBaseTestReader.TestArray;
  274. Var
  275. S1,S2,S3 : String;
  276. begin
  277. TestRead('[]',['sa','ea']);
  278. TestRead('[null]',['sa','null','ea']);
  279. TestRead('[true]',['sa','boolean:'+BoolToStr(true),'ea']);
  280. TestRead('[false]',['sa','boolean:'+BoolToStr(false),'ea']);
  281. TestRead('[1]',['sa','number:1','integer:1','ea']);
  282. TestRead('[1, 2]',['sa','number:1','integer:1','number:2','integer:2','ea']);
  283. TestRead('[1, 2, 3]',['sa','number:1','integer:1','number:2','integer:2','number:3','integer:3','ea']);
  284. TestRead('[1234567890123456]',['sa','number:1234567890123456','int64:1234567890123456','ea']);
  285. TestRead('[1234567890123456, 2234567890123456]',
  286. ['sa','number:1234567890123456','int64:1234567890123456','number:2234567890123456','int64:2234567890123456','ea']);
  287. TestRead('[1234567890123456, 2234567890123456, 3234567890123456]',
  288. ['sa','number:1234567890123456','int64:1234567890123456','number:2234567890123456','int64:2234567890123456',
  289. 'number:3234567890123456','int64:3234567890123456','ea']);
  290. Str(12/10,S1);
  291. Delete(S1,1,1);
  292. Str(34/10,S2);
  293. Delete(S2,1,1);
  294. Str(34/10,S3);
  295. Delete(S3,1,1);
  296. TestRead('['+S1+']',['sa','number:'+s1,'float:'+formatfloat('##.##',12/10),'ea']);
  297. {
  298. TestRead('['+S1+', '+S2+']',2,true);
  299. TestRead('['+S1+', '+S2+', '+S3+']',3,true);
  300. TestRead('["A string"]',1);
  301. TestRead('["A string", "Another string"]',2);
  302. TestRead('["A string", "Another string", "Yet another string"]',3);
  303. TestRead('[null, false]',2);
  304. TestRead('[true, false]',2);
  305. TestRead('[null, 1]',2);
  306. TestRead('[1, "A string"]',2);
  307. TestRead('[1, []]',2);
  308. TestRead('[1, [1, 2]]',2);}
  309. end;
  310. procedure TBaseTestReader.TestTrailingComma;
  311. begin
  312. FOptions:=[joIgnoreTrailingComma];
  313. TestRead('[1, 2, ]',['sa','number:1','integer:1','number:2','integer:2','ea']);
  314. TestRead('{ "a" : 1, }',['so','key:a', 'number:1','integer:1','eo']);
  315. end;
  316. procedure TBaseTestReader.TestTrailingCommaErrorArray;
  317. begin
  318. AssertException('Need joIgnoreTrailingComma in options to allow trailing comma',EJSONParser,@DoTrailingCommaErrorArray) ;
  319. end;
  320. procedure TBaseTestReader.TestTrailingCommaErrorObject;
  321. begin
  322. AssertException('Need joIgnoreTrailingComma in options to allow trailing comma',EJSONParser,@DoTrailingCommaErrorObject);
  323. end;
  324. procedure TBaseTestReader.DoTrailingCommaErrorArray;
  325. begin
  326. TestRead('[1, 2, ]',['sa','number:1','integer:1','number:2','integer:2','ea']);
  327. end;
  328. procedure TBaseTestReader.DoTrailingCommaErrorObject;
  329. begin
  330. TestRead('{ "a" : 1, }',['so','key:a', 'number:1','integer:1','eo']);
  331. end;
  332. procedure TBaseTestReader.TestMixed;
  333. begin
  334. TestRead('[1, {}]',['sa','number:1','integer:1','so','eo','ea']);
  335. TestRead('[1, { "a" : 1 }]',['sa','number:1','integer:1','so','key:a','number:1','integer:1','eo','ea']);
  336. TestRead('[1, { "a" : 1 }, 1]',['sa','number:1','integer:1','so','key:a','number:1','integer:1','eo','number:1','integer:1','ea']);
  337. TestRead('{ "a" : [1, 2] }',['so','key:a','sa','number:1','integer:1','number:2','integer:2','ea','eo']);
  338. TestRead('{ "a" : [1, 2], "B" : { "c" : "d" } }',
  339. ['so','key:a','sa','number:1','integer:1','number:2','integer:2','ea','key:B','so','key:c','string:d','eo','eo']);
  340. end;
  341. procedure TBaseTestReader.TestComment;
  342. begin
  343. FOptions:=[joComments];
  344. TestRead('/* */ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
  345. TestRead('//'+sLineBreak+' [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
  346. TestRead('/* '+sLineBreak+' */ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
  347. TestRead('/*'+sLineBreak+'*/ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
  348. TestRead('/*'+sLineBreak+'*'+sLineBreak+'*/ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
  349. TestRead('/**'+sLineBreak+'**'+sLineBreak+'**/ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
  350. TestRead('/* */ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
  351. TestRead('[1, {}]//',['sa','number:1','integer:1','so','eo','ea']);
  352. TestRead('[1, {}]/* '+sLineBreak+' */',['sa','number:1','integer:1','so','eo','ea']);
  353. TestRead('[1, {}]/* '+sLineBreak+' */ ',['sa','number:1','integer:1','so','eo','ea']);
  354. TestRead('[1, {}]/* '+sLineBreak+'*'+sLineBreak+'*/ ',['sa','number:1','integer:1','so','eo','ea']);
  355. TestRead('[1, {}]/**'+sLineBreak+'**'+sLineBreak+'**/ ',['sa','number:1','integer:1','so','eo','ea']);
  356. end;
  357. procedure TBaseTestReader.TestObject;
  358. begin
  359. TestRead('{}',['so','eo']);
  360. TestRead('{ "a" : 1 }',['so','key:a','number:1','integer:1','eo']);
  361. TestRead('{ "a" : 1, "B" : "String" }',['so','key:a','number:1','integer:1','key:B','string:String','eo']);
  362. TestRead('{ "a" : 1, "B" : {} }',['so','key:a','number:1','integer:1','key:B','so','eo','eo']);
  363. TestRead('{ "a" : 1, "B" : { "c" : "d" } }',['so','key:a','number:1','integer:1','key:B','so','key:c','string:d','eo','eo']);
  364. end;
  365. procedure TBaseTestReader.TestObjectError;
  366. begin
  367. DoTestError('{ "name" : value }',[joUTF8]);
  368. end;
  369. procedure TBaseTestReader.TestErrors;
  370. begin
  371. DoTestError('a');
  372. DoTestError('"b');
  373. DoTestError('1Tru');
  374. DoTestError('b"');
  375. DoTestError('{"a" : }');
  376. DoTestError('{"a" : ""');
  377. DoTestError('{"a : ""');
  378. DoTestError('[1,]');
  379. DoTestError('[,]');
  380. DoTestError('[,,]');
  381. DoTestError('[1,,]');
  382. end;
  383. procedure TBaseTestReader.TestGarbageOK;
  384. begin
  385. TestRead('"a"sss',['string:a']);
  386. TestRead('[null]xxx',['sa','null','ea']);
  387. end;
  388. procedure TBaseTestReader.TestGarbageFail;
  389. begin
  390. DoTestError('"a"sss',[joStrict]);
  391. DoTestError('[null]aaa',[joStrict]);
  392. end;
  393. procedure TBaseTestReader.CallNoHandlerStream;
  394. Var
  395. S : TStringStream;
  396. begin
  397. S:=TstringStream.Create('1');
  398. try
  399. GetJSON(S,True).Free;
  400. finally
  401. S.Free;
  402. end;
  403. end;
  404. procedure TBaseTestReader.DoTestString(S: String; AValue : String = '');
  405. begin
  406. if AValue='' then
  407. AValue:=S;
  408. TestRead('"'+S+'"',['string:'+AValue]);
  409. end;
  410. procedure TBaseTestReader.DoTestFloat(F : TJSONFloat);
  411. Var
  412. S : String;
  413. begin
  414. Str(F,S);
  415. DoTestFloat(F,S);
  416. end;
  417. procedure TBaseTestReader.DoTestFloat(F : TJSONFloat; S : String);
  418. begin
  419. TestRead(S,['number:'+trim(S),'float:'+formatfloat('##.##',F)]);
  420. end;
  421. procedure TTestReader.Teardown;
  422. begin
  423. FreeAndNil(FReader);
  424. inherited Teardown;
  425. end;
  426. procedure TTestReader.TestRead(aJSON: String; AResult: array of string);
  427. Var
  428. I : Integer;
  429. begin
  430. FreeAndNil(FReader);
  431. FReader:=TMyJSONReader.Create(aJSON,Foptions);
  432. TMyJSONReader(FReader).DoExecute;
  433. AssertEquals(aJSON+': Number of events',Length(AResult),FReader.List.Count);
  434. For I:=0 to Length(AResult)-1 do
  435. AssertEquals(aJSON+': Event number '+IntToStr(I),AResult[i],FReader.List[I]);
  436. end;
  437. procedure TTestReader.DoTestError(S : String; Options : TJSONOptions = DefaultOpts);
  438. Var
  439. P:TMyJSONReader;
  440. ParseOK : Boolean;
  441. begin
  442. ParseOK:=False;
  443. P:=TMyJSONReader.Create(S,FOptions);
  444. P.OPtions:=Options;
  445. Try
  446. Try
  447. P.DoExecute;
  448. ParseOk:=True;
  449. Finally
  450. FreeAndNil(P);
  451. end;
  452. except
  453. ParseOk:=False;
  454. end;
  455. If ParseOK then
  456. Fail('Parse of JSON string "'+S+'" should fail, but succeeded');
  457. end;
  458. { TJSONConsumer }
  459. procedure TJSONConsumer.Push(const aType : String; const AValue : String = '');
  460. begin
  461. if AValue<>'' then
  462. List.Add(aType+':'+AValue)
  463. else
  464. List.Add(aType);
  465. end;
  466. procedure TJSONConsumer.BooleanValue(const AValue: Boolean);
  467. begin
  468. Push('boolean',BoolToStr(AValue));
  469. end;
  470. procedure TJSONConsumer.EndArray;
  471. begin
  472. Push('ea');
  473. end;
  474. procedure TJSONConsumer.EndObject;
  475. begin
  476. Push('eo');
  477. end;
  478. procedure TJSONConsumer.FloatValue(const AValue: Double);
  479. begin
  480. List.Add('float:'+formatFloat('##.##',AVAlue));
  481. end;
  482. procedure TJSONConsumer.Int64Value(const AValue: int64);
  483. begin
  484. Push('int64',IntToStr(aValue));
  485. end;
  486. procedure TJSONConsumer.IntegerValue(const AValue: integer);
  487. begin
  488. Push('integer',IntToStr(aValue));
  489. end;
  490. procedure TJSONConsumer.KeyName(const AKey: TJSONStringType);
  491. begin
  492. Push('key',akey);
  493. end;
  494. procedure TJSONConsumer.NullValue;
  495. begin
  496. Push('null');
  497. end;
  498. procedure TJSONConsumer.NumberValue(const AValue: TJSONStringType);
  499. begin
  500. Push('number',aValue);
  501. end;
  502. procedure TJSONConsumer.QWordValue(const AValue: QWord);
  503. begin
  504. Push('qword',IntToStr(AValue));
  505. end;
  506. procedure TJSONConsumer.StartArray;
  507. begin
  508. Push('sa');
  509. end;
  510. procedure TJSONConsumer.StartObject;
  511. begin
  512. Push('so');
  513. end;
  514. procedure TJSONConsumer.StringValue(const AValue: TJSONStringType);
  515. begin
  516. List.Add('string:'+AValue)
  517. end;
  518. constructor TJSONConsumer.Create(AList: TStrings);
  519. begin
  520. FList:=AList;
  521. end;
  522. procedure TTestJSONConsumerReader.TestRead(aJSON: String; AResult: array of string);
  523. Var
  524. I : Integer;
  525. begin
  526. FreeAndNil(FReader);
  527. FreeAndNil(Flist);
  528. FList:=TStringList.Create;
  529. FReader:=TJSONConsumerReader.Create(aJSON,Foptions);
  530. FReader.Consumer:=TJSONConsumer.Create(FList);
  531. TJSONConsumerReader(FReader).Execute;
  532. AssertEquals(aJSON+': Number of events',Length(AResult),FList.Count);
  533. For I:=0 to Length(AResult)-1 do
  534. AssertEquals(aJSON+': Event number '+IntToStr(I),AResult[i],FList[I]);
  535. end;
  536. procedure TTestJSONConsumerReader.Teardown;
  537. begin
  538. FreeAndNil(FReader);
  539. FreeAndNil(FList);
  540. inherited Teardown;
  541. end;
  542. procedure TTestJSONConsumerReader.DoTestError(S : String; Options : TJSONOptions = DefaultOpts);
  543. Var
  544. P:TJSONConsumerReader;
  545. ParseOK : Boolean;
  546. begin
  547. ParseOK:=False;
  548. FreeAndNil(FReader);
  549. FreeAndNil(Flist);
  550. FList:=TStringList.Create;
  551. P:=TJSONConsumerReader.Create(S,Options);
  552. P.Consumer:=TJSONConsumer.Create(FList);
  553. P.OPtions:=Options;
  554. Try
  555. Try
  556. P.Execute;
  557. ParseOk:=True;
  558. Finally
  559. FreeAndNil(P);
  560. end;
  561. except
  562. ParseOk:=False;
  563. end;
  564. If ParseOK then
  565. Fail('Parse of JSON string "'+S+'" should fail, but succeeded');
  566. end;
  567. { TTestJSONEventReader }
  568. procedure TTestJSONEventReader.Teardown;
  569. begin
  570. FreeAndNil(Freader);
  571. FreeAndNil(Flist);
  572. inherited Teardown;
  573. end;
  574. procedure TTestJSONEventReader.DoTestError(S: String; Options: TJSONOptions);
  575. Var
  576. P:TJSONEventReader;
  577. ParseOK : Boolean;
  578. begin
  579. ParseOK:=False;
  580. FreeAndNil(FReader);
  581. FreeAndNil(Flist);
  582. FList:=TStringList.Create;
  583. P:=TJSONEventReader.Create(S,Options);
  584. HookupEvents(P);
  585. P.OPtions:=Options;
  586. Try
  587. Try
  588. P.Execute;
  589. ParseOk:=True;
  590. Finally
  591. FreeAndNil(P);
  592. end;
  593. except
  594. ParseOk:=False;
  595. end;
  596. If ParseOK then
  597. Fail('Parse of JSON string "'+S+'" should fail, but succeeded');
  598. end;
  599. procedure TTestJSONEventReader.TestRead(aJSON: String; AResult: array of string);
  600. Var
  601. I : Integer;
  602. begin
  603. FreeAndNil(FReader);
  604. FreeAndNil(Flist);
  605. FList:=TStringList.Create;
  606. FReader:=TJSONEventReader.Create(aJSON,Foptions);
  607. HookupEvents(FReader);
  608. FReader.Execute;
  609. AssertEquals(aJSON+': Number of events',Length(AResult),FList.Count);
  610. For I:=0 to Length(AResult)-1 do
  611. AssertEquals(aJSON+': Event number '+IntToStr(I),AResult[i],FList[I]);
  612. end;
  613. procedure TTestJSONEventReader.Push(const aType: String; const AValue: String);
  614. begin
  615. if AValue<>'' then
  616. FList.Add(aType+':'+AValue)
  617. else
  618. FList.Add(aType);
  619. end;
  620. procedure TTestJSONEventReader.BooleanValue(Sender: TObject; const AValue: Boolean);
  621. begin
  622. Push('boolean',BoolToStr(AValue));
  623. end;
  624. procedure TTestJSONEventReader.EndArray(Sender: TObject);
  625. begin
  626. Push('ea');
  627. end;
  628. procedure TTestJSONEventReader.EndObject(Sender: TObject);
  629. begin
  630. Push('eo');
  631. end;
  632. procedure TTestJSONEventReader.FloatValue(Sender: TObject; const AValue: Double);
  633. begin
  634. FList.Add('float:'+formatFloat('##.##',AVAlue));
  635. end;
  636. procedure TTestJSONEventReader.Int64Value(Sender: TObject; const AValue: int64);
  637. begin
  638. Push('int64',IntToStr(aValue));
  639. end;
  640. procedure TTestJSONEventReader.IntegerValue(Sender: TObject; const AValue: integer);
  641. begin
  642. Push('integer',IntToStr(aValue));
  643. end;
  644. procedure TTestJSONEventReader.KeyValue(Sender: TObject; const AKey: TJSONStringType);
  645. begin
  646. Push('key',akey);
  647. end;
  648. procedure TTestJSONEventReader.NullValue(Sender: TObject);
  649. begin
  650. Push('null');
  651. end;
  652. procedure TTestJSONEventReader.NumberValue(Sender: TObject; const AValue: TJSONStringType);
  653. begin
  654. Push('number',aValue);
  655. end;
  656. procedure TTestJSONEventReader.QWordValue(Sender: TObject; const AValue: QWord);
  657. begin
  658. Push('qword',IntToStr(AValue));
  659. end;
  660. procedure TTestJSONEventReader.StartArray(Sender: TObject);
  661. begin
  662. Push('sa');
  663. end;
  664. procedure TTestJSONEventReader.StartObject(Sender: TObject);
  665. begin
  666. Push('so');
  667. end;
  668. procedure TTestJSONEventReader.StringValue(Sender: TObject; const AValue: TJSONStringType);
  669. begin
  670. FList.Add('string:'+AValue)
  671. end;
  672. procedure TTestJSONEventReader.HookupEvents(AReader: TJSONEventReader);
  673. begin
  674. With Areader do
  675. begin
  676. OnNullValue:=@NullValue;
  677. OnBooleanValue:=@BooleanValue;
  678. OnNumberValue:=@NumberValue;
  679. OnFloatValue:=@FloatValue;
  680. OnIntegerValue:=@IntegerValue;
  681. OnInt64Value:=@Int64Value;
  682. OnQWordValue:=@QWordValue;
  683. OnStringValue:=@StringValue;
  684. OnKeyName:=@KeyValue;
  685. OnStartObject:=@StartObject;
  686. OnEndObject:=@EndObject;
  687. OnStartArray:=@StartArray;
  688. OnEndArray:=@EndArray;
  689. end;
  690. end;
  691. initialization
  692. RegisterTests([TTestReader,TTestJSONConsumerReader,TTestJSONEventReader]);
  693. end.