testjsonreader.pas 22 KB

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