tcscanner.pp 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997
  1. unit tcscanner;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, Typinfo, fpcunit, testutils, testregistry, jstoken, jsscanner;
  6. type
  7. { TTestLineReader }
  8. TTestLineReader = Class(TTestCase)
  9. Private
  10. FData: TStringStream;
  11. FReader : TStreamLineReader;
  12. protected
  13. Procedure CreateReader(AInput : String);
  14. procedure TearDown; override;
  15. published
  16. Procedure TestEmpty;
  17. Procedure TestReadLine;
  18. Procedure TestReadLines13;
  19. Procedure TestReadLines10;
  20. Procedure TestReadLines1310;
  21. procedure TestReadLinesEOF13;
  22. procedure TestReadLinesEOF10;
  23. procedure TestReadLinesEOF1310;
  24. procedure TestReadEmptyLines101010;
  25. end;
  26. { TTestJSScanner }
  27. TTestJSScanner = class(TTestCase)
  28. Private
  29. FStream : TStream;
  30. FLineReader : TLineReader;
  31. FScanner : TJSScanner;
  32. FErrorSource : String;
  33. procedure AssertEquals(AMessage: String; AExpected, AActual : TJSToken); overload;
  34. procedure CheckToken(AToken: TJSToken; ASource: String);
  35. procedure CheckTokens(ASource: String; ATokens: array of TJSToken);
  36. procedure DoTestFloat(F: Double);
  37. procedure DoTestFloat(F: Double; S: String);
  38. procedure DoTestString(S: String);
  39. procedure TestErrorSource;
  40. protected
  41. Function CreateScanner(AInput : String) : TJSScanner;
  42. procedure FreeScanner;
  43. procedure SetUp; override;
  44. procedure TearDown; override;
  45. Property Scanner : TJSScanner Read FScanner;
  46. published
  47. Procedure TestEmpty;
  48. procedure TestAndAnd;
  49. procedure TestAndEq;
  50. procedure TestAssign;
  51. procedure TestBraceClose;
  52. procedure TestBraceOpen;
  53. procedure TestColon;
  54. procedure TestComma;
  55. procedure TestCurlyBraceClose;
  56. procedure TestCurlyBraceOpen;
  57. procedure TestDiv;
  58. procedure TestDiveq;
  59. procedure TestXor;
  60. procedure TestXoreq;
  61. procedure TestDot;
  62. procedure TestEq;
  63. procedure TestGE;
  64. procedure TestFalse;
  65. procedure TestInv;
  66. procedure TestNot;
  67. procedure TestString;
  68. procedure TestTrue;
  69. procedure TestGreaterThan;
  70. procedure TestLE;
  71. procedure TestLessThan;
  72. procedure TestLSHIFT;
  73. procedure TestLSHIFTEQ;
  74. procedure TestMinus;
  75. procedure TestMinusEQ;
  76. procedure TestMinusMinus;
  77. procedure TestModeq;
  78. procedure TestMul;
  79. procedure TestNE;
  80. procedure TestNSE;
  81. procedure TestOREQ;
  82. procedure TestOROR;
  83. procedure TestPlus;
  84. procedure TestPlusEq;
  85. procedure TestPlusPlus;
  86. procedure TestRShift;
  87. procedure TestRShiftEq;
  88. procedure TestSemicolon;
  89. procedure TestSEq;
  90. procedure TestSquaredBraceClose;
  91. procedure TestSquaredBraceOpen;
  92. procedure TestStarEq;
  93. procedure TestURShift;
  94. procedure TestURShiftEq;
  95. procedure TestBreak;
  96. procedure TestCase;
  97. procedure TestCatch;
  98. procedure TestContinue;
  99. procedure TestDefault;
  100. procedure TestDelete;
  101. procedure TestDO;
  102. procedure TestElse;
  103. procedure TestFinally;
  104. procedure TestFor;
  105. procedure TestFunction;
  106. procedure TestIf;
  107. procedure TestIn;
  108. procedure TestInstanceOf;
  109. procedure TestNew;
  110. procedure TestReturn;
  111. procedure TestSwitch;
  112. procedure TestThis;
  113. procedure TestThrow;
  114. procedure TestTry;
  115. procedure TestTypeOf;
  116. procedure TestVar;
  117. procedure TestVoid;
  118. procedure TestWhile;
  119. procedure TestWith;
  120. Procedure Test2Words;
  121. procedure Test3Words;
  122. procedure TestIdentifier;
  123. procedure TestIdentifier2;
  124. procedure TestIdentifier3;
  125. procedure TestIdentifier4;
  126. procedure TestIdentifier5;
  127. procedure TestIdentifierDotIdentifier;
  128. procedure TestEOLN;
  129. procedure TestEOLN2;
  130. procedure TestEOLN3;
  131. procedure TestEOLN4;
  132. procedure TestComment1;
  133. procedure TestComment2;
  134. procedure TestComment3;
  135. procedure TestComment4;
  136. procedure TestComment5;
  137. procedure TestComment6;
  138. procedure TestFloat;
  139. procedure TestStringError;
  140. procedure TestFloatError;
  141. end;
  142. implementation
  143. Function TTestJSScanner.CreateScanner(AInput : String) : TJSScanner;
  144. begin
  145. FStream:=TStringStream.Create(AInput);
  146. FLineReader:=TStreamLineReader.Create(Fstream);
  147. FScanner:=TJSScanner.Create(FLineReader);
  148. Result:=FScanner;
  149. end;
  150. procedure TTestJSScanner.FreeScanner;
  151. begin
  152. FreeAndNil(FScanner);
  153. FreeAndNil(FLineReader);
  154. FreeAndNil(FStream);
  155. end;
  156. procedure TTestJSScanner.SetUp;
  157. begin
  158. inherited SetUp;
  159. end;
  160. procedure TTestJSScanner.TestEmpty;
  161. Var
  162. J : TJSToken;
  163. begin
  164. CreateScanner('');
  165. J:=Scanner.FetchToken;
  166. If (J<>tjsEOF) then
  167. Fail('Empty returns EOF');
  168. end;
  169. procedure TTestJSScanner.AssertEquals(AMessage : String; AExpected, AActual: TJSToken);
  170. Var
  171. J : TJSToken;
  172. S,EN1,EN2 : String;
  173. begin
  174. If (AActual<>AExpected) then
  175. begin
  176. EN1:=GetEnumName(TypeINfo(TJSToken),Ord(AExpected));
  177. EN2:=GetEnumName(TypeINfo(TJSToken),Ord(AActual));
  178. S:=Format('%s : %s <> %s',[AMessage,EN1,EN2]);
  179. Fail(S);
  180. end;
  181. end;
  182. procedure TTestJSScanner.CheckToken(AToken : TJSToken; ASource : String);
  183. Var
  184. J : TJSToken;
  185. EN2 : String;
  186. begin
  187. CreateScanner(ASource);
  188. J:=Scanner.FetchToken;
  189. EN2:=GetEnumName(TypeINfo(TJSToken),Ord(AToken));
  190. AssertEquals(Format('Source %s should result in %s.',[ASource,EN2]),AToken,J);
  191. end;
  192. procedure TTestJSScanner.TestAndAnd;
  193. begin
  194. CheckToken(tjsAndAnd,'&&');
  195. end;
  196. procedure TTestJSScanner.TestAndEq;
  197. begin
  198. CheckToken(tjsAndEq,'&=');
  199. end;
  200. procedure TTestJSScanner.TestBraceOpen;
  201. begin
  202. CheckToken(tjsBraceOpen,'(');
  203. end;
  204. procedure TTestJSScanner.TestBraceClose;
  205. begin
  206. CheckToken(tjsBraceClose,')');
  207. end;
  208. procedure TTestJSScanner.TestSquaredBraceClose;
  209. begin
  210. CheckToken(tjsSquaredBraceClose,']');
  211. end;
  212. procedure TTestJSScanner.TestSquaredBraceOpen;
  213. begin
  214. CheckToken(tjssQuaredBraceOpen,'[');
  215. end;
  216. procedure TTestJSScanner.TestCurlyBraceOpen;
  217. begin
  218. CheckToken(tjsCurlyBraceOpen,'{');
  219. end;
  220. procedure TTestJSScanner.TestCurlyBraceClose;
  221. begin
  222. CheckToken(tjsCurlyBraceClose,'}');
  223. end;
  224. procedure TTestJSScanner.TestComma;
  225. begin
  226. CheckToken(tjsComma,',');
  227. end;
  228. procedure TTestJSScanner.TestColon;
  229. begin
  230. CheckToken(tjsColon,':');
  231. end;
  232. procedure TTestJSScanner.TestDot;
  233. begin
  234. CheckToken(tjsDot,'.');
  235. end;
  236. procedure TTestJSScanner.TestSemicolon;
  237. begin
  238. CheckToken(tjsSemicolon,';');
  239. end;
  240. procedure TTestJSScanner.TestAssign;
  241. begin
  242. CheckToken(tjsAssign,'=');
  243. end;
  244. procedure TTestJSScanner.TestGreaterThan;
  245. begin
  246. CheckToken(tjsGT,'>');
  247. end;
  248. procedure TTestJSScanner.TestLessThan;
  249. begin
  250. CheckToken(tjsLT,'<');
  251. end;
  252. procedure TTestJSScanner.TestPlus;
  253. begin
  254. CheckToken(tjsPlus,'+');
  255. end;
  256. procedure TTestJSScanner.TestMinus;
  257. begin
  258. CheckToken(tjsMinus,'-');
  259. end;
  260. procedure TTestJSScanner.TestMul;
  261. begin
  262. CheckToken(tjsMul,'*');
  263. end;
  264. procedure TTestJSScanner.TestDiv;
  265. begin
  266. CheckToken(tjsDiv,'/');
  267. end;
  268. procedure TTestJSScanner.TestEq;
  269. begin
  270. CheckToken(tjsEq,'==');
  271. end;
  272. procedure TTestJSScanner.TestGE;
  273. begin
  274. CheckToken(tjsGE,'>=');
  275. end;
  276. procedure TTestJSScanner.TestLE;
  277. begin
  278. CheckToken(tjsLE,'<=');
  279. end;
  280. procedure TTestJSScanner.TestLSHIFT;
  281. begin
  282. CheckToken(tjsLShift,'<<');
  283. end;
  284. procedure TTestJSScanner.TestLSHIFTEQ;
  285. begin
  286. CheckToken(tjsLShiftEq,'<<=');
  287. end;
  288. procedure TTestJSScanner.TestMinusEQ;
  289. begin
  290. CheckToken(tjsMinusEq,'-=');
  291. end;
  292. procedure TTestJSScanner.TestMinusMinus;
  293. begin
  294. CheckToken(tjsMinusMinus,'--');
  295. end;
  296. procedure TTestJSScanner.TestModeq;
  297. begin
  298. CheckToken(tjsModeq,'%=');
  299. end;
  300. procedure TTestJSScanner.TestDiveq;
  301. begin
  302. CheckToken(tjsDiveq,'/=');
  303. end;
  304. procedure TTestJSScanner.TestXor;
  305. begin
  306. CheckToken(tjsXOR,'^');
  307. end;
  308. procedure TTestJSScanner.TestXoreq;
  309. begin
  310. CheckToken(tjsXOREQ,'^=');
  311. end;
  312. procedure TTestJSScanner.TestNE;
  313. begin
  314. CheckToken(tjsNE,'!=');
  315. end;
  316. procedure TTestJSScanner.TestInv;
  317. begin
  318. CheckToken(tjsInv,'~');
  319. end;
  320. procedure TTestJSScanner.TestNot;
  321. begin
  322. CheckToken(tjsNot,'!');
  323. end;
  324. procedure TTestJSScanner.TestTrue;
  325. begin
  326. CheckToken(tjsTrue,'true');
  327. end;
  328. procedure TTestJSScanner.TestFalse;
  329. begin
  330. CheckToken(tjsFalse,'false');
  331. end;
  332. procedure TTestJSScanner.TestOREQ;
  333. begin
  334. CheckToken(tjsOREQ,'|=');
  335. end;
  336. procedure TTestJSScanner.TestOROR;
  337. begin
  338. CheckToken(tjsOROR,'||');
  339. end;
  340. procedure TTestJSScanner.TestPlusEq;
  341. begin
  342. CheckToken(tjsPlusEq,'+=');
  343. end;
  344. procedure TTestJSScanner.TestPlusPlus;
  345. begin
  346. CheckToken(tjsPlusPlus,'++');
  347. end;
  348. procedure TTestJSScanner.TestURShift;
  349. begin
  350. CheckToken(tjsURSHIFT,'>>>');
  351. end;
  352. procedure TTestJSScanner.TestURShiftEq;
  353. begin
  354. CheckToken(tjsURSHIFTEQ,'>>>=');
  355. end;
  356. procedure TTestJSScanner.TestRShift;
  357. begin
  358. CheckToken(tjsRSHIFT,'>>');
  359. end;
  360. procedure TTestJSScanner.TestRShiftEq;
  361. begin
  362. CheckToken(tjsRSHIFTEQ,'>>=');
  363. end;
  364. procedure TTestJSScanner.TestSEq;
  365. begin
  366. CheckToken(tjsSEQ,'===');
  367. end;
  368. procedure TTestJSScanner.TestNSE;
  369. begin
  370. CheckToken(tjsSNE,'!==');
  371. end;
  372. procedure TTestJSScanner.TestStarEq;
  373. begin
  374. CheckToken(tjsMulEq,'*=');
  375. end;
  376. procedure TTestJSScanner.TestBreak;
  377. begin
  378. CheckToken(tjsBreak,'break');
  379. end;
  380. procedure TTestJSScanner.TestCase;
  381. begin
  382. CheckToken(tjscase,'case');
  383. end;
  384. procedure TTestJSScanner.TestCatch;
  385. begin
  386. CheckToken(tjscatch,'catch');
  387. end;
  388. procedure TTestJSScanner.TestContinue;
  389. begin
  390. CheckToken(tjscontinue,'continue');
  391. end;
  392. procedure TTestJSScanner.TestDefault;
  393. begin
  394. CheckToken(tjsdefault,'default');
  395. end;
  396. procedure TTestJSScanner.TestDelete;
  397. begin
  398. CheckToken(tjsdelete,'delete');
  399. end;
  400. procedure TTestJSScanner.TestDO;
  401. begin
  402. CheckToken(tjsdo,'do');
  403. end;
  404. procedure TTestJSScanner.TestElse;
  405. begin
  406. CheckToken(tjselse,'else');
  407. end;
  408. procedure TTestJSScanner.TestFinally;
  409. begin
  410. CheckToken(tjsfinally,'finally');
  411. end;
  412. procedure TTestJSScanner.TestFor;
  413. begin
  414. CheckToken(tjsfor,'for');
  415. end;
  416. procedure TTestJSScanner.TestFunction;
  417. begin
  418. CheckToken(tjsfunction,'function');
  419. end;
  420. procedure TTestJSScanner.TestIf;
  421. begin
  422. CheckToken(tjsif,'if');
  423. end;
  424. procedure TTestJSScanner.TestIn;
  425. begin
  426. CheckToken(tjsin,'in');
  427. end;
  428. procedure TTestJSScanner.TestInstanceOf;
  429. begin
  430. CheckToken(tjsinstanceof,'instanceof');
  431. end;
  432. procedure TTestJSScanner.TestNew;
  433. begin
  434. CheckToken(tjsnew,'new');
  435. end;
  436. procedure TTestJSScanner.TestReturn;
  437. begin
  438. CheckToken(tjsreturn,'return');
  439. end;
  440. procedure TTestJSScanner.TestSwitch;
  441. begin
  442. CheckToken(tjsswitch,'switch');
  443. end;
  444. procedure TTestJSScanner.TestThis;
  445. begin
  446. CheckToken(tjsThis,'this');
  447. end;
  448. procedure TTestJSScanner.TestThrow;
  449. begin
  450. CheckToken(tjsThrow,'throw');
  451. end;
  452. procedure TTestJSScanner.TestTry;
  453. begin
  454. CheckToken(tjsTry,'try');
  455. end;
  456. procedure TTestJSScanner.TestTypeOf;
  457. begin
  458. CheckToken(tjstypeof,'typeof');
  459. end;
  460. procedure TTestJSScanner.TestVar;
  461. begin
  462. CheckToken(tjsvar,'var');
  463. end;
  464. procedure TTestJSScanner.TestVoid;
  465. begin
  466. CheckToken(tjsvoid,'void');
  467. end;
  468. procedure TTestJSScanner.TestWhile;
  469. begin
  470. CheckToken(tjswhile,'while');
  471. end;
  472. procedure TTestJSScanner.TestWith;
  473. begin
  474. CheckToken(tjswith,'with');
  475. end;
  476. procedure TTestJSScanner.CheckTokens(ASource : String; ATokens : Array of TJSToken);
  477. Var
  478. I : Integer;
  479. J : TJSToken;
  480. S : String;
  481. begin
  482. CreateScanner(ASource);
  483. For I:=Low(ATokens) to High(ATokens) do
  484. begin
  485. J:=FScanner.FetchToken;
  486. S:=GetEnumName(TypeINfo(TJSToken),Ord(ATokens[i]));
  487. S:=Format('Source "%s", token %d (%s): expected %s',[ASource,I,FScanner.CurTokenString,S]);
  488. AssertEquals(S,ATokens[i],J);
  489. end;
  490. end;
  491. procedure TTestJSScanner.Test2Words;
  492. begin
  493. CheckTokens('with do',[tjsWith,tjsDo]);
  494. end;
  495. procedure TTestJSScanner.Test3Words;
  496. begin
  497. CheckTokens('with do for',[tjsWith,tjsDo,tjsFor]);
  498. end;
  499. procedure TTestJSScanner.TestIdentifier;
  500. begin
  501. CheckToken(tjsIdentifier,'something');
  502. AssertEquals('Correct identifier','something',FScanner.CurTokenString);
  503. end;
  504. procedure TTestJSScanner.TestIdentifier2;
  505. begin
  506. CheckToken(tjsIdentifier,'_something');
  507. AssertEquals('Correct identifier','_something',FScanner.CurTokenString);
  508. end;
  509. procedure TTestJSScanner.TestIdentifier3;
  510. begin
  511. CheckToken(tjsIdentifier,'$');
  512. AssertEquals('Correct identifier','$',FScanner.CurTokenString);
  513. end;
  514. procedure TTestJSScanner.TestIdentifier4;
  515. begin
  516. CheckToken(tjsIdentifier,'_0');
  517. AssertEquals('Correct identifier','_0',FScanner.CurTokenString);
  518. end;
  519. procedure TTestJSScanner.TestIdentifier5;
  520. begin
  521. CheckToken(tjsIdentifier,'$0');
  522. AssertEquals('Correct identifier','$0',FScanner.CurTokenString);
  523. end;
  524. procedure TTestJSScanner.TestIdentifierDotIdentifier;
  525. begin
  526. CheckTokens('something.different',[tjsIdentifier,tjsdot,tjsIdentifier]);
  527. // AssertEquals('Correct identifier','something',FScanner.CurTokenString);
  528. end;
  529. procedure TTestJSScanner.TestEOLN;
  530. begin
  531. CreateScanner('something');
  532. FScanner.FetchToken;
  533. AssertEquals('Got to end of line after reading single token at EOF',True,FScanner.IsEndOfLine);
  534. // AssertEquals('Correct identifier','something',FScanner.CurTokenString);
  535. end;
  536. procedure TTestJSScanner.TestEOLN2;
  537. begin
  538. CreateScanner('something different');
  539. FScanner.FetchToken;
  540. AssertEquals('Not yet end of line after reading single token at EOF',False,FScanner.IsEndOfLine);
  541. end;
  542. procedure TTestJSScanner.TestEOLN3;
  543. begin
  544. CreateScanner('something'#13#10'different');
  545. FScanner.FetchToken;
  546. AssertEquals('End of line after reading single token',True,FScanner.IsEndOfLine);
  547. end;
  548. procedure TTestJSScanner.TestEOLN4;
  549. begin
  550. CreateScanner('something'#10'different');
  551. FScanner.FetchToken;
  552. AssertEquals('End of line after reading first token',True,FScanner.IsEndOfLine);
  553. FScanner.FetchToken;
  554. AssertEquals('End of line after reading second token',True,FScanner.IsEndOfLine);
  555. end;
  556. procedure TTestJSScanner.TestComment1;
  557. begin
  558. CreateScanner('// some comment string');
  559. AssertEquals('Comment line is skipped',tjsEOF,FScanner.FetchToken);
  560. end;
  561. procedure TTestJSScanner.TestComment2;
  562. begin
  563. CreateScanner('// some comment string');
  564. FScanner.ReturnComments:=True;
  565. AssertEquals('Comment line is returned',tjsComment,FScanner.FetchToken);
  566. AssertEquals('Comment contents is returned',' some comment string',FScanner.CurTokenString);
  567. end;
  568. procedure TTestJSScanner.TestComment3;
  569. begin
  570. CreateScanner('/* some comment string */');
  571. AssertEquals('Comment line is skipped',tjsEOF,FScanner.FetchToken);
  572. end;
  573. procedure TTestJSScanner.TestComment4;
  574. begin
  575. CreateScanner('/* some comment string */');
  576. FScanner.ReturnComments:=True;
  577. AssertEquals('Comment line is returned',tjsComment,FScanner.FetchToken);
  578. AssertEquals('Comment contents is returned',' some comment string ',FScanner.CurTokenString);
  579. end;
  580. procedure TTestJSScanner.TestComment5;
  581. begin
  582. CreateScanner('/* some nested comment // string */');
  583. FScanner.ReturnComments:=True;
  584. AssertEquals('Comment line is returned',tjsComment,FScanner.FetchToken);
  585. AssertEquals('Comment contents is returned',' some nested comment // string ',FScanner.CurTokenString);
  586. end;
  587. procedure TTestJSScanner.TestComment6;
  588. begin
  589. CreateScanner('// /* some nested comment string */');
  590. FScanner.ReturnComments:=True;
  591. AssertEquals('Comment line is returned',tjsComment,FScanner.FetchToken);
  592. AssertEquals('Comment contents is returned',' /* some nested comment string */',FScanner.CurTokenString);
  593. end;
  594. procedure TTestJSScanner.TearDown;
  595. begin
  596. FreeScanner;
  597. Inherited;
  598. end;
  599. procedure TTestJSScanner.DoTestFloat(F : Double);
  600. Var
  601. S : String;
  602. begin
  603. Str(F,S);
  604. DoTestFloat(F,S);
  605. end;
  606. procedure TTestJSScanner.DoTestFloat(F : Double; S : String);
  607. Var
  608. J : TJSToken;
  609. C : Double;
  610. I : integer;
  611. V : String;
  612. begin
  613. CreateScanner(S);
  614. try
  615. J:=FScanner.FetchToken;
  616. AssertEquals(S+' is a number',tjsNumber,J);
  617. V:=FScanner.CurTokenString;
  618. If (Copy(V,1,2)='0x') then
  619. begin
  620. Flush(output);
  621. V:='$'+Copy(V,3,Length(V)-2);
  622. C:=StrToInt(V);
  623. end
  624. else
  625. begin
  626. Val(V,C,I);
  627. If (I<>0) then
  628. Fail(FScanner.CurTokenString+' does not contain a float value');
  629. end;
  630. AssertEquals('Parsed float equals original float',F,C);
  631. finally
  632. FreeScanner;
  633. end;
  634. end;
  635. procedure TTestJSScanner.TestFloat;
  636. begin
  637. DoTestFloat(1.2);
  638. DoTestFloat(-1.2);
  639. DoTestFloat(0);
  640. DoTestFloat(1.2e1);
  641. DoTestFloat(-1.2e1);
  642. DoTestFloat(0);
  643. DoTestFloat(1.2,'1.2');
  644. DoTestFloat(-1.2,'-1.2');
  645. DoTestFloat(0,'0.0');
  646. DoTestFloat(255,'0xff')
  647. end;
  648. procedure TTestJSScanner.TestFloatError;
  649. begin
  650. FErrorSource:='1xz';
  651. AssertException('Wrong float',EJSScannerError,@TestErrorSource);
  652. end;
  653. procedure TTestJSScanner.DoTestString(S: String);
  654. Var
  655. J : TJSToken;
  656. T : String;
  657. begin
  658. CreateScanner(S);
  659. try
  660. J:=FScanner.FetchToken;
  661. AssertEquals(S+' is a string',tjsString,J);
  662. If (Length(S)>0) and (S[1] in ['"','''']) then
  663. S:=Copy(S,2,Length(S)-2);
  664. AssertEquals('Correct string is returned',S,FScanner.CurTokenString);
  665. finally
  666. FreeScanner;
  667. end;
  668. end;
  669. procedure TTestJSScanner.TestString;
  670. begin
  671. DoTestString('"A string"');
  672. DoTestString('""');
  673. DoTestString('''''');
  674. DoTestString('''A string''');
  675. end;
  676. procedure TTestJSScanner.TestErrorSource;
  677. begin
  678. CreateScanner(FErrorSource);
  679. try
  680. While (FScanner.FetchToken<>tjsEOF) do ;
  681. finally
  682. FreeScanner;
  683. end;
  684. end;
  685. procedure TTestJSScanner.TestStringError;
  686. begin
  687. FErrorSource:='"A string';
  688. AssertException('Unterminated string',EJSScannerError,@TestErrorSource);
  689. FErrorSource:='''A string';
  690. AssertException('Unterminated string',EJSScannerError,@TestErrorSource);
  691. end;
  692. { TTestLineReader }
  693. procedure TTestLineReader.CreateReader(AInput: String);
  694. begin
  695. FData:=TStringStream.Create(AInput);
  696. FReader:=TStreamLineReader.Create(FData);
  697. end;
  698. procedure TTestLineReader.TearDown;
  699. begin
  700. FreeAndNil(FReader);
  701. FreeAndNil(FData);
  702. end;
  703. procedure TTestLineReader.TestEmpty;
  704. begin
  705. CreateReader('');
  706. AssertEquals('Empty reader returns EOF',True,FReader.IsEOF);
  707. AssertEquals('Empty reader returns empty string','',FReader.ReadLine);
  708. end;
  709. procedure TTestLineReader.TestReadLine;
  710. begin
  711. CreateReader('Something');
  712. AssertEquals('Reader with 1 line returns 1 line','Something',FReader.ReadLine);
  713. AssertEquals('EOF true after reading line',True,FReader.IsEOF);
  714. end;
  715. procedure TTestLineReader.TestReadLines13;
  716. begin
  717. CreateReader('Something'#13'else');
  718. AssertEquals('Reader with 2 lines returns 1st line','Something',FReader.ReadLine);
  719. AssertEquals('Reader with 2 lines returns 2nd line','else',FReader.ReadLine);
  720. AssertEquals('EOF true after reading lines',True,FReader.IsEOF);
  721. end;
  722. procedure TTestLineReader.TestReadLines10;
  723. begin
  724. CreateReader('Something'#10'else');
  725. AssertEquals('Reader with 2 lines returns 1st line','Something',FReader.ReadLine);
  726. AssertEquals('Reader with 2 lines returns 2nd line','else',FReader.ReadLine);
  727. AssertEquals('EOF true after reading lines',True,FReader.IsEOF);
  728. end;
  729. procedure TTestLineReader.TestReadLines1310;
  730. begin
  731. CreateReader('Something'#13#10'else');
  732. AssertEquals('Reader with 2 lines returns 1st line','Something',FReader.ReadLine);
  733. AssertEquals('Reader with 2 lines returns 2nd line','else',FReader.ReadLine);
  734. AssertEquals('EOF true after reading lines',True,FReader.IsEOF);
  735. end;
  736. procedure TTestLineReader.TestReadLinesEOF13;
  737. begin
  738. CreateReader('Something'#13);
  739. AssertEquals('Reader with 2 lines + CR returns 1st line','Something',FReader.ReadLine);
  740. AssertEquals('Reader with 1 lines + CR returns empty 2nd line','',FReader.ReadLine);
  741. AssertEquals('EOF true after reading lines',True,FReader.IsEOF);
  742. end;
  743. procedure TTestLineReader.TestReadLinesEOF10;
  744. begin
  745. CreateReader('Something'#10);
  746. AssertEquals('Reader with 2 lines + LF returns 1st line','Something',FReader.ReadLine);
  747. AssertEquals('Reader with 1 lines + LF returns empty 2nd line','',FReader.ReadLine);
  748. AssertEquals('EOF true after reading lines',True,FReader.IsEOF);
  749. end;
  750. procedure TTestLineReader.TestReadLinesEOF1310;
  751. begin
  752. CreateReader('Something'#13#10);
  753. AssertEquals('Reader with 2 lines + CRLF returns 1st line','Something',FReader.ReadLine);
  754. AssertEquals('Reader with 1 lines + CRLF returns empty 2nd line','',FReader.ReadLine);
  755. AssertEquals('EOF true after reading lines',True,FReader.IsEOF);
  756. end;
  757. procedure TTestLineReader.TestReadEmptyLines101010;
  758. begin
  759. CreateReader('Something'#10#10#10);
  760. AssertEquals('Reader with 1 line + LFLFLF returns 1st line','Something',FReader.ReadLine);
  761. AssertEquals('EOF false after reading line 1',False,FReader.IsEOF);
  762. AssertEquals('Reader with 1 line + LFLFLF returns empty 2nd line','',FReader.ReadLine);
  763. AssertEquals('EOF false after reading line 2',False,FReader.IsEOF);
  764. AssertEquals('Reader with 1 line + LFLFLF returns empty 3nd line','',FReader.ReadLine);
  765. AssertEquals('EOF true after reading lines',True,FReader.IsEOF);
  766. end;
  767. initialization
  768. RegisterTests([TTestLineReader,TTestJSScanner]);
  769. end.