testjsonreader.pp 21 KB

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