tcscanner.pas 58 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502
  1. unit tcscanner;
  2. {$mode objfpc}{$H+}
  3. {$define NOCONSOLE}
  4. interface
  5. uses
  6. Classes, SysUtils, typinfo, fpcunit, testregistry, pscanner;
  7. Const
  8. SingleQuote = #39;
  9. DoubleQuote = #39#39;
  10. TripleQuote = #39#39#39;
  11. type
  12. { TTestTokenFinder }
  13. TTestTokenFinder = class(TTestCase)
  14. Published
  15. Procedure TestFind;
  16. end;
  17. { TTestStreamLineReader }
  18. TTestStreamLineReader = class(TTestCase)
  19. Private
  20. FReader: TStreamLineReader;
  21. Protected
  22. procedure NewSource(Const Source : string);
  23. Procedure TestLine(Const ALine : String; ExpectEOF : Boolean = True);
  24. procedure TearDown; override;
  25. Published
  26. Procedure TestCreate;
  27. Procedure TestEOF;
  28. Procedure TestEmptyLine;
  29. Procedure TestEmptyLineCR;
  30. Procedure TestEmptyLineLF;
  31. Procedure TestEmptyLineCRLF;
  32. Procedure TestEmptyLineLFCR;
  33. Procedure TestOneLine;
  34. Procedure TestTwoLines;
  35. end;
  36. { TTestingPascalScanner }
  37. TTestingPascalScanner = Class(TPascalScanner)
  38. private
  39. FDoSpecial: Boolean;
  40. protected
  41. function HandleMacro(AIndex: integer): TToken;override;
  42. Public
  43. Property DoSpecial : Boolean Read FDoSpecial Write FDoSpecial;
  44. end;
  45. { TTestScanner }
  46. TTestScanner = class(TTestCase)
  47. Private
  48. FLI: String;
  49. FLibAlias: String;
  50. FLibName: String;
  51. FLibOptions: String;
  52. FLinkLibHandled: Boolean;
  53. FScanner : TPascalScanner;
  54. FResolver : TStreamResolver;
  55. FDoCommentCalled : Boolean;
  56. FComment: string;
  57. FPathPrefix : String;
  58. FTestTokenString: String;
  59. FMultiLine : String;
  60. procedure DoTestDelphiMultiLine;
  61. procedure DoTestDelphiMultiLineString;
  62. protected
  63. procedure DoComment(Sender: TObject; aComment: TPasScannerString);
  64. procedure DoLinkLib(Sender: TObject; const aLibName,aAlias,aOptions : TPasScannerString; var aHandled : Boolean);
  65. procedure SetUp; override;
  66. procedure TearDown; override;
  67. Procedure DoMultilineError;
  68. Function TokenToString(tk : TToken) : string;
  69. class Function CreateDelphiMultiLine(Lines : Array of string; PrefixCount : Byte = 2; Suffix : String = '';QuoteCount : Integer=3) : string;
  70. Procedure AssertEquals(Msg : String; Expected,Actual : TToken); overload;
  71. Procedure AssertEquals(Msg : String; Expected,Actual : TModeSwitch); overload;
  72. Procedure AssertEquals(Msg : String; Expected,Actual : TModeSwitches); overload;
  73. Procedure AssertEquals(Msg : String; Expected,Actual : TEOLStyle); overload;
  74. // creates a virtual source file with name 'afile.pp', prepended with PathPrefix
  75. procedure NewSource(Const Source : RawBytestring; DoClear : Boolean = True);
  76. Procedure DoTestToken(t : TToken; Const ASource : RawByteString; Const CheckEOF : Boolean = True);
  77. Procedure TestToken(t : TToken; Const ASource : RawByteString; Const CheckEOF : Boolean = True);
  78. Procedure TestTokens(t : array of TToken; Const ASource : RawByteString; Const CheckEOF : Boolean = True;Const DoClear : Boolean = True);
  79. Property LastIDentifier : String Read FLI Write FLi;
  80. Property Scanner : TPascalScanner Read FScanner;
  81. // Path for source filename.
  82. Property PathPrefix : String Read FPathPrefix Write FPathPrefix;
  83. Property TestTokenString : String Read FTestTokenString;
  84. // Results from DoLinkLib;
  85. Property LibName : String Read FLibName;
  86. Property LibAlias : String Read FLibAlias;
  87. Property LibOptions : String read FLibOptions;
  88. // Will be returned in aHandled in DoLinkLib
  89. Property LinkLibHandled : Boolean Read FLinkLibHandled Write FLinkLibHandled;
  90. published
  91. Procedure TestEmpty;
  92. procedure TestEOF;
  93. procedure TestWhitespace;
  94. procedure TestComment1;
  95. procedure TestComment2;
  96. procedure TestComment3;
  97. procedure TestComment4;
  98. procedure TestComment5;
  99. procedure TestComment6;
  100. procedure TestComment7;
  101. procedure TestComment8;
  102. procedure TestComment9;
  103. procedure TestNestedComment1;
  104. procedure TestNestedComment2;
  105. procedure TestNestedComment3;
  106. procedure TestNestedComment4;
  107. procedure TestNestedComment5;
  108. procedure TestonComment;
  109. procedure TestIdentifier;
  110. procedure TestSelf;
  111. procedure TestSelfNoToken;
  112. procedure TestString;
  113. procedure TestMultilineStringError;
  114. procedure TestMultilineStringSource;
  115. Procedure TestMultilineStringLF;
  116. Procedure TestMultilineStringCR;
  117. Procedure TestMultilineStringCRLF;
  118. Procedure TestMultilineStringPlatform;
  119. Procedure TestMultilineStringDoubleBackticks;
  120. Procedure TestMultilineLineEndingDirective;
  121. Procedure TestMultilineTrimLeftDirective;
  122. procedure TestMultilineStringTrimAll;
  123. procedure TestMultilineStringTrimAuto;
  124. procedure TestMultilineStringTrim2;
  125. Procedure TestDelphiMultiLine;
  126. procedure TestDelphiMultiLineNotEnabled;
  127. procedure TestDelphiMultiLineWrongIndent;
  128. procedure TestDelphiMultiLineSpecial1;
  129. procedure TestDelphiMultiLineSpecial2;
  130. procedure TestDelphiMultiLineTrailingGarbage1;
  131. procedure TestDelphiMultiLineTrailingGarbage2;
  132. procedure TestDelphiMultiLineTrailingGarbage3;
  133. procedure TestDelphiMultiLineTrailingPlusLit;
  134. procedure TestDelphiMultiLineEmbeddedQuotes;
  135. procedure TestDelphiMultiLineInDelphiMode;
  136. procedure TestDelphiMultiLineFailNonWhiteSpaceBeforeClosing;
  137. Procedure TestTextBlockDirective;
  138. procedure TestNumber;
  139. procedure TestChar;
  140. procedure TestCharString;
  141. procedure TestCaretString;
  142. procedure TestBraceOpen;
  143. procedure TestBraceClose;
  144. procedure TestMul;
  145. procedure TestPlus;
  146. procedure TestComma;
  147. procedure TestMinus;
  148. procedure TestDot;
  149. procedure TestDivision;
  150. procedure TestColon;
  151. procedure TestSemicolon;
  152. procedure TestLessThan;
  153. procedure TestEqual;
  154. procedure TestGreaterThan;
  155. procedure TestAt;
  156. procedure TestSquaredBraceOpen;
  157. procedure TestSquaredBraceClose;
  158. procedure TestCaret;
  159. procedure TestBackslash;
  160. procedure TestDotDot;
  161. procedure TestAssign;
  162. procedure TestAssignPlus;
  163. procedure TestAssignMinus;
  164. procedure TestAssignMul;
  165. procedure TestAssignDivision;
  166. procedure TestNotEqual;
  167. procedure TestLessEqualThan;
  168. procedure TestGreaterEqualThan;
  169. procedure TestPower;
  170. procedure TestSymmetricalDifference;
  171. procedure TestAbsolute;
  172. procedure TestAnd;
  173. procedure TestArray;
  174. procedure TestAs;
  175. procedure TestAsm;
  176. Procedure TestAsmComments;
  177. Procedure TestAsmConditionals;
  178. procedure TestBegin;
  179. procedure TestBitpacked;
  180. procedure TestCase;
  181. procedure TestClass;
  182. procedure TestConst;
  183. procedure TestConstructor;
  184. procedure TestDestructor;
  185. procedure TestDispinterface;
  186. procedure TestDiv;
  187. procedure TestDo;
  188. procedure TestDownto;
  189. procedure TestElse;
  190. procedure TestEnd;
  191. procedure TestExcept;
  192. procedure TestExports;
  193. procedure TestFalse;
  194. procedure TestFile;
  195. procedure TestFinalization;
  196. procedure TestFinally;
  197. procedure TestFor;
  198. procedure TestFunction;
  199. procedure TestGeneric;
  200. procedure TestGoto;
  201. Procedure TestHelper;
  202. procedure TestIf;
  203. procedure TestImplementation;
  204. procedure TestIn;
  205. procedure TestInherited;
  206. procedure TestInitialization;
  207. procedure TestInline;
  208. procedure TestInterface;
  209. procedure TestIs;
  210. procedure TestLabel;
  211. procedure TestLibrary;
  212. procedure TestMod;
  213. procedure TestNil;
  214. procedure TestNot;
  215. procedure TestObject;
  216. procedure TestOf;
  217. procedure TestOn;
  218. procedure TestOperator;
  219. procedure TestOr;
  220. procedure TestPacked;
  221. procedure TestProcedure;
  222. procedure TestProgram;
  223. procedure TestProperty;
  224. procedure TestRaise;
  225. procedure TestRecord;
  226. procedure TestRepeat;
  227. procedure TestResourceString;
  228. procedure TestSet;
  229. procedure TestShl;
  230. procedure TestShr;
  231. procedure TestShlC;
  232. procedure TestShrC;
  233. procedure TestSpecialize;
  234. procedure TestThen;
  235. procedure TestThreadvar;
  236. procedure TestTo;
  237. procedure TestTrue;
  238. procedure TestTry;
  239. procedure TestType;
  240. procedure TestUnit;
  241. procedure TestUntil;
  242. procedure TestUses;
  243. procedure TestVar;
  244. procedure TestWhile;
  245. procedure TestWith;
  246. procedure TestXor;
  247. procedure TestLineEnding;
  248. procedure TestObjCClass;
  249. procedure TestObjCClass2;
  250. procedure TestObjCProtocol;
  251. procedure TestObjCProtocol2;
  252. procedure TestObjCCategory;
  253. procedure TestObjCCategory2;
  254. procedure TestTab;
  255. Procedure TestEscapedKeyWord;
  256. Procedure TestTokenSeries;
  257. Procedure TestTokenSeriesNoWhiteSpace;
  258. Procedure TestTokenSeriesComments;
  259. Procedure TestTokenSeriesNoComments;
  260. Procedure TestDefine0;
  261. procedure TestDefine0Spaces;
  262. procedure TestDefine0Spaces2;
  263. procedure TestDefine01;
  264. Procedure TestDefine1;
  265. Procedure TestDefine2;
  266. Procedure TestDefine21;
  267. procedure TestDefine22;
  268. Procedure TestDefine3;
  269. Procedure TestDefine4;
  270. Procedure TestDefine5;
  271. Procedure TestDefine6;
  272. Procedure TestDefine7;
  273. Procedure TestDefine8;
  274. Procedure TestDefine9;
  275. Procedure TestDefine10;
  276. Procedure TestDefine11;
  277. Procedure TestDefine12;
  278. Procedure TestDefine13;
  279. Procedure TestDefine14;
  280. Procedure TestInclude;
  281. Procedure TestInclude2;
  282. Procedure TestInclude3;
  283. Procedure TestIncludeString;
  284. Procedure TestIncludeStringFile;
  285. Procedure TestIncludeString2Lines;
  286. Procedure TestUnDefine1;
  287. Procedure TestMacro1;
  288. procedure TestMacro2;
  289. procedure TestMacro3;
  290. procedure TestMacro4;
  291. procedure TestMacroHandling;
  292. procedure TestIFDefined;
  293. procedure TestIFUnDefined;
  294. procedure TestIFAnd;
  295. procedure TestIFAndShortEval;
  296. procedure TestIFOr;
  297. procedure TestIFOrShortEval;
  298. procedure TestIFXor;
  299. procedure TestIFAndOr;
  300. procedure TestIFEqual;
  301. procedure TestIFNotEqual;
  302. procedure TestIFGreaterThan;
  303. procedure TestIFGreaterEqualThan;
  304. procedure TestIFLesserThan;
  305. procedure TestIFLesserEqualThan;
  306. procedure TestIFDefinedElseIf;
  307. procedure TestIfError;
  308. procedure TestIFCDefined;
  309. procedure TestIFCNotDefined;
  310. procedure TestIFCAndDefined;
  311. procedure TestIFCFalse;
  312. Procedure TestModeSwitch;
  313. Procedure TestOperatorIdentifier;
  314. Procedure TestUTF8BOM;
  315. Procedure TestBooleanSwitch;
  316. Procedure TestLinkLibSimple;
  317. Procedure TestLinkLibAlias;
  318. Procedure TestLinkLibDefaultAlias;
  319. Procedure TestLinkLibDefaultAliasStrip;
  320. Procedure TestLinkLibOptions;
  321. end;
  322. implementation
  323. { TTestingPascalScanner }
  324. function TTestingPascalScanner.HandleMacro(AIndex: integer): TToken;
  325. begin
  326. if DoSpecial then
  327. begin
  328. Result:=tkIdentifier;
  329. SetCurTokenstring('somethingweird');
  330. end
  331. else
  332. Result:=inherited HandleMacro(AIndex);
  333. end;
  334. { TTestTokenFinder }
  335. procedure TTestTokenFinder.TestFind;
  336. Var
  337. tk,tkr : TToken;
  338. S : string;
  339. B : Boolean;
  340. begin
  341. For tk:=tkAbsolute to tkXor do
  342. begin
  343. S:=tokenInfos[tk];
  344. B:=IsNamedToken(S,tkr);
  345. AssertEquals('Token '+S+' is a token',true,B);
  346. AssertEquals('Token '+S+' returns correct token',Ord(tk),Ord(tkr));
  347. end;
  348. end;
  349. { TTestStreamLineReader }
  350. procedure TTestStreamLineReader.NewSource(Const Source: string);
  351. begin
  352. FReader:=TStringStreamLineReader.Create('afile',Source);
  353. end;
  354. procedure TTestStreamLineReader.TestLine(const ALine: String; ExpectEOF: Boolean);
  355. begin
  356. AssertNotNull('Have reader',FReader);
  357. AssertEquals('Reading source line',ALine,FReader.ReadLine);
  358. if ExpectEOF then
  359. AssertEquals('End of file reached',True,FReader.IsEOF);
  360. end;
  361. procedure TTestStreamLineReader.TearDown;
  362. begin
  363. inherited TearDown;
  364. If Assigned(FReader) then
  365. FreeAndNil(Freader);
  366. end;
  367. procedure TTestStreamLineReader.TestCreate;
  368. begin
  369. FReader:=TStreamLineReader.Create('afile');
  370. AssertEquals('Correct filename','afile',FReader.FileName);
  371. AssertEquals('Initially empty',True,FReader.isEOF);
  372. end;
  373. procedure TTestStreamLineReader.TestEOF;
  374. begin
  375. NewSource('');
  376. AssertEquals('Empty stream',True,FReader.IsEOF);
  377. end;
  378. procedure TTestStreamLineReader.TestEmptyLine;
  379. begin
  380. NewSource('');
  381. TestLine('');
  382. end;
  383. procedure TTestStreamLineReader.TestEmptyLineCR;
  384. begin
  385. NewSource(#13);
  386. TestLine('');
  387. end;
  388. procedure TTestStreamLineReader.TestEmptyLineLF;
  389. begin
  390. NewSource(#10);
  391. TestLine('');
  392. end;
  393. procedure TTestStreamLineReader.TestEmptyLineCRLF;
  394. begin
  395. NewSource(#13#10);
  396. TestLine('');
  397. end;
  398. procedure TTestStreamLineReader.TestEmptyLineLFCR;
  399. begin
  400. NewSource(#10#13);
  401. TestLine('',False);
  402. TestLine('');
  403. end;
  404. procedure TTestStreamLineReader.TestOneLine;
  405. Const
  406. S = 'a line with text';
  407. begin
  408. NewSource(S);
  409. TestLine(S);
  410. end;
  411. procedure TTestStreamLineReader.TestTwoLines;
  412. Const
  413. S = 'a line with text';
  414. begin
  415. NewSource(S+sLineBreak+S);
  416. TestLine(S,False);
  417. TestLine(S);
  418. end;
  419. { ---------------------------------------------------------------------
  420. TTestScanner
  421. ---------------------------------------------------------------------}
  422. procedure TTestScanner.DoComment(Sender: TObject; aComment: TPasScannerString);
  423. begin
  424. FDoCommentCalled:=True;
  425. FComment:=aComment;
  426. end;
  427. procedure TTestScanner.DoLinkLib(Sender: TObject; const aLibName, aAlias, aOptions: TPasScannerString; var aHandled: Boolean);
  428. begin
  429. FLibName:=aLibName;
  430. FLibAlias:=aAlias;
  431. FLibOptions:=aOptions;
  432. aHandled:=FLinkLibHandled;
  433. end;
  434. procedure TTestScanner.SetUp;
  435. begin
  436. FTestTokenString:='';
  437. FLibAlias:='';
  438. FLibName:='';
  439. FLibOptions:='';
  440. FLinkLibHandled:=False;
  441. FDoCommentCalled:=False;
  442. FResolver:=TStreamResolver.Create;
  443. FResolver.OwnsStreams:=True;
  444. FScanner:=TTestingPascalScanner.Create(FResolver);
  445. // Do nothing
  446. end;
  447. procedure TTestScanner.TearDown;
  448. begin
  449. FreeAndNil(FScanner);
  450. FreeAndNil(FResolver);
  451. end;
  452. procedure TTestScanner.DoMultilineError;
  453. begin
  454. TestToken(pscanner.tkString,'`A '#10'multiline string`');
  455. end;
  456. function TTestScanner.TokenToString(tk: TToken): string;
  457. begin
  458. Result:=GetEnumName(TypeInfo(TToken),Ord(tk));
  459. end;
  460. class function TTestScanner.CreateDelphiMultiLine(Lines: array of string; PrefixCount: Byte; Suffix: String = '';QuoteCount : Integer=3): string;
  461. Var
  462. Quotes,S,Prefix : String;
  463. begin
  464. Prefix:=StringOfChar(' ',PrefixCount);
  465. Quotes:=StringOfChar(SingleQuote,QuoteCount);
  466. Result:=Prefix+Quotes+sLineBreak;
  467. For S in Lines do
  468. Result:=Result+Prefix+S+sLineBreak;
  469. Result:=Result+Prefix+Quotes+Suffix+sLineBreak;
  470. end;
  471. procedure TTestScanner.AssertEquals(Msg: String; Expected, Actual: TToken);
  472. begin
  473. AssertEquals(Msg,TokenToString(Expected),TokenToString(Actual));
  474. end;
  475. procedure TTestScanner.AssertEquals(Msg: String; Expected, Actual: TModeSwitch);
  476. begin
  477. AssertEquals(Msg,GetEnumName(TypeInfo(TModeSwitch),Ord(Expected)),
  478. GetEnumName(TypeInfo(TModeSwitch),Ord(Actual)))
  479. end;
  480. procedure TTestScanner.AssertEquals(Msg: String; Expected, Actual: TModeSwitches);
  481. Function ToString(S : TModeSwitches) : String;
  482. Var
  483. M : TModeSwitch;
  484. begin
  485. Result:='';
  486. For M in TModeswitch do
  487. if M in S then
  488. begin
  489. If (Result<>'') then
  490. Result:=Result+', ';
  491. Result:=Result+GetEnumName(TypeInfo(TModeSwitch), Ord(M));
  492. end;
  493. end;
  494. begin
  495. AssertEquals(Msg,ToString(Expected),ToString(Actual));
  496. end;
  497. procedure TTestScanner.AssertEquals(Msg: String; Expected, Actual: TEOLStyle);
  498. begin
  499. AssertEquals(Msg,GetEnumName(TypeInfo(TEOLStyle),Ord(Expected)),
  500. GetEnumName(TypeInfo(TEOLStyle),Ord(Actual)))
  501. end;
  502. procedure TTestScanner.NewSource(const Source: RawBytestring; DoClear : Boolean = True);
  503. Const
  504. afilename : TPasTreeString = TPasTreeString('afile.pp');
  505. Var
  506. aFile : TPasTreeString;
  507. begin
  508. aFile:='';
  509. if DoClear then
  510. FResolver.Clear;
  511. if (FPathPrefix<>'') then
  512. aFile:=IncludeTrailingPathDelimiter(FPathPrefix);
  513. aFile:=aFile+aFileName;
  514. FResolver.AddStream(aFile,TStringStream.Create(Source));
  515. {$ifndef NOCONSOLE} // JC: To get the tests to run with GUI
  516. Writeln('// '+TestName);
  517. Writeln(Source);
  518. {$EndIf}
  519. // FreeAndNil(FScanner);
  520. // FScanner:=TTestingPascalScanner.Create(FResolver);
  521. FScanner.OpenFile(aFile);
  522. end;
  523. procedure TTestScanner.DoTestToken(t: TToken; const ASource: RawByteString;
  524. const CheckEOF: Boolean);
  525. Var
  526. tk : ttoken;
  527. begin
  528. NewSource(ASource);
  529. tk:=FScanner.FetchToken;
  530. AssertEquals('Read token equals expected token.',t,tk);
  531. FTestTokenString:=FScanner.CurTokenString;
  532. if CheckEOF then
  533. begin
  534. tk:=FScanner.FetchToken;
  535. if (tk=tkLineEnding) and not (t in [tkEOF,tkLineEnding]) then
  536. tk:=FScanner.FetchToken;
  537. AssertEquals('EOF reached.',tkEOF,FScanner.FetchToken);
  538. end;
  539. end;
  540. procedure TTestScanner.TestToken(t: TToken; const ASource: RawByteString;
  541. const CheckEOF: Boolean);
  542. Var
  543. S : String;
  544. begin
  545. DoTestToken(t,ASource);
  546. if (ASource<>'') then
  547. begin
  548. S:=ASource;
  549. S[1]:=Upcase(S[1]);
  550. DoTestToken(t,S);
  551. end;
  552. DoTestToken(t,UpperCase(ASource));
  553. DoTestToken(t,LowerCase(ASource),CheckEOF);
  554. end;
  555. procedure TTestScanner.TestTokens(t: array of TToken; const ASource: RawByteString;
  556. const CheckEOF: Boolean; const DoClear: Boolean);
  557. Var
  558. tk : ttoken;
  559. i : integer;
  560. begin
  561. NewSource(ASource,DoClear);
  562. For I:=Low(t) to High(t) do
  563. begin
  564. tk:=FScanner.FetchToken;
  565. AssertEquals(Format('Read token %d equals expected token.',[i]),t[i],tk);
  566. case tk of
  567. tkIdentifier:
  568. LastIdentifier:=FScanner.CurtokenString;
  569. tkString:
  570. fTestTokenString:=FScanner.CurTokenString;
  571. tkStringMultiLine:
  572. fTestTokenString:=FScanner.CurTokenString;
  573. end;
  574. end;
  575. if CheckEOF then
  576. begin
  577. tk:=FScanner.FetchToken;
  578. if (tk=tkLineEnding) then
  579. tk:=FScanner.FetchToken
  580. else if not (tk in [tkComment,tkEOF]) then
  581. AssertEquals('Wrong character, expected lineending.',tkLineEnding,tk);
  582. AssertEquals('EOF reached.',tkEOF,FScanner.FetchToken);
  583. end;
  584. end;
  585. procedure TTestScanner.TestEmpty;
  586. begin
  587. AssertNotNull('Have Scanner',Scanner);
  588. AssertTrue('Options is empty',[]=Scanner.Options);
  589. AssertEquals('FPC modes is default',FPCModeSwitches,Scanner.CurrentModeSwitches);
  590. end;
  591. procedure TTestScanner.TestEOF;
  592. begin
  593. TestToken(tkEOF,'')
  594. end;
  595. procedure TTestScanner.TestWhitespace;
  596. begin
  597. TestToken(tkWhitespace,' ');
  598. TestToken(tkWhitespace,' ');
  599. end;
  600. procedure TTestScanner.TestComment1;
  601. begin
  602. TestToken(tkComment,'{ comment }');
  603. end;
  604. procedure TTestScanner.TestComment2;
  605. begin
  606. TestToken(tkComment,'(* comment *)');
  607. end;
  608. procedure TTestScanner.TestComment3;
  609. begin
  610. TestToken(tkComment,'//');
  611. end;
  612. procedure TTestScanner.TestComment4;
  613. begin
  614. DoTestToken(tkComment,'(* abc *)',False);
  615. AssertEquals('Correct comment',' abc ',Scanner.CurTokenString);
  616. end;
  617. procedure TTestScanner.TestComment5;
  618. begin
  619. DoTestToken(tkComment,'(* abc'+LineEnding+'def *)',False);
  620. AssertEquals('Correct comment',' abc'+LineEnding+'def ',Scanner.CurTokenString);
  621. end;
  622. procedure TTestScanner.TestComment6;
  623. begin
  624. DoTestToken(tkComment,'{ abc }',False);
  625. AssertEquals('Correct comment',' abc ',Scanner.CurTokenString);
  626. end;
  627. procedure TTestScanner.TestComment7;
  628. begin
  629. DoTestToken(tkComment,'{ abc'+LineEnding+'def }',False);
  630. AssertEquals('Correct comment',' abc'+LineEnding+'def ',Scanner.CurTokenString);
  631. end;
  632. procedure TTestScanner.TestComment8;
  633. begin
  634. DoTestToken(tkComment,'// abc ',False);
  635. AssertEquals('Correct comment',' abc ',Scanner.CurTokenString);
  636. end;
  637. procedure TTestScanner.TestComment9;
  638. begin
  639. DoTestToken(tkComment,'// abc '+LineEnding,False);
  640. AssertEquals('Correct comment',' abc ',Scanner.CurTokenString);
  641. end;
  642. procedure TTestScanner.TestNestedComment1;
  643. begin
  644. TestToken(tkComment,'// { comment } ');
  645. end;
  646. procedure TTestScanner.TestNestedComment2;
  647. begin
  648. TestToken(tkComment,'(* { comment } *)');
  649. end;
  650. procedure TTestScanner.TestNestedComment3;
  651. begin
  652. TestToken(tkComment,'{ { comment } }');
  653. end;
  654. procedure TTestScanner.TestNestedComment4;
  655. begin
  656. TestToken(tkComment,'{ (* comment *) }');
  657. end;
  658. procedure TTestScanner.TestNestedComment5;
  659. begin
  660. TestToken(tkComment,'(* (* comment *) *)');
  661. end;
  662. procedure TTestScanner.TestonComment;
  663. begin
  664. FScanner.OnComment:=@DoComment;
  665. DoTestToken(tkComment,'(* abc *)',False);
  666. assertTrue('Comment called',FDoCommentCalled);
  667. AssertEquals('Correct comment',' abc ',Scanner.CurTokenString);
  668. AssertEquals('Correct comment token',' abc ',FComment);
  669. end;
  670. procedure TTestScanner.TestIdentifier;
  671. begin
  672. TestToken(tkIdentifier,'identifier');
  673. end;
  674. procedure TTestScanner.TestString;
  675. begin
  676. TestToken(pscanner.tkString,'''A string''');
  677. end;
  678. procedure TTestScanner.TestMultilineStringError;
  679. begin
  680. AssertException('Need modeswitch',EScannerError,@DoMultilineError);
  681. end;
  682. procedure TTestScanner.TestMultilineStringSource;
  683. const
  684. S = '''AB'#13#10'CD''';
  685. begin
  686. Scanner.CurrentModeSwitches:=[msMultiLineStrings];
  687. Scanner.MultilineStringsEOLStyle:=elSource;
  688. DoTestToken(pscanner.tkString,'`AB'#13#10'CD`');
  689. AssertEquals('Correct lineending',S,TestTokenString);
  690. end;
  691. procedure TTestScanner.TestMultilineStringLF;
  692. const
  693. S = '''AB'#10'CD''';
  694. begin
  695. Scanner.CurrentModeSwitches:=[msMultiLineStrings];
  696. Scanner.MultilineStringsEOLStyle:=elLF;
  697. DoTestToken(pscanner.tkString,'`AB'#13#10'CD`');
  698. AssertEquals('Correct lineending',S,TestTokenString);
  699. end;
  700. procedure TTestScanner.TestMultilineStringCR;
  701. const
  702. S = '''AB'#13'CD''';
  703. begin
  704. Scanner.CurrentModeSwitches:=[msMultiLineStrings];
  705. Scanner.MultilineStringsEOLStyle:=elCR;
  706. DoTestToken(pscanner.tkString,'`AB'#10'CD`');
  707. AssertEquals('Correct lineending',S,TestTokenString);
  708. end;
  709. procedure TTestScanner.TestMultilineStringCRLF;
  710. const
  711. S = '''AB'#13#10'CD''';
  712. begin
  713. Scanner.CurrentModeSwitches:=[msMultiLineStrings];
  714. Scanner.MultilineStringsEOLStyle:=elCRLF;
  715. DoTestToken(pscanner.tkString,'`AB'#10'CD`');
  716. AssertEquals('Correct lineending',S,TestTokenString);
  717. end;
  718. procedure TTestScanner.TestMultilineStringPlatform;
  719. const
  720. S = '''AB'+sLineBreak+'CD''';
  721. begin
  722. Scanner.CurrentModeSwitches:=[msMultiLineStrings];
  723. Scanner.MultilineStringsEOLStyle:=elPlatform;
  724. DoTestToken(pscanner.tkString,'`AB'#13#10'CD`');
  725. AssertEquals('Correct lineending',S,TestTokenString);
  726. end;
  727. procedure TTestScanner.TestMultilineStringDoubleBackticks;
  728. const
  729. S = '''AB`CD''';
  730. begin
  731. Scanner.CurrentModeSwitches:=[msMultiLineStrings];
  732. Scanner.MultilineStringsEOLStyle:=elSource;
  733. DoTestToken(pscanner.tkString,'`AB``CD`');
  734. AssertEquals('Correct lineending',S,TestTokenString);
  735. end;
  736. procedure TTestScanner.TestMultilineLineEndingDirective;
  737. begin
  738. AssertTrue('Default platform', FScanner.MultilineStringsEOLStyle=elPlatform);
  739. TestTokens([tkComment],'{$MULTILINESTRINGLINEENDING CR}');
  740. AssertTrue('CR', FScanner.MultilineStringsEOLStyle=elCR);
  741. TestTokens([tkComment],'{$MULTILINESTRINGLINEENDING LF}');
  742. AssertTrue('LF', FScanner.MultilineStringsEOLStyle=elLF);
  743. TestTokens([tkComment],'{$MULTILINESTRINGLINEENDING CRLF}');
  744. AssertTrue('CRLF', FScanner.MultilineStringsEOLStyle=elCRLF);
  745. TestTokens([tkComment],'{$MULTILINESTRINGLINEENDING SOURCE}');
  746. AssertTrue('SOURCE', FScanner.MultilineStringsEOLStyle=elSOURCE);
  747. TestTokens([tkComment],'{$MULTILINESTRINGLINEENDING PLATFORM}');
  748. AssertTrue('Platform', FScanner.MultilineStringsEOLStyle=elPlatform);
  749. end;
  750. procedure TTestScanner.TestMultilineTrimLeftDirective;
  751. begin
  752. AssertTrue('Default', FScanner.MultilineStringsTrimLeft=0);
  753. TestTokens([tkComment],'{$MULTILINESTRINGTRIMLEFT 1}');
  754. AssertTrue('1', FScanner.MultilineStringsTrimLeft=1);
  755. TestTokens([tkComment],'{$MULTILINESTRINGTRIMLEFT 2}');
  756. AssertTrue('2', FScanner.MultilineStringsTrimLeft=2);
  757. TestTokens([tkComment],'{$MULTILINESTRINGTRIMLEFT ALL}');
  758. AssertTrue('ALL', FScanner.MultilineStringsTrimLeft=-2);
  759. TestTokens([tkComment],'{$MULTILINESTRINGTRIMLEFT AUTO}');
  760. AssertTrue('AUTO', FScanner.MultilineStringsTrimLeft=-1);
  761. end;
  762. procedure TTestScanner.TestMultilineStringTrimAll;
  763. const
  764. S = '''AB'#10'CD''';
  765. begin
  766. SCanner.MultilineStringsTrimLeft:=-2;
  767. Scanner.CurrentModeSwitches:=[msMultiLineStrings];
  768. Scanner.MultilineStringsEOLStyle:=elLF;
  769. DoTestToken(pscanner.tkString,'`AB'#13#10' CD`');
  770. AssertEquals('Correct trim',S,TestTokenString);
  771. end;
  772. procedure TTestScanner.TestMultilineStringTrimAuto;
  773. const
  774. S = '''AB'#10' CD''';
  775. begin
  776. SCanner.MultilineStringsTrimLeft:=-1;
  777. Scanner.CurrentModeSwitches:=[msMultiLineStrings];
  778. Scanner.MultilineStringsEOLStyle:=elLF;
  779. Scanner.SkipWhiteSpace:=True;
  780. DoTestToken(pscanner.tkString,' `AB'#13#10' CD`');
  781. AssertEquals('Correct trim',S,TestTokenString);
  782. end;
  783. procedure TTestScanner.TestMultilineStringTrim2;
  784. const
  785. S = '''AB'#10' CD''';
  786. S2 = '''AB'#10'CD''';
  787. begin
  788. SCanner.MultilineStringsTrimLeft:=2;
  789. Scanner.CurrentModeSwitches:=[msMultiLineStrings];
  790. Scanner.MultilineStringsEOLStyle:=elLF;
  791. Scanner.SkipWhiteSpace:=True;
  792. DoTestToken(pscanner.tkString,' `AB'#13#10' CD`');
  793. AssertEquals('Correct trim',S,TestTokenString);
  794. DoTestToken(pscanner.tkString,' `AB'#13#10' CD`');
  795. AssertEquals('Correct trim 2',S2,TestTokenString);
  796. end;
  797. procedure TTestScanner.DoTestDelphiMultiLineString;
  798. begin
  799. TestTokens([pscanner.tkWhitespace,pscanner.tkStringMultiLine],FMultiLine);
  800. end;
  801. procedure TTestScanner.DoTestDelphiMultiLine;
  802. var
  803. S1,S2 : String;
  804. begin
  805. S1:='Line 1';
  806. S2:='Line 2';
  807. FMultiLine:=CreateDelphiMultiLine([S1,S2]);
  808. DoTestDelphiMultiLineString;
  809. end;
  810. procedure TTestScanner.TestDelphiMultiLineNotEnabled;
  811. begin
  812. AssertException('Must be enabled',EScannerError,@DoTestDelphiMultiLine);
  813. end;
  814. procedure TTestScanner.TestDelphiMultiLineWrongIndent;
  815. var
  816. Prefix,S1,S2 : String;
  817. begin
  818. S1:='Line 1';
  819. S2:='Line 2';
  820. Prefix:=' ';
  821. FMultiLine:=Prefix+TripleQuote+sLineBreak; // Line 1
  822. FMultiLine:=FMultiLine+Prefix+S1+sLineBreak; // Line 2
  823. FMultiLine:=FMultiLine+' '+S2+sLineBreak; // Line 3, 2 indent so error col is 2.
  824. FMultiLine:=FMultiLine+Prefix+TripleQuote+sLineBreak; // Line 4
  825. Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
  826. // We check the error message for the displayed line number and column.
  827. AssertException('Wrong indent',EScannerError,@DoTestDelphiMultiLineString,'afile.pp(3,2) Error: Inconsistent indent characters');
  828. end;
  829. procedure TTestScanner.TestDelphiMultiLineSpecial1;
  830. var
  831. S1,S2 : String;
  832. begin
  833. S1:='Line 1 ''#39';
  834. S2:='Line 2';
  835. FMultiLine:=CreateDelphiMultiLine([S1,S2]);
  836. Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
  837. DoTestDelphiMultiLineString;
  838. AssertEquals('Correct string',S1+sLineBreak+S2,TestTokenString);
  839. end;
  840. procedure TTestScanner.TestDelphiMultiLineSpecial2;
  841. var
  842. S1,S2 : String;
  843. begin
  844. S1:='Line 1 ''^A';
  845. S2:='Line 2';
  846. FMultiLine:=CreateDelphiMultiLine([S1,S2]);
  847. Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
  848. DoTestDelphiMultiLineString;
  849. AssertEquals('Correct string',S1+sLineBreak+S2,TestTokenString);
  850. end;
  851. procedure TTestScanner.TestDelphiMultiLineTrailingGarbage1;
  852. var
  853. S1,S2 : String;
  854. begin
  855. S1:='Line 1';
  856. S2:='Line 2';
  857. FMultiLine:=CreateDelphiMultiLine([S1,S2],2,SingleQuote);
  858. Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
  859. // test on actual error message, we need
  860. AssertException('Trailing garbage leads to error',EScannerError,@DoTestDelphiMultiLineString,'afile.pp(4,7) Error: string exceeds end of line');
  861. end;
  862. procedure TTestScanner.TestDelphiMultiLineTrailingGarbage2;
  863. var
  864. S1,S2 : String;
  865. begin
  866. S1:='Line 1 ';
  867. S2:='Line 2';
  868. FMultiLine:=CreateDelphiMultiLine([S1,S2],2,'^A');
  869. Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
  870. // EAssertionFailedError because the last token is a Dereferencing token
  871. AssertException('Trailing garbage leads to error',EAssertionFailedError,@DoTestDelphiMultiLineString,'"Wrong character, expected lineending." expected: <tkLineEnding> but was: <tkChar>');
  872. end;
  873. procedure TTestScanner.TestDelphiMultiLineTrailingGarbage3;
  874. var
  875. S1,S2 : String;
  876. begin
  877. S1:='Line 1 ';
  878. S2:='Line 2';
  879. FMultiLine:=CreateDelphiMultiLine([S1,S2],2,'#01');
  880. Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
  881. // EAssertionFailedError because the last token is a Dereferencing token
  882. AssertException('Trailing garbage leads to error',EAssertionFailedError,@DoTestDelphiMultiLineString,'"Wrong character, expected lineending." expected: <tkLineEnding> but was: <tkChar>');
  883. end;
  884. procedure TTestScanner.TestDelphiMultiLineTrailingPlusLit;
  885. var
  886. S1,S2 : String;
  887. begin
  888. S1:='Line 1 ';
  889. S2:='Line 2';
  890. FMultiLine:=CreateDelphiMultiLine([S1,S2],2,'+''abc'';');
  891. Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
  892. TestTokens([pscanner.tkWhitespace,pscanner.tkStringMultiLine,pscanner.tkPlus,pscanner.tkString,pscanner.tkSemicolon],FMultiLine);
  893. AssertEquals('Correct string','''abc''',TestTokenString);
  894. end;
  895. procedure TTestScanner.TestDelphiMultiLineEmbeddedQuotes;
  896. var
  897. S1,S2,S3 : String;
  898. begin
  899. S1:='Line 1 ';
  900. S2:='Line 2 '+TripleQuote;
  901. S3:='Line 2';
  902. FMultiLine:=CreateDelphiMultiLine([S1,S2,S3],2,'',5);
  903. Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
  904. DoTestDelphiMultiLineString;
  905. AssertEquals('Correct string',S1+sLineBreak+S2+sLineBreak+S3,TestTokenString);
  906. end;
  907. procedure TTestScanner.TestDelphiMultiLineInDelphiMode;
  908. var
  909. S1,S2 : String;
  910. begin
  911. S1:='Line 1';
  912. S2:='Line 2';
  913. FMultiLine:='{$mode delphi}'+sLineBreak+CreateDelphiMultiLine([S1,S2]);
  914. TestTokens([pscanner.tkComment, pscanner.tkLineEnding,pscanner.tkWhitespace,pscanner.tkStringMultiLine],FMultiLine);
  915. AssertEquals('Correct string',S1+sLineBreak+S2,TestTokenString);
  916. end;
  917. procedure TTestScanner.TestDelphiMultiLineFailNonWhiteSpaceBeforeClosing;
  918. var
  919. S1, S2: String;
  920. begin
  921. S1:='Line1';
  922. S2:='Line''''''''2';
  923. FMultiLine:=CreateDelphiMultiLine([S1,S2],2,'');
  924. Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
  925. AssertException('Non Whitespace chars before closing',EScannerError,@DoTestDelphiMultiLineString,'afile.pp(3,10) Error: '+SErrMultilineNonWhiteSpaceBeforeClosing);
  926. end;
  927. procedure TTestScanner.TestDelphiMultiLine;
  928. var
  929. S1,S2 : String;
  930. begin
  931. S1:='Line 1';
  932. S2:='Line 2';
  933. FMultiLine:=CreateDelphiMultiLine([S1,S2]);
  934. Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
  935. DoTestDelphiMultiLineString;
  936. AssertEquals('Correct string',S1+sLineBreak+S2,TestTokenString);
  937. end;
  938. procedure TTestScanner.TestCharString;
  939. begin
  940. TestToken(pscanner.tkChar,'''A''');
  941. end;
  942. procedure TTestScanner.TestCaretString;
  943. begin
  944. TestTokens([tkIdentifier,tkWhiteSpace,tkEqual,tkwhiteSpace,pscanner.tkString,tkSemicolon],'a = ^C''abc'';',false);
  945. end;
  946. procedure TTestScanner.TestNumber;
  947. begin
  948. TestToken(tkNumber,'123');
  949. end;
  950. procedure TTestScanner.TestChar;
  951. begin
  952. TestToken(pscanner.tkChar,'#65 ', false);
  953. end;
  954. procedure TTestScanner.TestBraceOpen;
  955. begin
  956. TestToken(tkBraceOpen,'(');
  957. end;
  958. procedure TTestScanner.TestBraceClose;
  959. begin
  960. TestToken(tkBraceClose,')');
  961. end;
  962. procedure TTestScanner.TestMul;
  963. begin
  964. TestToken(tkMul,'*');
  965. end;
  966. procedure TTestScanner.TestPlus;
  967. begin
  968. TestToken(tkPlus,'+');
  969. end;
  970. procedure TTestScanner.TestComma;
  971. begin
  972. TestToken(tkComma,',');
  973. end;
  974. procedure TTestScanner.TestMinus;
  975. begin
  976. TestToken(tkMinus,'-');
  977. end;
  978. procedure TTestScanner.TestDot;
  979. begin
  980. TestToken(tkDot,'.');
  981. end;
  982. procedure TTestScanner.TestDivision;
  983. begin
  984. TestToken(tkDivision,'/');
  985. end;
  986. procedure TTestScanner.TestColon;
  987. begin
  988. TestToken(tkColon,':');
  989. end;
  990. procedure TTestScanner.TestSemicolon;
  991. begin
  992. TestToken(tkSemicolon,';');
  993. end;
  994. procedure TTestScanner.TestLessThan;
  995. begin
  996. TestToken(tkLessThan,'<');
  997. end;
  998. procedure TTestScanner.TestEqual;
  999. begin
  1000. TestToken(tkEqual,'=');
  1001. end;
  1002. procedure TTestScanner.TestGreaterThan;
  1003. begin
  1004. TestToken(tkGreaterThan,'>');
  1005. end;
  1006. procedure TTestScanner.TestAt;
  1007. begin
  1008. TestToken(tkAt,'@');
  1009. end;
  1010. procedure TTestScanner.TestSquaredBraceOpen;
  1011. begin
  1012. TestToken(tkSquaredBraceOpen,'[');
  1013. TestToken(tkSquaredBraceOpen,'(.'); // JC: Test for the BraceDotOpen
  1014. end;
  1015. procedure TTestScanner.TestSquaredBraceClose;
  1016. begin
  1017. TestToken(tkSquaredBraceClose,']');
  1018. TestToken(tkSquaredBraceClose,'.)'); // JC: Test for the DotBraceClose
  1019. TestTokens([tkNumber,tkSquaredBraceClose],'1.)'); // JC: Test for a Number followed by DotBraceClose
  1020. end;
  1021. procedure TTestScanner.TestCaret;
  1022. begin
  1023. TestToken(tkCaret,'^');
  1024. end;
  1025. procedure TTestScanner.TestBackslash;
  1026. begin
  1027. TestToken(tkBackslash,'\');
  1028. end;
  1029. procedure TTestScanner.TestDotDot;
  1030. begin
  1031. TestToken(tkDotDot,'..');
  1032. end;
  1033. procedure TTestScanner.TestAssign;
  1034. begin
  1035. TestToken(tkAssign,':=');
  1036. end;
  1037. procedure TTestScanner.TestAssignPlus;
  1038. begin
  1039. TestTokens([tkPlus,tkEqual],'+=');
  1040. FScanner.Options:=[po_cassignments];
  1041. TestToken(tkAssignPlus,'+=');
  1042. end;
  1043. procedure TTestScanner.TestAssignMinus;
  1044. begin
  1045. TestTokens([tkMinus,tkEqual],'-=');
  1046. FScanner.Options:=[po_cassignments];
  1047. TestToken(tkAssignMinus,'-=');
  1048. end;
  1049. procedure TTestScanner.TestAssignMul;
  1050. begin
  1051. TestTokens([tkMul,tkEqual],'*=');
  1052. FScanner.Options:=[po_cassignments];
  1053. TestToken(tkAssignMul,'*=');
  1054. end;
  1055. procedure TTestScanner.TestAssignDivision;
  1056. begin
  1057. TestTokens([tkDivision,tkEqual],'/=');
  1058. FScanner.Options:=[po_cassignments];
  1059. TestToken(tkAssignDivision,'/=');
  1060. end;
  1061. procedure TTestScanner.TestNotEqual;
  1062. begin
  1063. TestToken(tkNotEqual,'<>');
  1064. end;
  1065. procedure TTestScanner.TestLessEqualThan;
  1066. begin
  1067. TestToken(tkLessEqualThan,'<=');
  1068. end;
  1069. procedure TTestScanner.TestGreaterEqualThan;
  1070. begin
  1071. TestToken(tkGreaterEqualThan,'>=');
  1072. end;
  1073. procedure TTestScanner.TestPower;
  1074. begin
  1075. TestToken(tkPower,'**');
  1076. end;
  1077. procedure TTestScanner.TestSymmetricalDifference;
  1078. begin
  1079. TestToken(tkSymmetricalDifference,'><');
  1080. end;
  1081. procedure TTestScanner.TestAbsolute;
  1082. begin
  1083. TestToken(tkabsolute,'absolute');
  1084. end;
  1085. procedure TTestScanner.TestAnd;
  1086. begin
  1087. TestToken(tkand,'and');
  1088. end;
  1089. procedure TTestScanner.TestArray;
  1090. begin
  1091. TestToken(tkarray,'array');
  1092. end;
  1093. procedure TTestScanner.TestAs;
  1094. begin
  1095. TestToken(tkas,'as');
  1096. end;
  1097. procedure TTestScanner.TestAsm;
  1098. begin
  1099. TestToken(tkasm,'asm');
  1100. end;
  1101. procedure TTestScanner.TestAsmComments;
  1102. begin
  1103. TestTokens([tkAsm,tkWhitespace,tkComment,tkLineEnding,tkEnd],'asm { something '+sLinebreak+' in comment }'+sLineBreak+'end');
  1104. end;
  1105. procedure TTestScanner.TestAsmConditionals;
  1106. begin
  1107. TestTokens([tkAsm,tkWhitespace,tkComment,tkLineEnding,tkEnd],'asm {$IFDEF SOMETHING}{ something '+sLinebreak+' in comment }{$ENDIF}'+sLineBreak+'end');
  1108. end;
  1109. procedure TTestScanner.TestBegin;
  1110. begin
  1111. TestToken(tkbegin,'begin');
  1112. end;
  1113. procedure TTestScanner.TestBitpacked;
  1114. begin
  1115. TestToken(tkbitpacked,'bitpacked');
  1116. end;
  1117. procedure TTestScanner.TestCase;
  1118. begin
  1119. TestToken(tkcase,'case');
  1120. end;
  1121. procedure TTestScanner.TestClass;
  1122. begin
  1123. TestToken(tkclass,'class');
  1124. end;
  1125. procedure TTestScanner.TestConst;
  1126. begin
  1127. TestToken(tkconst,'const');
  1128. end;
  1129. procedure TTestScanner.TestConstructor;
  1130. begin
  1131. TestToken(tkconstructor,'constructor');
  1132. end;
  1133. procedure TTestScanner.TestDestructor;
  1134. begin
  1135. TestToken(tkdestructor,'destructor');
  1136. end;
  1137. procedure TTestScanner.TestDispinterface;
  1138. begin
  1139. TestToken(tkdispinterface,'dispinterface');
  1140. end;
  1141. procedure TTestScanner.TestDiv;
  1142. begin
  1143. TestToken(tkdiv,'div');
  1144. end;
  1145. procedure TTestScanner.TestDo;
  1146. begin
  1147. TestToken(tkdo,'do');
  1148. end;
  1149. procedure TTestScanner.TestDownto;
  1150. begin
  1151. TestToken(tkdownto,'downto');
  1152. end;
  1153. procedure TTestScanner.TestElse;
  1154. begin
  1155. TestToken(tkelse,'else');
  1156. end;
  1157. procedure TTestScanner.TestEnd;
  1158. begin
  1159. TestToken(tkend,'end');
  1160. end;
  1161. procedure TTestScanner.TestExcept;
  1162. begin
  1163. TestToken(tkexcept,'except');
  1164. end;
  1165. procedure TTestScanner.TestExports;
  1166. begin
  1167. TestToken(tkexports,'exports');
  1168. end;
  1169. procedure TTestScanner.TestFalse;
  1170. begin
  1171. TestToken(tkfalse,'false');
  1172. end;
  1173. procedure TTestScanner.TestFile;
  1174. begin
  1175. TestToken(tkfile,'file');
  1176. end;
  1177. procedure TTestScanner.TestFinalization;
  1178. begin
  1179. TestToken(tkfinalization,'finalization');
  1180. end;
  1181. procedure TTestScanner.TestFinally;
  1182. begin
  1183. TestToken(tkfinally,'finally');
  1184. end;
  1185. procedure TTestScanner.TestFor;
  1186. begin
  1187. TestToken(tkfor,'for');
  1188. end;
  1189. procedure TTestScanner.TestFunction;
  1190. begin
  1191. TestToken(tkfunction,'function');
  1192. end;
  1193. procedure TTestScanner.TestGeneric;
  1194. begin
  1195. TestToken(tkgeneric,'generic');
  1196. end;
  1197. procedure TTestScanner.TestGoto;
  1198. begin
  1199. TestToken(tkgoto,'goto');
  1200. end;
  1201. procedure TTestScanner.TestHelper;
  1202. begin
  1203. TestToken(tkIdentifier,'helper');
  1204. end;
  1205. procedure TTestScanner.TestIf;
  1206. begin
  1207. TestToken(tkif,'if');
  1208. end;
  1209. procedure TTestScanner.TestImplementation;
  1210. begin
  1211. TestToken(tkimplementation,'implementation');
  1212. end;
  1213. procedure TTestScanner.TestIn;
  1214. begin
  1215. TestToken(tkin,'in');
  1216. end;
  1217. procedure TTestScanner.TestInherited;
  1218. begin
  1219. TestToken(tkinherited,'inherited');
  1220. end;
  1221. procedure TTestScanner.TestInitialization;
  1222. begin
  1223. TestToken(tkinitialization,'initialization');
  1224. end;
  1225. procedure TTestScanner.TestInline;
  1226. begin
  1227. TestToken(tkinline,'inline');
  1228. end;
  1229. procedure TTestScanner.TestInterface;
  1230. begin
  1231. TestToken(tkinterface,'interface');
  1232. end;
  1233. procedure TTestScanner.TestIs;
  1234. begin
  1235. TestToken(tkis,'is');
  1236. end;
  1237. procedure TTestScanner.TestLabel;
  1238. begin
  1239. TestToken(tklabel,'label');
  1240. end;
  1241. procedure TTestScanner.TestLibrary;
  1242. begin
  1243. TestToken(tklibrary,'library');
  1244. end;
  1245. procedure TTestScanner.TestMod;
  1246. begin
  1247. TestToken(tkmod,'mod');
  1248. end;
  1249. procedure TTestScanner.TestNil;
  1250. begin
  1251. TestToken(tknil,'nil');
  1252. end;
  1253. procedure TTestScanner.TestNot;
  1254. begin
  1255. TestToken(tknot,'not');
  1256. end;
  1257. procedure TTestScanner.TestObject;
  1258. begin
  1259. TestToken(tkobject,'object');
  1260. end;
  1261. procedure TTestScanner.TestOf;
  1262. begin
  1263. TestToken(tkof,'of');
  1264. end;
  1265. procedure TTestScanner.TestOn;
  1266. begin
  1267. TestToken(tkIdentifier,'on');
  1268. end;
  1269. procedure TTestScanner.TestOperator;
  1270. begin
  1271. Scanner.SetTokenOption(toOperatorToken);
  1272. TestToken(tkoperator,'operator');
  1273. end;
  1274. procedure TTestScanner.TestOr;
  1275. begin
  1276. TestToken(tkor,'or');
  1277. end;
  1278. procedure TTestScanner.TestPacked;
  1279. begin
  1280. TestToken(tkpacked,'packed');
  1281. end;
  1282. procedure TTestScanner.TestProcedure;
  1283. begin
  1284. TestToken(tkprocedure,'procedure');
  1285. end;
  1286. procedure TTestScanner.TestProgram;
  1287. begin
  1288. TestToken(tkprogram,'program');
  1289. end;
  1290. procedure TTestScanner.TestProperty;
  1291. begin
  1292. TestToken(tkproperty,'property');
  1293. end;
  1294. procedure TTestScanner.TestRaise;
  1295. begin
  1296. TestToken(tkraise,'raise');
  1297. end;
  1298. procedure TTestScanner.TestRecord;
  1299. begin
  1300. TestToken(tkrecord,'record');
  1301. end;
  1302. procedure TTestScanner.TestRepeat;
  1303. begin
  1304. TestToken(tkrepeat,'repeat');
  1305. end;
  1306. procedure TTestScanner.TestResourceString;
  1307. begin
  1308. TestToken(tkResourceString,'resourcestring');
  1309. end;
  1310. procedure TTestScanner.TestSelf;
  1311. begin
  1312. FScanner.Options:=FScanner.Options + [po_selftoken];
  1313. TestToken(tkself,'self');
  1314. end;
  1315. procedure TTestScanner.TestSelfNoToken;
  1316. begin
  1317. TestToken(tkIdentifier,'self');
  1318. end;
  1319. procedure TTestScanner.TestSet;
  1320. begin
  1321. TestToken(tkset,'set');
  1322. end;
  1323. procedure TTestScanner.TestShl;
  1324. begin
  1325. TestToken(tkshl,'shl');
  1326. end;
  1327. procedure TTestScanner.TestShr;
  1328. begin
  1329. TestToken(tkshr,'shr');
  1330. end;
  1331. procedure TTestScanner.TestShlC;
  1332. begin
  1333. TestToken(tkshl,'<<');
  1334. end;
  1335. procedure TTestScanner.TestShrC;
  1336. begin
  1337. TestToken(tkshr,'>>');
  1338. end;
  1339. procedure TTestScanner.TestSpecialize;
  1340. begin
  1341. TestToken(tkspecialize,'specialize');
  1342. end;
  1343. procedure TTestScanner.TestThen;
  1344. begin
  1345. TestToken(tkthen,'then');
  1346. end;
  1347. procedure TTestScanner.TestThreadvar;
  1348. begin
  1349. TestToken(tkthreadvar,'threadvar');
  1350. end;
  1351. procedure TTestScanner.TestTo;
  1352. begin
  1353. TestToken(tkto,'to');
  1354. end;
  1355. procedure TTestScanner.TestTrue;
  1356. begin
  1357. TestToken(tktrue,'true');
  1358. end;
  1359. procedure TTestScanner.TestTry;
  1360. begin
  1361. TestToken(tktry,'try');
  1362. end;
  1363. procedure TTestScanner.TestType;
  1364. begin
  1365. TestToken(tktype,'type');
  1366. end;
  1367. procedure TTestScanner.TestUnit;
  1368. begin
  1369. TestToken(tkunit,'unit');
  1370. end;
  1371. procedure TTestScanner.TestUntil;
  1372. begin
  1373. TestToken(tkuntil,'until');
  1374. end;
  1375. procedure TTestScanner.TestUses;
  1376. begin
  1377. TestToken(tkuses,'uses');
  1378. end;
  1379. procedure TTestScanner.TestVar;
  1380. begin
  1381. TestToken(tkvar,'var');
  1382. end;
  1383. procedure TTestScanner.TestWhile;
  1384. begin
  1385. TestToken(tkwhile,'while');
  1386. end;
  1387. procedure TTestScanner.TestWith;
  1388. begin
  1389. TestToken(tkwith,'with');
  1390. end;
  1391. procedure TTestScanner.TestXor;
  1392. begin
  1393. TestToken(tkxor,'xor');
  1394. end;
  1395. procedure TTestScanner.TestLineEnding;
  1396. begin
  1397. TestToken(tkLineEnding,#10);
  1398. end;
  1399. procedure TTestScanner.TestObjCClass;
  1400. begin
  1401. TestToken(tkObjCClass,'objcclass');
  1402. end;
  1403. procedure TTestScanner.TestObjCClass2;
  1404. begin
  1405. TestTokens([tkComment,tkWhitespace,tkidentifier],'{$mode fpc} objcclass');
  1406. end;
  1407. procedure TTestScanner.TestObjCProtocol;
  1408. begin
  1409. TestToken(tkObjCProtocol,'objcprotocol');
  1410. end;
  1411. procedure TTestScanner.TestObjCProtocol2;
  1412. begin
  1413. TestTokens([tkComment,tkWhitespace,tkidentifier],'{$mode fpc} objcprotocol');
  1414. end;
  1415. procedure TTestScanner.TestObjCCategory;
  1416. begin
  1417. TestToken(tkObjCCategory,'objccategory');
  1418. end;
  1419. procedure TTestScanner.TestObjCCategory2;
  1420. begin
  1421. TestTokens([tkComment,tkWhitespace,tkidentifier],'{$mode fpc} objccategory');
  1422. end;
  1423. procedure TTestScanner.TestTab;
  1424. begin
  1425. TestToken(tkTab,#9);
  1426. end;
  1427. procedure TTestScanner.TestEscapedKeyWord;
  1428. begin
  1429. TestToken(tkIdentifier,'&xor');
  1430. end;
  1431. procedure TTestScanner.TestTokenSeries;
  1432. begin
  1433. TestTokens([tkin,tkWhitespace,tkOf,tkWhiteSpace,tkthen,tkWhiteSpace,tkIdentifier],'in of then aninteger')
  1434. end;
  1435. procedure TTestScanner.TestTokenSeriesNoWhiteSpace;
  1436. begin
  1437. FScanner.SkipWhiteSpace:=True;
  1438. TestTokens([tkin,tkOf,tkthen,tkIdentifier],'in of then aninteger')
  1439. end;
  1440. procedure TTestScanner.TestTokenSeriesComments;
  1441. begin
  1442. TestTokens([tkin,tkWhitespace,tkOf,tkWhiteSpace,tkComment,tkWhiteSpace,tkIdentifier],'in of {then} aninteger')
  1443. end;
  1444. procedure TTestScanner.TestTokenSeriesNoComments;
  1445. begin
  1446. FScanner.SkipComments:=True;
  1447. TestTokens([tkin,tkWhitespace,tkOf,tkWhiteSpace,tkWhiteSpace,tkIdentifier],'in of {then} aninteger')
  1448. end;
  1449. procedure TTestScanner.TestDefine0;
  1450. begin
  1451. TestTokens([tkComment],'{$DEFINE NEVER}');
  1452. AssertTrue('Define not defined', FScanner.Defines.IndexOf('NEVER')<>-1);
  1453. end;
  1454. procedure TTestScanner.TestDefine0Spaces;
  1455. begin
  1456. TestTokens([tkComment],'{$DEFINE NEVER}');
  1457. AssertTrue('Define not defined',FScanner.Defines.IndexOf('NEVER')<>-1);
  1458. end;
  1459. procedure TTestScanner.TestDefine0Spaces2;
  1460. begin
  1461. TestTokens([tkComment],'{$DEFINE NEVER }');
  1462. AssertTrue('Define not defined',FScanner.Defines.IndexOf('NEVER')<>-1);
  1463. end;
  1464. procedure TTestScanner.TestDefine01;
  1465. begin
  1466. TestTokens([tkComment],'(*$DEFINE NEVER*)');
  1467. AssertTrue('Define not defined',FScanner.Defines.IndexOf('NEVER')<>-1);
  1468. end;
  1469. procedure TTestScanner.TestDefine1;
  1470. begin
  1471. TestTokens([tkComment],'{$IFDEF NEVER} of {$ENDIF}');
  1472. end;
  1473. procedure TTestScanner.TestDefine2;
  1474. begin
  1475. FScanner.Defines.Add('ALWAYS');
  1476. TestTokens([tkComment,tkWhitespace,tkOf,tkWhitespace,tkcomment],'{$IFDEF ALWAYS comment} of {$ENDIF}');
  1477. end;
  1478. procedure TTestScanner.TestDefine21;
  1479. begin
  1480. FScanner.Defines.Add('ALWAYS');
  1481. TestTokens([tkComment,tkWhitespace,tkOf,tkWhitespace,tkcomment],'(*$IFDEF ALWAYS*) of (*$ENDIF*)');
  1482. end;
  1483. procedure TTestScanner.TestDefine22;
  1484. begin
  1485. FScanner.Defines.Add('ALWAYS');
  1486. // No whitespace. Test border of *)
  1487. TestTokens([tkComment,tkOf,tkWhitespace,tkcomment],'(*$IFDEF ALWAYS*)of (*$ENDIF*)');
  1488. end;
  1489. procedure TTestScanner.TestDefine3;
  1490. begin
  1491. FScanner.Defines.Add('ALWAYS');
  1492. TestTokens([tkComment,tkWhitespace,tkOf,tkWhitespace,tkcomment],'{$IFDEF ALWAYS} of {$ELSE} in {$ENDIF}');
  1493. end;
  1494. procedure TTestScanner.TestDefine4;
  1495. begin
  1496. TestTokens([tkComment,tkWhitespace,tkin,tkWhitespace,tkcomment],'{$IFDEF ALWAYS} of {$ELSE} in {$ENDIF}');
  1497. end;
  1498. procedure TTestScanner.TestDefine5;
  1499. begin
  1500. FScanner.SkipComments:=True;
  1501. TestTokens([tkLineEnding],'{$IFDEF NEVER} of {$ENDIF}');
  1502. end;
  1503. procedure TTestScanner.TestDefine6;
  1504. begin
  1505. FScanner.Defines.Add('ALWAYS');
  1506. FScanner.SkipComments:=True;
  1507. TestTokens([tkWhitespace,tkOf,tkWhitespace],'{$IFDEF ALWAYS} of {$ENDIF}');
  1508. end;
  1509. procedure TTestScanner.TestDefine7;
  1510. begin
  1511. FScanner.Defines.Add('ALWAYS');
  1512. FScanner.SkipComments:=True;
  1513. TestTokens([tkWhitespace,tkOf,tkWhitespace],'{$IFDEF ALWAYS} of {$ELSE} in {$ENDIF}');
  1514. end;
  1515. procedure TTestScanner.TestDefine8;
  1516. begin
  1517. FScanner.SkipComments:=True;
  1518. TestTokens([tkWhitespace,tkin,tkWhitespace],'{$IFDEF ALWAYS} of {$ELSE} in {$ENDIF}');
  1519. end;
  1520. procedure TTestScanner.TestDefine9;
  1521. begin
  1522. FScanner.SkipWhiteSpace:=True;
  1523. TestTokens([],'{$IFDEF NEVER} of {$ENDIF}');
  1524. end;
  1525. procedure TTestScanner.TestDefine10;
  1526. begin
  1527. FScanner.Defines.Add('ALWAYS');
  1528. FScanner.SkipComments:=True;
  1529. TestTokens([tkWhitespace,tkOf,tkWhitespace],'{$IFDEF ALWAYS} of {$ENDIF}');
  1530. end;
  1531. procedure TTestScanner.TestDefine11;
  1532. begin
  1533. FScanner.Defines.Add('ALWAYS');
  1534. FScanner.SkipComments:=True;
  1535. FScanner.SkipWhiteSpace:=True;
  1536. TestTokens([tkOf],'{$IFDEF ALWAYS} of {$ELSE} in {$ENDIF}');
  1537. end;
  1538. procedure TTestScanner.TestDefine12;
  1539. begin
  1540. FScanner.SkipComments:=True;
  1541. FScanner.SkipWhiteSpace:=True;
  1542. TestTokens([tkin],'{$IFDEF ALWAYS} of {$ELSE} in {$ENDIF}');
  1543. end;
  1544. procedure TTestScanner.TestDefine13;
  1545. begin
  1546. FScanner.SkipComments:=True;
  1547. FScanner.SkipWhiteSpace:=True;
  1548. TestTokens([tkin],'{$IFDEF ALWAYS} }; ą è {$ELSE} in {$ENDIF}');
  1549. end;
  1550. procedure TTestScanner.TestDefine14;
  1551. Const
  1552. Source = '{$ifdef NEVER_DEFINED}' +sLineBreak+
  1553. 'type'+sLineBreak+
  1554. ' TNPEventModel = ('+sLineBreak+
  1555. ' NPEventModelCarbon = 0,'+sLineBreak+
  1556. ' NPEventModelCocoa = 1'+sLineBreak+
  1557. '}; // yes, this is an error... except this code should never be included.'+sLineBreak+
  1558. 'ą'+sLineBreak+
  1559. '|'+sLineBreak+
  1560. '{$endif}'+sLineBreak+
  1561. ''+sLineBreak+
  1562. 'begin'+sLineBreak+
  1563. 'end.'+sLineBreak;
  1564. begin
  1565. NewSource(Source,True);
  1566. While FScanner.fetchToken<>tkEOF do
  1567. end;
  1568. procedure TTestScanner.TestInclude;
  1569. begin
  1570. FResolver.AddStream('myinclude.inc',TStringStream.Create('if true then'));
  1571. FScanner.SkipWhiteSpace:=True;
  1572. FScanner.SkipComments:=True;
  1573. TestTokens([tkIf,tkTrue,tkThen],'{$I myinclude.inc}',True,False);
  1574. end;
  1575. procedure TTestScanner.TestInclude2;
  1576. begin
  1577. FResolver.AddStream('myinclude.inc',TStringStream.Create('if true then'));
  1578. FScanner.SkipWhiteSpace:=True;
  1579. FScanner.SkipComments:=True;
  1580. TestTokens([tkIf,tkTrue,tkThen,tkElse],'{$I myinclude.inc} else',True,False);
  1581. end;
  1582. procedure TTestScanner.TestInclude3;
  1583. begin
  1584. PathPrefix:='src';
  1585. FResolver.AddStream('src/myinclude2.inc',TStringStream.Create(' true '));
  1586. FResolver.AddStream('src/myinclude1.inc',TStringStream.Create('if {$i myinclude2.inc} then '));
  1587. FScanner.SkipWhiteSpace:=True;
  1588. FScanner.SkipComments:=True;
  1589. TestTokens([tkIf,tkTrue,tkThen,tkElse],'{$I src/myinclude1.inc} else',True,False);
  1590. end;
  1591. procedure TTestScanner.TestIncludeString;
  1592. begin
  1593. FResolver.AddStream('myinclude.inc',TStringStream.Create('if true then'));
  1594. FScanner.SkipWhiteSpace:=True;
  1595. FScanner.SkipComments:=True;
  1596. TestTokens([tkString],'{$INCLUDESTRING myinclude.inc}',False,False);
  1597. AssertEquals('Correct string','''if true then''',TestTokenString)
  1598. end;
  1599. procedure TTestScanner.TestIncludeStringFile;
  1600. begin
  1601. FResolver.AddStream('myinclude.inc',TStringStream.Create('if true then'));
  1602. FScanner.SkipWhiteSpace:=True;
  1603. FScanner.SkipComments:=True;
  1604. TestTokens([tkString],'{$INCLUDESTRINGFILE myinclude.inc}',False,False);
  1605. AssertEquals('Correct string','''if true then''',TestTokenString)
  1606. end;
  1607. procedure TTestScanner.TestIncludeString2Lines;
  1608. begin
  1609. FResolver.AddStream('myinclude.inc',TStringStream.Create('if true then'#10'else'));
  1610. FScanner.SkipWhiteSpace:=True;
  1611. FScanner.SkipComments:=True;
  1612. FScanner.MultilineStringsEOLStyle:=elCRLF;
  1613. TestTokens([tkString],'{$INCLUDESTRING myinclude.inc}',False,False);
  1614. AssertEquals('Correct string','''if true then'#13#10'else''',TestTokenString)
  1615. end;
  1616. procedure TTestScanner.TestUnDefine1;
  1617. begin
  1618. FScanner.Defines.Add('ALWAYS');
  1619. TestTokens([tkComment],'{$UNDEF ALWAYS}');
  1620. AssertEquals('No more define',-1,FScanner.Defines.INdexOf('ALWAYS'));
  1621. end;
  1622. procedure TTestScanner.TestMacro1;
  1623. begin
  1624. FScanner.SkipWhiteSpace:=True;
  1625. FScanner.SkipComments:=True;
  1626. TestTokens([tkbegin,tkend,tkDot],'{$MACRO on}{$DEFINE MM:=begin end.}'#13#10'MM',True,False);
  1627. end;
  1628. procedure TTestScanner.TestMacro2;
  1629. begin
  1630. FScanner.SkipWhiteSpace:=True;
  1631. FScanner.SkipComments:=True;
  1632. TestTokens([tkbegin,tkend,tkDot],'{$MACRO on}{$DEFINE MM:=begin end}'#13#10'MM .',True,False);
  1633. end;
  1634. procedure TTestScanner.TestMacro3;
  1635. begin
  1636. FScanner.SkipComments:=True;
  1637. FScanner.SkipWhiteSpace:=True;
  1638. TestTokens([tkof],'{$MACRO on}{$DEFINE MM:=begin end}'#13#10'{$IFDEF MM} of {$ELSE} in {$ENDIF}');
  1639. end;
  1640. procedure TTestScanner.TestMacro4;
  1641. begin
  1642. FScanner.SkipComments:=True;
  1643. FScanner.SkipWhiteSpace:=True;
  1644. TestTokens([tkIdentifier],'{$MACRO on}{$DEFINE MM:=Solo}'#13#10'MM',False);
  1645. AssertEquals('Token case preserved','Solo',FScanner.CurTokenString);
  1646. end;
  1647. procedure TTestScanner.TestMacroHandling;
  1648. begin
  1649. TTestingPascalScanner(FScanner).DoSpecial:=True;
  1650. FScanner.SkipComments:=True;
  1651. FScanner.SkipWhiteSpace:=True;
  1652. TestTokens([tkIdentifier],'{$MACRO on}{$DEFINE MM:=begin end}'#13#10'MM');
  1653. AssertEQuals('Correct identifier', 'somethingweird',LastIdentifier);
  1654. end;
  1655. procedure TTestScanner.TestIFDefined;
  1656. begin
  1657. FScanner.SkipWhiteSpace:=True;
  1658. FScanner.SkipComments:=True;
  1659. TestTokens([tkbegin,tkend,tkDot],'{$DEFINE A}{$IF defined(A)}begin{$ENDIF}end.',True,False);
  1660. end;
  1661. procedure TTestScanner.TestIFUnDefined;
  1662. begin
  1663. FScanner.SkipWhiteSpace:=True;
  1664. FScanner.SkipComments:=True;
  1665. TestTokens([tkbegin,tkend,tkDot],'{$IF undefined(A)}begin{$ENDIF}end.',True,False);
  1666. end;
  1667. procedure TTestScanner.TestIFAnd;
  1668. begin
  1669. FScanner.SkipWhiteSpace:=True;
  1670. FScanner.SkipComments:=True;
  1671. TestTokens([tkbegin,tkend,tkDot],
  1672. '{$DEFINE A}{$IF defined(A) and undefined(B)}begin{$ENDIF}end.',True,False);
  1673. end;
  1674. procedure TTestScanner.TestIFAndShortEval;
  1675. begin
  1676. FScanner.SkipWhiteSpace:=True;
  1677. FScanner.SkipComments:=True;
  1678. TestTokens([tkbegin,tkend,tkDot],
  1679. '{$UNDEFINE A}{$IF defined(A) and undefined(B)}wrong{$ELSE}begin{$ENDIF}end.',
  1680. True,False);
  1681. end;
  1682. procedure TTestScanner.TestIFOr;
  1683. begin
  1684. FScanner.SkipWhiteSpace:=True;
  1685. FScanner.SkipComments:=True;
  1686. TestTokens([tkbegin,tkend,tkDot],
  1687. '{$DEFINE B}{$IF defined(A) or defined(B)}begin{$ENDIF}end.',True,False);
  1688. end;
  1689. procedure TTestScanner.TestIFOrShortEval;
  1690. begin
  1691. FScanner.SkipWhiteSpace:=True;
  1692. FScanner.SkipComments:=True;
  1693. TestTokens([tkbegin,tkend,tkDot],
  1694. '{$DEFINE A}{$IF defined(A) or defined(B)}begin{$ENDIF}end.',True,False);
  1695. end;
  1696. procedure TTestScanner.TestIFXor;
  1697. begin
  1698. FScanner.SkipWhiteSpace:=True;
  1699. FScanner.SkipComments:=True;
  1700. TestTokens([tkbegin,tkend,tkDot],
  1701. '{$DEFINE B}{$IF defined(A) xor defined(B)}begin{$ENDIF}end.',True,False);
  1702. end;
  1703. procedure TTestScanner.TestIFAndOr;
  1704. begin
  1705. FScanner.SkipWhiteSpace:=True;
  1706. FScanner.SkipComments:=True;
  1707. TestTokens([tkbegin,tkend,tkDot],
  1708. '{$IF defined(A) and defined(B) or defined(C)}wrong1{$ENDIF}'+LineEnding
  1709. +'{$IF defined(A) and defined(B) or undefined(C)}{$ELSE}wrong2{$ENDIF}'+LineEnding
  1710. +'{$IF defined(A) and undefined(B) or defined(C)}wrong3{$ENDIF}'+LineEnding
  1711. +'{$IF defined(A) and undefined(B) or undefined(C)}{$ELSE}wrong4{$ENDIF}'+LineEnding
  1712. +'{$IF undefined(A) and defined(B) or defined(C)}wrong5{$ENDIF}'+LineEnding
  1713. +'{$IF undefined(A) and defined(B) or undefined(C)}{$ELSE}wrong6{$ENDIF}'+LineEnding
  1714. +'{$IF undefined(A) and undefined(B) or defined(C)}{$ELSE}wrong7{$ENDIF}'+LineEnding
  1715. +'{$IF undefined(A) and undefined(B) or undefined(C)}begin{$ENDIF}end.',
  1716. True,False);
  1717. end;
  1718. procedure TTestScanner.TestIFEqual;
  1719. begin
  1720. FScanner.SkipWhiteSpace:=True;
  1721. FScanner.SkipComments:=True;
  1722. FScanner.AddMacro('Version','30101');
  1723. TestTokens([tkbegin,tkend,tkDot],
  1724. '{$IF Version=30101}begin{$ENDIF}end.',True,False);
  1725. end;
  1726. procedure TTestScanner.TestIFNotEqual;
  1727. begin
  1728. FScanner.SkipWhiteSpace:=True;
  1729. FScanner.SkipComments:=True;
  1730. FScanner.AddMacro('Version','30101');
  1731. TestTokens([tkbegin,tkend,tkDot],
  1732. '{$IF Version<>30000}begin{$ENDIF}end.',True,False);
  1733. end;
  1734. procedure TTestScanner.TestIFGreaterThan;
  1735. begin
  1736. FScanner.SkipWhiteSpace:=True;
  1737. FScanner.SkipComments:=True;
  1738. FScanner.AddMacro('Version','30101');
  1739. TestTokens([tkbegin,tkend,tkDot],
  1740. '{$IF Version>30000}begin{$ENDIF}end.',True,False);
  1741. end;
  1742. procedure TTestScanner.TestIFGreaterEqualThan;
  1743. begin
  1744. FScanner.SkipWhiteSpace:=True;
  1745. FScanner.SkipComments:=True;
  1746. FScanner.AddMacro('Version','30101');
  1747. TestTokens([tkbegin,tkend,tkDot],
  1748. '{$IF Version>=30000}begin{$ENDIF}end.',True,False);
  1749. end;
  1750. procedure TTestScanner.TestIFLesserThan;
  1751. begin
  1752. FScanner.SkipWhiteSpace:=True;
  1753. FScanner.SkipComments:=True;
  1754. FScanner.AddMacro('Version','30101');
  1755. TestTokens([tkbegin,tkend,tkDot],
  1756. '{$IF Version<40000}begin{$ENDIF}end.',True,False);
  1757. end;
  1758. procedure TTestScanner.TestIFLesserEqualThan;
  1759. begin
  1760. FScanner.SkipWhiteSpace:=True;
  1761. FScanner.SkipComments:=True;
  1762. FScanner.AddMacro('Version','30101');
  1763. TestTokens([tkbegin,tkend,tkDot],
  1764. '{$IF Version<=30101}begin{$ENDIF}end.',True,False);
  1765. end;
  1766. procedure TTestScanner.TestIFDefinedElseIf;
  1767. begin
  1768. FScanner.SkipWhiteSpace:=True;
  1769. FScanner.SkipComments:=True;
  1770. FScanner.AddDefine('cpu32');
  1771. TestTokens([tkconst,tkIdentifier,tkEqual,tkString,tkSemicolon,tkbegin,tkend,tkDot],
  1772. 'const platform = '+LineEnding
  1773. +'{$if defined(cpu32)} ''x86'''+LineEnding
  1774. +'{$elseif defined(cpu64)} ''x64'''+LineEnding
  1775. +'{$else} {$error unknown platform} {$endif};'+LineEnding
  1776. +'begin end.',True,False);
  1777. end;
  1778. procedure TTestScanner.TestIfError;
  1779. begin
  1780. FScanner.SkipWhiteSpace:=True;
  1781. FScanner.SkipComments:=True;
  1782. TestTokens([tkprogram,tkIdentifier,tkSemicolon,tkbegin,tkend,tkDot],
  1783. 'program Project1;'+LineEnding
  1784. +'begin'+LineEnding
  1785. +'{$if sizeof(integer) <> 4} {$error wrong sizeof(integer)} {$endif}'+LineEnding
  1786. +'end.',True,False);
  1787. end;
  1788. procedure TTestScanner.TestIFCDefined;
  1789. begin
  1790. FScanner.SkipWhiteSpace:=True;
  1791. FScanner.SkipComments:=True;
  1792. FScanner.AddDefine('cpu32');
  1793. TestTokens([tkconst,tkIdentifier,tkEqual,tkString,tkSemicolon,tkbegin,tkend,tkDot],
  1794. 'const platform = '+LineEnding
  1795. +'{$ifc defined cpu32} ''x86'''+LineEnding
  1796. +'{$elseif defined(cpu64)} 1 '+LineEnding
  1797. +'{$else} {$error unknown platform} {$endc};'+LineEnding
  1798. +'begin end.',True,False);
  1799. end;
  1800. procedure TTestScanner.TestIFCNotDefined;
  1801. begin
  1802. FScanner.SkipWhiteSpace:=True;
  1803. FScanner.SkipComments:=True;
  1804. FScanner.AddDefine('cpu32');
  1805. TestTokens([tkconst,tkIdentifier,tkEqual,tkNumber,tkSemicolon,tkbegin,tkend,tkDot],
  1806. 'const platform = '+LineEnding
  1807. +'{$ifc not defined cpu32} ''x86'''+LineEnding
  1808. +'{$else} 1 '+LineEnding
  1809. +'{$endc};'+LineEnding
  1810. +'begin end.',True,False);
  1811. end;
  1812. procedure TTestScanner.TestIFCAndDefined;
  1813. begin
  1814. FScanner.SkipWhiteSpace:=True;
  1815. FScanner.SkipComments:=True;
  1816. FScanner.AddDefine('cpu32');
  1817. FScanner.AddDefine('alpha');
  1818. TestTokens([tkconst,tkIdentifier,tkEqual,tkstring,tkSemicolon,tkbegin,tkend,tkDot],
  1819. 'const platform = '+LineEnding
  1820. +'{$ifc defined cpu32 and defined alpha} ''x86'''+LineEnding
  1821. +'{$else} 1 '+LineEnding
  1822. +'{$endc};'+LineEnding
  1823. +'begin end.',True,False);
  1824. end;
  1825. procedure TTestScanner.TestIFCFalse;
  1826. begin
  1827. FScanner.SkipWhiteSpace:=True;
  1828. FScanner.SkipComments:=True;
  1829. FScanner.AddDefine('cpu32');
  1830. FScanner.AddDefine('alpha');
  1831. FScanner.AddMacro('MY','FALSE');
  1832. TestTokens([tkconst,tkIdentifier,tkEqual,tkNumber,tkSemicolon,tkbegin,tkend,tkDot],
  1833. 'const platform = '+LineEnding
  1834. +'{$IFC MY} ''x86'''+LineEnding
  1835. +'{$else} 1 '+LineEnding
  1836. +'{$endc};'+LineEnding
  1837. +'begin end.',True,False);
  1838. end;
  1839. procedure TTestScanner.TestModeSwitch;
  1840. Const
  1841. PlusMinus = [' ','+','-'];
  1842. Var
  1843. M : TModeSwitch;
  1844. C : AnsiChar;
  1845. begin
  1846. For M in TModeSwitch do
  1847. for C in PlusMinus do
  1848. if SModeSwitchNames[M]<>'' then
  1849. begin
  1850. Scanner.CurrentModeSwitches:=[];
  1851. NewSource('{$MODESWITCH '+SModeSwitchNames[M]+C+'}');
  1852. While not (Scanner.FetchToken=tkEOF) do;
  1853. if C in [' ','+'] then
  1854. AssertTrue(SModeSwitchNames[M]+C+' sets '+GetEnumName(TypeInfo(TModeSwitch),Ord(M)),M in Scanner.CurrentModeSwitches)
  1855. else
  1856. AssertFalse(SModeSwitchNames[M]+C+' removes '+GetEnumName(TypeInfo(TModeSwitch),Ord(M)),M in Scanner.CurrentModeSwitches);
  1857. end;
  1858. end;
  1859. procedure TTestScanner.TestOperatorIdentifier;
  1860. begin
  1861. Scanner.SetNonToken(tkoperator);
  1862. TestToken(tkidentifier,'operator',True);
  1863. end;
  1864. procedure TTestScanner.TestUTF8BOM;
  1865. begin
  1866. DoTestToken(tkLineEnding,#$EF+#$BB+#$BF);
  1867. end;
  1868. procedure TTestScanner.TestBooleanSwitch;
  1869. begin
  1870. Scanner.CurrentBoolSwitches:=[bsHints];
  1871. // end space intentional.
  1872. NewSource('{$HINTS OFF }');
  1873. While not (Scanner.FetchToken=tkEOF) do;
  1874. AssertFalse('Hints off',bshints in Scanner.CurrentBoolSwitches);
  1875. end;
  1876. procedure TTestScanner.TestLinkLibSimple;
  1877. begin
  1878. FScanner.OnLinkLib:=@DoLinkLib;
  1879. // DoTestToken because we don't want to change casing
  1880. DoTestToken(tkComment,'{$LINKLIB myfile.js}');
  1881. AssertEquals('Library name','myfile.js',LibName);
  1882. AssertEquals('Library alias','myfile',LibAlias);
  1883. AssertEquals('Library options','',LibOptions);
  1884. end;
  1885. procedure TTestScanner.TestLinkLibAlias;
  1886. begin
  1887. FScanner.OnLinkLib:=@DoLinkLib;
  1888. // DoTestToken because we don't want to change casing
  1889. DoTestToken(tkComment,'{$LINKLIB myfile.js MyLib}');
  1890. AssertEquals('Library name','myfile.js',LibName);
  1891. AssertEquals('Library alias','MyLib',LibAlias);
  1892. AssertEquals('Library options','',LibOptions);
  1893. end;
  1894. procedure TTestScanner.TestLinkLibDefaultAlias;
  1895. begin
  1896. FScanner.OnLinkLib:=@DoLinkLib;
  1897. // DoTestToken because we don't want to change casing
  1898. DoTestToken(tkComment,'{$LINKLIB my-file.min.js}');
  1899. AssertEquals('Library name','my-file.min.js',LibName);
  1900. AssertEquals('Library alias','my_file_min',LibAlias);
  1901. AssertEquals('Library options','',LibOptions);
  1902. end;
  1903. procedure TTestScanner.TestLinkLibDefaultAliasStrip;
  1904. begin
  1905. FScanner.OnLinkLib:=@DoLinkLib;
  1906. // DoTestToken because we don't want to change casing
  1907. DoTestToken(tkComment,'{$LINKLIB ../solong/my-file.min.js}');
  1908. AssertEquals('Library name','../solong/my-file.min.js',LibName);
  1909. AssertEquals('Library alias','my_file_min',LibAlias);
  1910. AssertEquals('Library options','',LibOptions);
  1911. end;
  1912. procedure TTestScanner.TestLinkLibOptions;
  1913. begin
  1914. FScanner.OnLinkLib:=@DoLinkLib;
  1915. // DoTestToken because we don't want to change casing
  1916. DoTestToken(tkComment,'{$LINKLIB ../solong/my-file.min.js MyFile opt1, opt2 }');
  1917. AssertEquals('Library name','../solong/my-file.min.js',LibName);
  1918. AssertEquals('Library alias','MyFile',LibAlias);
  1919. AssertEquals('Library options','opt1, opt2',LibOptions);
  1920. end;
  1921. procedure TTestScanner.TestTextBlockDirective;
  1922. begin
  1923. DoTestToken(tkComment,'{$TEXTBLOCK LF}');
  1924. AssertEquals('Correct EOL style',elLF,Scanner.MultilineStringsEOLStyle);
  1925. DoTestToken(tkComment,'{$TEXTBLOCK CRLF}');
  1926. AssertEquals('Correct EOL style',elCRLF,Scanner.MultilineStringsEOLStyle);
  1927. DoTestToken(tkComment,'{$TEXTBLOCK CR}');
  1928. AssertEquals('Correct EOL style',elCR,Scanner.MultilineStringsEOLStyle);
  1929. DoTestToken(tkComment,'{$TEXTBLOCK NATIVE}');
  1930. AssertEquals('Correct EOL style',elPlatform,Scanner.MultilineStringsEOLStyle);
  1931. // Ident allowed after...
  1932. DoTestToken(tkComment,'{$TEXTBLOCK NATIVE XYZ}');
  1933. AssertEquals('Correct EOL style',elPlatform,Scanner.MultilineStringsEOLStyle);
  1934. end;
  1935. initialization
  1936. RegisterTests([TTestTokenFinder,TTestStreamLineReader,TTestScanner]);
  1937. end.