tcstatements.pas 76 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121
  1. {
  2. Examples:
  3. ./testpassrc --suite=TTestStatementParser.TestCallQualified2
  4. }
  5. unit tcstatements;
  6. {$mode objfpc}{$H+}
  7. interface
  8. uses
  9. Classes, SysUtils, fpcunit, pastree, pscanner, pparser,
  10. tcbaseparser, testregistry;
  11. Type
  12. { TTestStatementParser }
  13. TTestStatementParser = Class(TTestParser)
  14. private
  15. FStatement: TPasImplBlock;
  16. FVariables : TStrings;
  17. procedure DoTestCallOtherFormat;
  18. procedure TestCallFormat(FN: String; AddPrecision: Boolean; AddSecondParam: boolean = false);
  19. Protected
  20. Procedure SetUp; override;
  21. Procedure TearDown; override;
  22. procedure AddStatements(ASource : Array of string);
  23. Procedure DeclareVar(Const AVarType : String; Const AVarName : String = 'A');
  24. function TestStatement(ASource : string) : TPasImplElement;
  25. function TestStatement(ASource : Array of string) : TPasImplElement;
  26. Procedure ExpectParserError(Const Msg : string);
  27. Procedure ExpectParserError(Const Msg : string; ASource : Array of string);
  28. Function AssertStatement(Msg : String; AClass : TClass;AIndex : Integer = 0) : TPasImplBlock;
  29. Property Statement: TPasImplBlock Read FStatement;
  30. Published
  31. Procedure TestEmpty;
  32. Procedure TestEmptyStatement;
  33. Procedure TestEmptyStatements;
  34. Procedure TestBlock;
  35. Procedure TestBlockComment;
  36. Procedure TestBlock2Comments;
  37. Procedure TestAssignment;
  38. Procedure TestAssignmentAdd;
  39. Procedure TestAssignmentMinus;
  40. Procedure TestAssignmentMul;
  41. Procedure TestAssignmentDivision;
  42. Procedure TestAssignmentMissingSemicolonError;
  43. Procedure TestCall;
  44. Procedure TestCallComment;
  45. Procedure TestCallQualified;
  46. Procedure TestCallQualified2;
  47. Procedure TestCallNoArgs;
  48. Procedure TestCallOneArg;
  49. procedure TestCallWriteFormat1;
  50. procedure TestCallWriteFormat2;
  51. procedure TestCallWriteFormat3;
  52. procedure TestCallWriteFormat4;
  53. procedure TestCallWritelnFormat1;
  54. procedure TestCallWritelnFormat2;
  55. procedure TestCallStrFormat1;
  56. procedure TestCallStrFormat2;
  57. procedure TestCallOtherFormat;
  58. Procedure TestIf;
  59. Procedure TestIfBlock;
  60. Procedure TestIfAssignment;
  61. Procedure TestIfElse;
  62. Procedure TestIfElseBlock;
  63. Procedure TestIfSemiColonElseError;
  64. procedure TestIfforElseBlock;
  65. procedure TestIfRaiseElseBlock;
  66. procedure TestIfGotoElseBlock;
  67. procedure TestIfWithBlock;
  68. Procedure TestNestedIf;
  69. Procedure TestNestedIfElse;
  70. Procedure TestNestedIfElseElse;
  71. procedure TestIfIfElseElseBlock;
  72. Procedure TestWhile;
  73. Procedure TestWhileBlock;
  74. Procedure TestWhileNested;
  75. Procedure TestRepeat;
  76. Procedure TestRepeatBlock;
  77. procedure TestRepeatBlockNosemicolon;
  78. Procedure TestRepeatNested;
  79. Procedure TestFor;
  80. Procedure TestForVarDef;
  81. Procedure TestForVarDefImplicit;
  82. Procedure TestForIn;
  83. Procedure TestForInDef;
  84. Procedure TestForInDefImplicit;
  85. Procedure TestForExpr;
  86. Procedure TestForBlock;
  87. procedure TestDowntoBlock;
  88. Procedure TestForNested;
  89. Procedure TestWith;
  90. Procedure TestWithMultiple;
  91. Procedure TestCaseEmpty;
  92. Procedure TestCaseOneInteger;
  93. Procedure TestCaseTwoIntegers;
  94. Procedure TestCaseRange;
  95. Procedure TestCaseRangeSeparate;
  96. Procedure TestCase2Cases;
  97. Procedure TestCaseBlock;
  98. Procedure TestCaseElseBlockEmpty;
  99. procedure TestCaseOtherwiseBlockEmpty;
  100. Procedure TestCaseElseBlockAssignment;
  101. Procedure TestCaseElseBlock2Assignments;
  102. Procedure TestCaseIfCaseElse;
  103. Procedure TestCaseIfCaseElseElse;
  104. Procedure TestCaseIfElse;
  105. Procedure TestCaseElseNoSemicolon;
  106. Procedure TestCaseIfElseNoSemicolon;
  107. procedure TestCaseIfOtherwiseNoSemicolon;
  108. Procedure TestRaise;
  109. Procedure TestRaiseEmpty;
  110. Procedure TestRaiseAt;
  111. Procedure TestGoto;
  112. Procedure TestTryFinally;
  113. Procedure TestTryFinallyEmpty;
  114. Procedure TestTryFinallyNested;
  115. procedure TestTryExcept;
  116. procedure TestTryExceptNested;
  117. procedure TestTryExceptEmpty;
  118. Procedure TestTryExceptOn;
  119. Procedure TestTryExceptOn2;
  120. Procedure TestTryExceptOnElse;
  121. Procedure TestTryExceptOnIfElse;
  122. Procedure TestTryExceptOnElseNoSemicolo;
  123. procedure TestTryExceptRaise;
  124. Procedure TestAsm;
  125. Procedure TestAsmBlock;
  126. Procedure TestAsmBlockWithEndLabel;
  127. Procedure TestAsmBlockInIfThen;
  128. Procedure TestGotoInIfThen;
  129. procedure TestAssignToAddress;
  130. procedure TestFinalizationNoSemicolon;
  131. procedure TestMacroComment;
  132. Procedure TestPlatformIdentifier;
  133. Procedure TestPlatformIdentifier2;
  134. Procedure TestArgumentNameOn;
  135. Procedure TestInlineVarDeclaration;
  136. Procedure TestInlineVarDeclarationDotted;
  137. Procedure TestInlineVarDeclarationNoType;
  138. end;
  139. implementation
  140. { TTestStatementParser }
  141. procedure TTestStatementParser.SetUp;
  142. begin
  143. inherited SetUp;
  144. FVariables:=TStringList.Create;
  145. end;
  146. procedure TTestStatementParser.TearDown;
  147. begin
  148. FreeAndNil(FVariables);
  149. inherited TearDown;
  150. end;
  151. procedure TTestStatementParser.AddStatements(ASource: array of string);
  152. Var
  153. I :Integer;
  154. begin
  155. StartProgram(ExtractFileUnitName(MainFilename));
  156. if FVariables.Count>0 then
  157. begin
  158. Add('Var');
  159. For I:=0 to FVariables.Count-1 do
  160. Add(' '+Fvariables[I]);
  161. end;
  162. Add('begin');
  163. For I:=Low(ASource) to High(ASource) do
  164. Add(' '+ASource[i]);
  165. end;
  166. procedure TTestStatementParser.DeclareVar(const AVarType: String;
  167. const AVarName: String);
  168. begin
  169. FVariables.Add(AVarName+' : '+AVarType+';');
  170. end;
  171. function TTestStatementParser.TestStatement(ASource: string): TPasImplElement;
  172. begin
  173. Result:=TestStatement([ASource]);
  174. end;
  175. function TTestStatementParser.TestStatement(ASource: array of string
  176. ): TPasImplElement;
  177. begin
  178. Result:=Nil;
  179. FStatement:=Nil;
  180. AddStatements(ASource);
  181. ParseModule;
  182. AssertEquals('Have program',TPasProgram,Module.ClassType);
  183. AssertNotNull('Have program section',PasProgram.ProgramSection);
  184. AssertNotNull('Have initialization section',PasProgram.InitializationSection);
  185. if (PasProgram.InitializationSection.Elements.Count>0) then
  186. if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then
  187. FStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
  188. Result:=FStatement;
  189. end;
  190. procedure TTestStatementParser.ExpectParserError(const Msg: string);
  191. begin
  192. AssertException(Msg,EParserError,@ParseModule);
  193. end;
  194. procedure TTestStatementParser.ExpectParserError(const Msg: string;
  195. ASource: array of string);
  196. begin
  197. AddStatements(ASource);
  198. ExpectParserError(Msg);
  199. end;
  200. function TTestStatementParser.AssertStatement(Msg: String; AClass: TClass;
  201. AIndex: Integer): TPasImplBlock;
  202. begin
  203. if not (AIndex<PasProgram.InitializationSection.Elements.Count) then
  204. Fail(Msg+': No such statement : '+intTostr(AIndex));
  205. AssertNotNull(Msg+' Have statement',PasProgram.InitializationSection.Elements[AIndex]);
  206. AssertEquals(Msg+' statement class',AClass,TObject(PasProgram.InitializationSection.Elements[AIndex]).ClassType);
  207. Result:=TObject(PasProgram.InitializationSection.Elements[AIndex]) as TPasImplBlock;
  208. end;
  209. procedure TTestStatementParser.TestEmpty;
  210. begin
  211. //TestStatement(';');
  212. TestStatement('');
  213. AssertEquals('No statements',0,PasProgram.InitializationSection.Elements.Count);
  214. end;
  215. procedure TTestStatementParser.TestEmptyStatement;
  216. begin
  217. TestStatement(';');
  218. AssertEquals('0 statement',0,PasProgram.InitializationSection.Elements.Count);
  219. end;
  220. procedure TTestStatementParser.TestEmptyStatements;
  221. begin
  222. TestStatement(';;');
  223. AssertEquals('0 statement',0,PasProgram.InitializationSection.Elements.Count);
  224. end;
  225. procedure TTestStatementParser.TestBlock;
  226. Var
  227. B : TPasImplBeginBlock;
  228. begin
  229. TestStatement(['begin','end']);
  230. AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
  231. AssertNotNull('Statement assigned',PasProgram.InitializationSection.Elements[0]);
  232. AssertEquals('Block statement',TPasImplBeginBlock,Statement.ClassType);
  233. B:= Statement as TPasImplBeginBlock;
  234. AssertEquals('Empty block',0,B.Elements.Count);
  235. end;
  236. procedure TTestStatementParser.TestBlockComment;
  237. Var
  238. B : TPasImplBeginBlock;
  239. begin
  240. Engine.NeedComments:=True;
  241. TestStatement(['{ This is a comment }','begin','end']);
  242. AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
  243. AssertNotNull('Statement assigned',PasProgram.InitializationSection.Elements[0]);
  244. AssertEquals('Block statement',TPasImplBeginBlock,Statement.ClassType);
  245. B:= Statement as TPasImplBeginBlock;
  246. AssertEquals('Empty block',0,B.Elements.Count);
  247. AssertEquals('No DocComment','',B.DocComment);
  248. end;
  249. procedure TTestStatementParser.TestBlock2Comments;
  250. Var
  251. B : TPasImplBeginBlock;
  252. begin
  253. Engine.NeedComments:=True;
  254. TestStatement(['{ This is a comment }','// Another comment','begin','end']);
  255. AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
  256. AssertNotNull('Statement assigned',PasProgram.InitializationSection.Elements[0]);
  257. AssertEquals('Block statement',TPasImplBeginBlock,Statement.ClassType);
  258. B:= Statement as TPasImplBeginBlock;
  259. AssertEquals('Empty block',0,B.Elements.Count);
  260. AssertEquals('No DocComment','',B.DocComment);
  261. end;
  262. procedure TTestStatementParser.TestAssignment;
  263. Var
  264. A : TPasImplAssign;
  265. begin
  266. DeclareVar('integer');
  267. TestStatement(['a:=1;']);
  268. AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
  269. AssertEquals('Assignment statement',TPasImplAssign,Statement.ClassType);
  270. A:=Statement as TPasImplAssign;
  271. AssertEquals('Normal assignment',akDefault,A.Kind);
  272. AssertExpression('Right side is constant',A.Right,pekNumber,'1');
  273. AssertExpression('Left side is variable',A.Left,pekIdent,'a');
  274. end;
  275. procedure TTestStatementParser.TestAssignmentAdd;
  276. Var
  277. A : TPasImplAssign;
  278. begin
  279. Parser.Scanner.Options:=[po_cassignments];
  280. DeclareVar('integer');
  281. TestStatement(['a+=1;']);
  282. AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
  283. AssertEquals('Assignment statement',TPasImplAssign,Statement.ClassType);
  284. A:=Statement as TPasImplAssign;
  285. AssertEquals('Add assignment',akAdd,A.Kind);
  286. AssertExpression('Right side is constant',A.Right,pekNumber,'1');
  287. AssertExpression('Left side is variable',A.Left,pekIdent,'a');
  288. end;
  289. procedure TTestStatementParser.TestAssignmentMinus;
  290. Var
  291. A : TPasImplAssign;
  292. begin
  293. Parser.Scanner.Options:=[po_cassignments];
  294. DeclareVar('integer');
  295. TestStatement(['a-=1;']);
  296. AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
  297. AssertEquals('Assignment statement',TPasImplAssign,Statement.ClassType);
  298. A:=Statement as TPasImplAssign;
  299. AssertEquals('Minus assignment',akMinus,A.Kind);
  300. AssertExpression('Right side is constant',A.Right,pekNumber,'1');
  301. AssertExpression('Left side is variable',A.Left,pekIdent,'a');
  302. end;
  303. procedure TTestStatementParser.TestAssignmentMul;
  304. Var
  305. A : TPasImplAssign;
  306. begin
  307. Parser.Scanner.Options:=[po_cassignments];
  308. DeclareVar('integer');
  309. TestStatement(['a*=1;']);
  310. AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
  311. AssertEquals('Assignment statement',TPasImplAssign,Statement.ClassType);
  312. A:=Statement as TPasImplAssign;
  313. AssertEquals('Mul assignment',akMul,A.Kind);
  314. AssertExpression('Right side is constant',A.Right,pekNumber,'1');
  315. AssertExpression('Left side is variable',A.Left,pekIdent,'a');
  316. end;
  317. procedure TTestStatementParser.TestAssignmentDivision;
  318. Var
  319. A : TPasImplAssign;
  320. begin
  321. Parser.Scanner.Options:=[po_cassignments];
  322. DeclareVar('integer');
  323. TestStatement(['a/=1;']);
  324. AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
  325. AssertEquals('Assignment statement',TPasImplAssign,Statement.ClassType);
  326. A:=Statement as TPasImplAssign;
  327. AssertEquals('Division assignment',akDivision,A.Kind);
  328. AssertExpression('Right side is constant',A.Right,pekNumber,'1');
  329. AssertExpression('Left side is variable',A.Left,pekIdent,'a');
  330. end;
  331. procedure TTestStatementParser.TestAssignmentMissingSemicolonError;
  332. begin
  333. DeclareVar('integer');
  334. ExpectParserError('Semicolon expected, but "a" found',['a:=1','a:=2']);
  335. end;
  336. procedure TTestStatementParser.TestCall;
  337. Var
  338. S : TPasImplSimple;
  339. begin
  340. TestStatement('Doit;');
  341. AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
  342. AssertEquals('Simple statement',TPasImplSimple,Statement.ClassType);
  343. S:=Statement as TPasImplSimple;
  344. AssertExpression('Doit call',S.Expr,pekIdent,'Doit');
  345. end;
  346. procedure TTestStatementParser.TestCallComment;
  347. Var
  348. S : TPasImplSimple;
  349. begin
  350. Engine.NeedComments:=True;
  351. TestStatement(['//comment line','Doit;']);
  352. AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
  353. AssertEquals('Simple statement',TPasImplSimple,Statement.ClassType);
  354. AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
  355. S:=Statement as TPasImplSimple;
  356. AssertExpression('Doit call',S.Expr,pekIdent,'Doit');
  357. AssertEquals('No DocComment','',S.DocComment);
  358. end;
  359. procedure TTestStatementParser.TestCallQualified;
  360. Var
  361. S : TPasImplSimple;
  362. B : TBinaryExpr;
  363. begin
  364. TestStatement('Unita.Doit;');
  365. AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
  366. AssertEquals('Simple statement',TPasImplSimple,Statement.ClassType);
  367. S:=Statement as TPasImplSimple;
  368. AssertExpression('Doit call',S.Expr,pekBinary,TBinaryExpr);
  369. B:=S.Expr as TBinaryExpr;
  370. TAssert.AssertSame('B.left.Parent=B',B,B.Left.Parent);
  371. TAssert.AssertSame('B.right.Parent=B',B,B.Right.Parent);
  372. AssertExpression('Unit name',B.Left,pekIdent,'Unita');
  373. AssertExpression('Doit call',B.Right,pekIdent,'Doit');
  374. end;
  375. procedure TTestStatementParser.TestCallQualified2;
  376. Var
  377. S : TPasImplSimple;
  378. B : TBinaryExpr;
  379. begin
  380. TestStatement('Unita.ClassB.Doit;');
  381. AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
  382. AssertEquals('Simple statement',TPasImplSimple,Statement.ClassType);
  383. S:=Statement as TPasImplSimple;
  384. AssertExpression('Doit call',S.Expr,pekBinary,TBinaryExpr);
  385. B:=S.Expr as TBinaryExpr;
  386. AssertExpression('Doit call',B.Right,pekIdent,'Doit');
  387. AssertExpression('First two parts of unit name',B.Left,pekBinary,TBinaryExpr);
  388. B:=B.Left as TBinaryExpr;
  389. AssertExpression('Unit name part 1',B.Left,pekIdent,'Unita');
  390. AssertExpression('Unit name part 2',B.Right,pekIdent,'ClassB');
  391. end;
  392. procedure TTestStatementParser.TestCallNoArgs;
  393. Var
  394. S : TPasImplSimple;
  395. P : TParamsExpr;
  396. begin
  397. TestStatement('Doit();');
  398. AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
  399. AssertEquals('Simple statement',TPasImplSimple,Statement.ClassType);
  400. S:=Statement as TPasImplSimple;
  401. AssertExpression('Doit call',S.Expr,pekFuncParams,TParamsExpr);
  402. P:=S.Expr as TParamsExpr;
  403. AssertExpression('Correct function call name',P.Value,pekIdent,'Doit');
  404. AssertEquals('No params',0,Length(P.Params));
  405. end;
  406. procedure TTestStatementParser.TestCallOneArg;
  407. Var
  408. S : TPasImplSimple;
  409. P : TParamsExpr;
  410. begin
  411. TestStatement('Doit(1);');
  412. AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
  413. AssertEquals('Simple statement',TPasImplSimple,Statement.ClassType);
  414. S:=Statement as TPasImplSimple;
  415. AssertExpression('Doit call',S.Expr,pekFuncParams,TParamsExpr);
  416. P:=S.Expr as TParamsExpr;
  417. AssertExpression('Correct function call name',P.Value,pekIdent,'Doit');
  418. AssertEquals('One param',1,Length(P.Params));
  419. AssertExpression('Parameter is constant',P.Params[0],pekNumber,'1');
  420. end;
  421. procedure TTestStatementParser.TestCallFormat(FN: String;
  422. AddPrecision: Boolean; AddSecondParam: boolean);
  423. var
  424. P : TParamsExpr;
  425. procedure CheckParam(Index: integer; const aParamName: string);
  426. begin
  427. AssertExpression('Parameter['+IntToStr(Index)+'] is identifier',P.Params[Index],pekIdent,aParamName);
  428. AssertExpression('Parameter['+IntToStr(Index)+'] has formatting constant 1' ,P.Params[Index].Format1,pekNumber,'3');
  429. if AddPrecision then
  430. AssertExpression('Parameter['+IntToStr(Index)+'] has formatting constant 2',P.Params[Index].Format2,pekNumber,'2');
  431. end;
  432. Var
  433. S : TPasImplSimple;
  434. N : String;
  435. ArgCnt: Integer;
  436. begin
  437. N:=fn+'(a:3';
  438. if AddPrecision then
  439. N:=N+':2';
  440. ArgCnt:=1;
  441. if AddSecondParam then
  442. begin
  443. ArgCnt:=2;
  444. N:=N+',b:3';
  445. if AddPrecision then
  446. N:=N+':2';
  447. end;
  448. N:=N+');';
  449. TestStatement(N);
  450. AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
  451. AssertEquals('Simple statement',TPasImplSimple,Statement.ClassType);
  452. S:=Statement as TPasImplSimple;
  453. AssertExpression('Doit call',S.Expr,pekFuncParams,TParamsExpr);
  454. P:=S.Expr as TParamsExpr;
  455. AssertExpression('Correct function call name',P.Value,pekIdent,FN);
  456. AssertEquals(IntToStr(ArgCnt)+' param',ArgCnt,Length(P.Params));
  457. CheckParam(0,'a');
  458. if AddSecondParam then
  459. CheckParam(1,'b');
  460. end;
  461. procedure TTestStatementParser.TestCallWriteFormat1;
  462. begin
  463. TestCallFormat('write',False);
  464. end;
  465. procedure TTestStatementParser.TestCallWriteFormat2;
  466. begin
  467. TestCallFormat('write',True);
  468. end;
  469. procedure TTestStatementParser.TestCallWriteFormat3;
  470. begin
  471. TestCallFormat('write',false,true);
  472. end;
  473. procedure TTestStatementParser.TestCallWriteFormat4;
  474. begin
  475. TestCallFormat('write',true,true);
  476. end;
  477. procedure TTestStatementParser.TestCallWritelnFormat1;
  478. begin
  479. TestCallFormat('writeln',False);
  480. end;
  481. procedure TTestStatementParser.TestCallWritelnFormat2;
  482. begin
  483. TestCallFormat('writeln',True);
  484. end;
  485. procedure TTestStatementParser.TestCallStrFormat1;
  486. begin
  487. TestCallFormat('str',False);
  488. end;
  489. procedure TTestStatementParser.TestCallStrFormat2;
  490. begin
  491. TestCallFormat('str',True);
  492. end;
  493. procedure TTestStatementParser.DoTestCallOtherFormat;
  494. begin
  495. TestCallFormat('nono',False);
  496. end;
  497. procedure TTestStatementParser.TestCallOtherFormat;
  498. begin
  499. AssertException('Only Write(ln) and str allow format',EParserError,@DoTestCallOtherFormat);
  500. end;
  501. procedure TTestStatementParser.TestIf;
  502. Var
  503. I : TPasImplIfElse;
  504. begin
  505. DeclareVar('boolean');
  506. TestStatement(['if a then',';']);
  507. I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
  508. AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
  509. AssertNull('No else',i.ElseBranch);
  510. AssertNull('No if branch',I.IfBranch);
  511. end;
  512. procedure TTestStatementParser.TestIfBlock;
  513. Var
  514. I : TPasImplIfElse;
  515. begin
  516. DeclareVar('boolean');
  517. TestStatement(['if a then',' begin',' end']);
  518. I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
  519. AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
  520. AssertNull('No else',i.ElseBranch);
  521. AssertNotNull('if branch',I.IfBranch);
  522. AssertEquals('begin end block',TPasImplBeginBlock,I.ifBranch.ClassType);
  523. end;
  524. procedure TTestStatementParser.TestIfAssignment;
  525. Var
  526. I : TPasImplIfElse;
  527. begin
  528. DeclareVar('boolean');
  529. TestStatement(['if a then',' a:=False;']);
  530. I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
  531. AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
  532. AssertNull('No else',i.ElseBranch);
  533. AssertNotNull('if branch',I.IfBranch);
  534. AssertEquals('assignment statement',TPasImplAssign,I.ifBranch.ClassType);
  535. end;
  536. procedure TTestStatementParser.TestIfElse;
  537. Var
  538. I : TPasImplIfElse;
  539. begin
  540. DeclareVar('boolean');
  541. TestStatement(['if a then',' begin',' end','else',';']);
  542. I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
  543. AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
  544. AssertNull('No else',i.ElseBranch);
  545. AssertNotNull('if branch',I.IfBranch);
  546. AssertEquals('begin end block',TPasImplBeginBlock,I.ifBranch.ClassType);
  547. end;
  548. procedure TTestStatementParser.TestIfElseBlock;
  549. Var
  550. I : TPasImplIfElse;
  551. begin
  552. DeclareVar('boolean');
  553. TestStatement(['if a then',' begin',' end','else',' begin',' end']);
  554. I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
  555. AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
  556. AssertNotNull('if branch',I.IfBranch);
  557. AssertEquals('begin end block',TPasImplBeginBlock,I.ifBranch.ClassType);
  558. AssertNotNull('Else branch',i.ElseBranch);
  559. AssertEquals('begin end block',TPasImplBeginBlock,I.ElseBranch.ClassType);
  560. end;
  561. procedure TTestStatementParser.TestIfforElseBlock;
  562. Var
  563. I : TPasImplIfElse;
  564. begin
  565. TestStatement(['if a then','for X := 1 downto 0 do Writeln(X)','else', 'for X := 0 to 1 do Writeln(X)']);
  566. I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
  567. AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
  568. AssertEquals('For statement',TPasImplForLoop,I.ifBranch.ClassType);
  569. AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
  570. end;
  571. procedure TTestStatementParser.TestIfRaiseElseBlock;
  572. Var
  573. I : TPasImplIfElse;
  574. begin
  575. TestStatement(['if a then','raise','else', 'for X := 0 to 1 do Writeln(X)']);
  576. I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
  577. AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
  578. AssertEquals('Raise statement',TPasImplRaise,I.ifBranch.ClassType);
  579. AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
  580. end;
  581. procedure TTestStatementParser.TestIfGotoElseBlock;
  582. Var
  583. I : TPasImplIfElse;
  584. begin
  585. TestStatement(['if a then','goto bird','else', 'for X := 0 to 1 do Writeln(X)']);
  586. I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
  587. AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
  588. AssertEquals('Goto statement',TPasImplGoto,I.ifBranch.ClassType);
  589. AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
  590. end;
  591. procedure TTestStatementParser.TestIfWithBlock;
  592. Var
  593. I : TPasImplIfElse;
  594. begin
  595. TestStatement(['if a then','with b do something','else', 'for X := 0 to 1 do Writeln(X)']);
  596. I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
  597. AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
  598. AssertEquals('With statement',TPasImplWithDo,I.ifBranch.ClassType);
  599. AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
  600. end;
  601. procedure TTestStatementParser.TestIfSemiColonElseError;
  602. begin
  603. DeclareVar('boolean');
  604. ExpectParserError('No semicolon before else',['if a then',' begin',' end;','else',' begin',' end']);
  605. end;
  606. procedure TTestStatementParser.TestNestedIf;
  607. Var
  608. I : TPasImplIfElse;
  609. begin
  610. DeclareVar('boolean');
  611. DeclareVar('boolean','b');
  612. TestStatement(['if a then',' if b then',' begin',' end','else',' begin',' end']);
  613. I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
  614. AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
  615. AssertNotNull('if branch',I.IfBranch);
  616. AssertNull('Else branch',i.ElseBranch);
  617. AssertEquals('if in if branch',TPasImplIfElse,I.ifBranch.ClassType);
  618. I:=I.Ifbranch as TPasImplIfElse;
  619. AssertEquals('begin end block',TPasImplBeginBlock,I.ElseBranch.ClassType);
  620. end;
  621. procedure TTestStatementParser.TestNestedIfElse;
  622. Var
  623. I : TPasImplIfElse;
  624. begin
  625. DeclareVar('boolean');
  626. TestStatement(['if a then',' if b then',' begin',' end',' else',' begin',' end','else',' begin','end']);
  627. I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
  628. AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
  629. AssertNotNull('if branch',I.IfBranch);
  630. AssertNotNull('Else branch',i.ElseBranch);
  631. AssertEquals('begin end block',TPasImplBeginBlock,I.ElseBranch.ClassType);
  632. AssertEquals('if in if branch',TPasImplIfElse,I.ifBranch.ClassType);
  633. I:=I.Ifbranch as TPasImplIfElse;
  634. AssertEquals('begin end block',TPasImplBeginBlock,I.ElseBranch.ClassType);
  635. end;
  636. procedure TTestStatementParser.TestNestedIfElseElse;
  637. // Bug ID 37760
  638. Var
  639. I,I2 : TPasImplIfElse;
  640. begin
  641. DeclareVar('boolean');
  642. TestStatement(['if a then',
  643. ' if b then',
  644. ' DoA ',
  645. ' else',
  646. ' else',
  647. ' DoB']);
  648. I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
  649. AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
  650. AssertNotNull('if branch',I.IfBranch);
  651. AssertNotNull('Have else for outer if',I.ElseBranch);
  652. AssertEquals('Have if in if branch',TPasImplIfElse,I.ifBranch.ClassType);
  653. I2:=I.Ifbranch as TPasImplIfElse;
  654. AssertExpression('IF condition',I2.ConditionExpr,pekIdent,'b');
  655. AssertNotNull('Have then for inner if',I2.ifBranch);
  656. AssertnotNull('Empty else for inner if',I2.ElseBranch);
  657. AssertEquals('Have a commend for inner if else',TPasImplCommand,I2.ElseBranch.ClassType);
  658. AssertEquals('... an empty command','',TPasImplCommand(I2.ElseBranch).Command);
  659. end;
  660. procedure TTestStatementParser.TestIfIfElseElseBlock;
  661. var
  662. OuterIf,InnerIf: TPasImplIfElse;
  663. begin
  664. DeclareVar('boolean');
  665. DeclareVar('boolean','B');
  666. TestStatement(['if a then','if b then',' begin',' end','else','else',' begin',' end']);
  667. OuterIf:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
  668. AssertExpression('IF condition',OuterIf.ConditionExpr,pekIdent,'a');
  669. AssertNotNull('if branch',OuterIf.IfBranch);
  670. AssertEquals('if else block',TPasImplIfElse,OuterIf.ifBranch.ClassType);
  671. InnerIf:=OuterIf.IfBranch as TPasImplIfElse;
  672. AssertExpression('IF condition',InnerIf.ConditionExpr,pekIdent,'b');
  673. AssertNotNull('if branch',InnerIf.IfBranch);
  674. AssertEquals('begin end block',TPasImplBeginBlock,InnerIf.ifBranch.ClassType);
  675. AssertNotNull('Else branch',InnerIf.ElseBranch);
  676. AssertEquals('empty statement',TPasImplCommand,InnerIf.ElseBranch.ClassType);
  677. AssertEquals('empty command','',TPasImplCommand(InnerIf.ElseBranch).Command);
  678. AssertNotNull('Else branch',OuterIf.ElseBranch);
  679. AssertEquals('begin end block',TPasImplBeginBlock,OuterIf.ElseBranch.ClassType);
  680. end;
  681. procedure TTestStatementParser.TestWhile;
  682. Var
  683. W : TPasImplWhileDo;
  684. begin
  685. DeclareVar('boolean');
  686. TestStatement(['While a do ;']);
  687. W:=AssertStatement('While statement',TPasImplWhileDo) as TPasImplWhileDo;
  688. AssertExpression('While condition',W.ConditionExpr,pekIdent,'a');
  689. AssertNull('Empty body',W.Body);
  690. end;
  691. procedure TTestStatementParser.TestWhileBlock;
  692. Var
  693. W : TPasImplWhileDo;
  694. begin
  695. DeclareVar('boolean');
  696. TestStatement(['While a do',' begin',' end']);
  697. W:=AssertStatement('While statement',TPasImplWhileDo) as TPasImplWhileDo;
  698. AssertExpression('While condition',W.ConditionExpr,pekIdent,'a');
  699. AssertNotNull('Have while body',W.Body);
  700. AssertEquals('begin end block',TPasImplBeginBlock,W.Body.ClassType);
  701. AssertEquals('Empty block',0,TPasImplBeginBlock(W.Body).ELements.Count);
  702. end;
  703. procedure TTestStatementParser.TestWhileNested;
  704. Var
  705. W : TPasImplWhileDo;
  706. begin
  707. DeclareVar('boolean');
  708. DeclareVar('boolean','b');
  709. TestStatement(['While a do',' while b do',' begin',' end']);
  710. W:=AssertStatement('While statement',TPasImplWhileDo) as TPasImplWhileDo;
  711. AssertExpression('While condition',W.ConditionExpr,pekIdent,'a');
  712. AssertNotNull('Have while body',W.Body);
  713. AssertEquals('Nested while',TPasImplWhileDo,W.Body.ClassType);
  714. W:=W.Body as TPasImplWhileDo;
  715. AssertExpression('While condition',W.ConditionExpr,pekIdent,'b');
  716. AssertNotNull('Have nested while body',W.Body);
  717. AssertEquals('Nested begin end block',TPasImplBeginBlock,W.Body.ClassType);
  718. AssertEquals('Empty nested block',0,TPasImplBeginBlock(W.Body).ELements.Count);
  719. end;
  720. procedure TTestStatementParser.TestRepeat;
  721. Var
  722. R : TPasImplRepeatUntil;
  723. begin
  724. DeclareVar('boolean');
  725. TestStatement(['Repeat','Until a;']);
  726. R:=AssertStatement('Repeat statement',TPasImplRepeatUntil) as TPasImplRepeatUntil;
  727. AssertExpression('repeat condition',R.ConditionExpr,pekIdent,'a');
  728. AssertEquals('Empty body',0,R.Elements.Count);
  729. end;
  730. procedure TTestStatementParser.TestRepeatBlock;
  731. Var
  732. R : TPasImplRepeatUntil;
  733. begin
  734. DeclareVar('boolean');
  735. TestStatement(['Repeat','begin','end;','Until a;']);
  736. R:=AssertStatement('repeat statement',TPasImplRepeatUntil) as TPasImplRepeatUntil;
  737. AssertExpression('repeat condition',R.ConditionExpr,pekIdent,'a');
  738. AssertEquals('Have statement',1,R.Elements.Count);
  739. AssertEquals('begin end block',TPasImplBeginBlock,TObject(R.Elements[0]).ClassType);
  740. AssertEquals('Empty block',0,TPasImplBeginBlock(R.Elements[0]).ELements.Count);
  741. end;
  742. procedure TTestStatementParser.TestRepeatBlockNosemicolon;
  743. Var
  744. R : TPasImplRepeatUntil;
  745. begin
  746. DeclareVar('boolean');
  747. TestStatement(['Repeat','begin','end','Until a;']);
  748. R:=AssertStatement('repeat statement',TPasImplRepeatUntil) as TPasImplRepeatUntil;
  749. AssertExpression('repeat condition',R.ConditionExpr,pekIdent,'a');
  750. AssertEquals('Have statement',1,R.Elements.Count);
  751. AssertEquals('begin end block',TPasImplBeginBlock,TObject(R.Elements[0]).ClassType);
  752. AssertEquals('Empty block',0,TPasImplBeginBlock(R.Elements[0]).ELements.Count);
  753. end;
  754. procedure TTestStatementParser.TestRepeatNested;
  755. Var
  756. R : TPasImplRepeatUntil;
  757. begin
  758. DeclareVar('boolean');
  759. DeclareVar('boolean','b');
  760. TestStatement(['Repeat','repeat','begin','end','until b','Until a;']);
  761. R:=AssertStatement('repeat statement',TPasImplRepeatUntil) as TPasImplRepeatUntil;
  762. AssertExpression('repeat condition',R.ConditionExpr,pekIdent,'a');
  763. AssertEquals('Have statement',1,R.Elements.Count);
  764. AssertEquals('Nested repeat',TPasImplRepeatUntil,TObject(R.Elements[0]).ClassType);
  765. R:=TPasImplRepeatUntil(R.Elements[0]);
  766. AssertExpression('repeat condition',R.ConditionExpr,pekIdent,'b');
  767. AssertEquals('Have statement',1,R.Elements.Count);
  768. AssertEquals('begin end block',TPasImplBeginBlock,TObject(R.Elements[0]).ClassType);
  769. AssertEquals('Empty block',0,TPasImplBeginBlock(R.Elements[0]).ELements.Count);
  770. end;
  771. procedure TTestStatementParser.TestFor;
  772. Var
  773. F : TPasImplForLoop;
  774. begin
  775. DeclareVar('integer');
  776. TestStatement(['For a:=1 to 10 do',';']);
  777. F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
  778. AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
  779. AssertEquals('Loop type',ltNormal,F.Looptype);
  780. AssertEquals('Up loop',False,F.Down);
  781. AssertExpression('Start value',F.StartExpr,pekNumber,'1');
  782. AssertExpression('End value',F.EndExpr,pekNumber,'10');
  783. AssertNull('Empty body',F.Body);
  784. end;
  785. procedure TTestStatementParser.TestForVarDef;
  786. Var
  787. F : TPasImplForLoop;
  788. begin
  789. AddStatements([
  790. '{$modeswitch inlinevars}',
  791. 'for var a : integer := 1 to 10 do',';'
  792. ]);
  793. ParseModule;
  794. F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
  795. AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
  796. AssertEquals('Loop type',ltNormal,F.Looptype);
  797. AssertEquals('Implicitly typed',False,F.ImplicitTyped);
  798. AssertNotNull('Var type',F.VarType);
  799. AssertExpression('Start value',F.StartExpr,pekNumber,'1');
  800. AssertExpression('end value',F.EndExpr,pekNumber,'10');
  801. AssertNull('Empty body',F.Body);
  802. end;
  803. procedure TTestStatementParser.TestForVarDefImplicit;
  804. Var
  805. F : TPasImplForLoop;
  806. begin
  807. AddStatements([
  808. '{$modeswitch inlinevars}',
  809. 'for var a := 1 to 10 do',';'
  810. ]);
  811. ParseModule;
  812. F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
  813. AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
  814. AssertEquals('Loop type',ltNormal,F.Looptype);
  815. AssertEquals('Implicitly typed',True,F.ImplicitTyped);
  816. AssertNull('Var type',F.VarType);
  817. AssertExpression('Start value',F.StartExpr,pekNumber,'1');
  818. AssertExpression('end value',F.EndExpr,pekNumber,'10');
  819. AssertNull('Empty body',F.Body);
  820. end;
  821. procedure TTestStatementParser.TestForIn;
  822. Var
  823. F : TPasImplForLoop;
  824. begin
  825. DeclareVar('integer');
  826. TestStatement(['For a in SomeSet Do',';']);
  827. F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
  828. AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
  829. AssertEquals('Loop type',ltIn,F.Looptype);
  830. AssertEquals('In loop',False,F.Down);
  831. AssertExpression('Start value',F.StartExpr,pekIdent,'SomeSet');
  832. AssertNull('Loop type',F.EndExpr);
  833. AssertNull('Empty body',F.Body);
  834. end;
  835. procedure TTestStatementParser.TestForInDef;
  836. Var
  837. F : TPasImplForLoop;
  838. begin
  839. TestStatement(['{$modeswitch inlinevars}',
  840. 'For var a : Integer in SomeSet Do',
  841. ';']);
  842. F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
  843. AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
  844. AssertEquals('Loop type',ltIn,F.Looptype);
  845. AssertEquals('Implicitly typed',False,F.ImplicitTyped);
  846. AssertNotNull('Var type',F.VarType);
  847. AssertEquals('In loop',False,F.Down);
  848. AssertExpression('Start value',F.StartExpr,pekIdent,'SomeSet');
  849. AssertNull('Loop type',F.EndExpr);
  850. AssertNull('Empty body',F.Body);
  851. end;
  852. procedure TTestStatementParser.TestForInDefImplicit;
  853. Var
  854. F : TPasImplForLoop;
  855. begin
  856. TestStatement(['{$modeswitch inlinevars}',
  857. 'For var a in SomeSet Do',
  858. ';']);
  859. F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
  860. AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
  861. AssertEquals('Loop type',ltIn,F.Looptype);
  862. AssertEquals('Implicitly typed',True,F.ImplicitTyped);
  863. AssertNull('Var type',F.VarType);
  864. AssertEquals('In loop',False,F.Down);
  865. AssertExpression('Start value',F.StartExpr,pekIdent,'SomeSet');
  866. AssertNull('Loop type',F.EndExpr);
  867. AssertNull('Empty body',F.Body);
  868. end;
  869. procedure TTestStatementParser.TestForExpr;
  870. Var
  871. F : TPasImplForLoop;
  872. B : TBinaryExpr;
  873. begin
  874. DeclareVar('integer');
  875. TestStatement(['For a:=1+1 to 5+5 do',';']);
  876. F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
  877. AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
  878. AssertEquals('Up loop',False,F.Down);
  879. AssertExpression('Start expression',F.StartExpr,pekBinary,TBinaryExpr);
  880. B:=F.StartExpr as TBinaryExpr;
  881. AssertExpression('Start value left',B.Left,pekNumber,'1');
  882. AssertExpression('Start value right',B.Right,pekNumber,'1');
  883. AssertExpression('Start expression',F.StartExpr,pekBinary,TBinaryExpr);
  884. B:=F.EndExpr as TBinaryExpr;
  885. AssertExpression('End value left',B.Left,pekNumber,'5');
  886. AssertExpression('End value right',B.Right,pekNumber,'5');
  887. AssertNull('Empty body',F.Body);
  888. end;
  889. procedure TTestStatementParser.TestForBlock;
  890. Var
  891. F : TPasImplForLoop;
  892. begin
  893. DeclareVar('integer');
  894. TestStatement(['For a:=1 to 10 do','begin','end']);
  895. F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
  896. AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
  897. AssertEquals('Up loop',False,F.Down);
  898. AssertExpression('Start value',F.StartExpr,pekNumber,'1');
  899. AssertExpression('End value',F.EndExpr,pekNumber,'10');
  900. AssertNotNull('Have for body',F.Body);
  901. AssertEquals('begin end block',TPasImplBeginBlock,F.Body.ClassType);
  902. AssertEquals('Empty block',0,TPasImplBeginBlock(F.Body).ELements.Count);
  903. end;
  904. procedure TTestStatementParser.TestDowntoBlock;
  905. Var
  906. F : TPasImplForLoop;
  907. begin
  908. DeclareVar('integer');
  909. TestStatement(['For a:=10 downto 1 do','begin','end']);
  910. F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
  911. AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
  912. AssertEquals('Down loop',True,F.Down);
  913. AssertExpression('Start value',F.StartExpr,pekNumber,'10');
  914. AssertExpression('End value',F.EndExpr,pekNumber,'1');
  915. AssertNotNull('Have for body',F.Body);
  916. AssertEquals('begin end block',TPasImplBeginBlock,F.Body.ClassType);
  917. AssertEquals('Empty block',0,TPasImplBeginBlock(F.Body).ELements.Count);
  918. end;
  919. procedure TTestStatementParser.TestForNested;
  920. Var
  921. F : TPasImplForLoop;
  922. begin
  923. DeclareVar('integer');
  924. DeclareVar('integer','b');
  925. TestStatement(['For a:=1 to 10 do','For b:=11 to 20 do','begin','end']);
  926. F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
  927. AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
  928. AssertEquals('Up loop',False,F.Down);
  929. AssertExpression('Start value',F.StartExpr,pekNumber,'1');
  930. AssertExpression('End value',F.EndExpr,pekNumber,'10');
  931. AssertNotNull('Have while body',F.Body);
  932. AssertEquals('begin end block',TPasImplForLoop,F.Body.ClassType);
  933. F:=F.Body as TPasImplForLoop;
  934. AssertExpression('Loop variable name',F.VariableName,pekIdent,'b');
  935. AssertEquals('Up loop',False,F.Down);
  936. AssertExpression('Start value',F.StartExpr,pekNumber,'11');
  937. AssertExpression('End value',F.EndExpr,pekNumber,'20');
  938. AssertNotNull('Have for body',F.Body);
  939. AssertEquals('begin end block',TPasImplBeginBlock,F.Body.ClassType);
  940. AssertEquals('Empty block',0,TPasImplBeginBlock(F.Body).ELements.Count);
  941. end;
  942. procedure TTestStatementParser.TestWith;
  943. Var
  944. W : TpasImplWithDo;
  945. begin
  946. DeclareVar('record X,Y : Integer; end');
  947. TestStatement(['With a do','begin','end']);
  948. W:=AssertStatement('For statement',TpasImplWithDo) as TpasImplWithDo;
  949. AssertEquals('1 expression',1,W.Expressions.Count);
  950. AssertExpression('With identifier',TPasExpr(W.Expressions[0]),pekIdent,'a');
  951. AssertNotNull('Have with body',W.Body);
  952. AssertEquals('begin end block',TPasImplBeginBlock,W.Body.ClassType);
  953. AssertEquals('Empty block',0,TPasImplBeginBlock(W.Body).ELements.Count);
  954. end;
  955. procedure TTestStatementParser.TestWithMultiple;
  956. Var
  957. W : TpasImplWithDo;
  958. begin
  959. DeclareVar('record X,Y : Integer; end');
  960. DeclareVar('record W,Z : Integer; end','b');
  961. TestStatement(['With a,b do','begin','end']);
  962. W:=AssertStatement('For statement',TpasImplWithDo) as TpasImplWithDo;
  963. AssertEquals('2 expressions',2,W.Expressions.Count);
  964. AssertExpression('With identifier 1',TPasExpr(W.Expressions[0]),pekIdent,'a');
  965. AssertExpression('With identifier 2',TPasExpr(W.Expressions[1]),pekIdent,'b');
  966. AssertNotNull('Have with body',W.Body);
  967. AssertEquals('begin end block',TPasImplBeginBlock,W.Body.ClassType);
  968. AssertEquals('Empty block',0,TPasImplBeginBlock(W.Body).ELements.Count);
  969. end;
  970. procedure TTestStatementParser.TestCaseEmpty;
  971. begin
  972. DeclareVar('integer');
  973. AddStatements(['case a of','end;']);
  974. ExpectParserError('Empty case not allowed');
  975. end;
  976. procedure TTestStatementParser.TestCaseOneInteger;
  977. Var
  978. C : TPasImplCaseOf;
  979. S : TPasImplCaseStatement;
  980. begin
  981. DeclareVar('integer');
  982. TestStatement(['case a of','1 : ;','end;']);
  983. C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
  984. AssertNotNull('Have case expression',C.CaseExpr);
  985. AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
  986. AssertNull('No else branch',C.ElseBranch);
  987. AssertEquals('One case label',1,C.Elements.Count);
  988. AssertEquals('Correct case for case label',TPasImplCaseStatement,TPasElement(C.Elements[0]).ClassType);
  989. S:=TPasImplCaseStatement(C.Elements[0]);
  990. AssertEquals('1 expression for case',1,S.Expressions.Count);
  991. AssertExpression('With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'1');
  992. AssertEquals('Empty case label statement',0,S.Elements.Count);
  993. AssertNull('Empty case label statement',S.Body);
  994. end;
  995. procedure TTestStatementParser.TestCaseTwoIntegers;
  996. Var
  997. C : TPasImplCaseOf;
  998. S : TPasImplCaseStatement;
  999. begin
  1000. DeclareVar('integer');
  1001. TestStatement(['case a of','1,2 : ;','end;']);
  1002. C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
  1003. AssertNotNull('Have case expression',C.CaseExpr);
  1004. AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
  1005. AssertNull('No else branch',C.ElseBranch);
  1006. AssertEquals('One case label',1,C.Elements.Count);
  1007. AssertEquals('Correct case for case label',TPasImplCaseStatement,TPasElement(C.Elements[0]).ClassType);
  1008. S:=TPasImplCaseStatement(C.Elements[0]);
  1009. AssertEquals('2 expressions for case',2,S.Expressions.Count);
  1010. AssertExpression('With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'1');
  1011. AssertExpression('With identifier 2',TPasExpr(S.Expressions[1]),pekNumber,'2');
  1012. AssertEquals('Empty case label statement',0,S.Elements.Count);
  1013. AssertNull('Empty case label statement',S.Body);
  1014. end;
  1015. procedure TTestStatementParser.TestCaseRange;
  1016. Var
  1017. C : TPasImplCaseOf;
  1018. S : TPasImplCaseStatement;
  1019. begin
  1020. DeclareVar('integer');
  1021. TestStatement(['case a of','1..3 : ;','end;']);
  1022. C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
  1023. AssertNotNull('Have case expression',C.CaseExpr);
  1024. AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
  1025. AssertNull('No else branch',C.ElseBranch);
  1026. AssertEquals('One case label',1,C.Elements.Count);
  1027. AssertEquals('Correct case for case label',TPasImplCaseStatement,TPasElement(C.Elements[0]).ClassType);
  1028. S:=TPasImplCaseStatement(C.Elements[0]);
  1029. AssertEquals('1 expression for case',1,S.Expressions.Count);
  1030. AssertExpression('With identifier 1',TPasExpr(S.Expressions[0]),pekRange,TBinaryExpr);
  1031. AssertEquals('Empty case label statement',0,S.Elements.Count);
  1032. AssertNull('Empty case label statement',S.Body);
  1033. end;
  1034. procedure TTestStatementParser.TestCaseRangeSeparate;
  1035. Var
  1036. C : TPasImplCaseOf;
  1037. S : TPasImplCaseStatement;
  1038. begin
  1039. DeclareVar('integer');
  1040. TestStatement(['case a of','1..3,5 : ;','end;']);
  1041. C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
  1042. AssertNotNull('Have case expression',C.CaseExpr);
  1043. AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
  1044. AssertNull('No else branch',C.ElseBranch);
  1045. AssertEquals('One case label',1,C.Elements.Count);
  1046. AssertEquals('Correct case for case label',TPasImplCaseStatement,TPasElement(C.Elements[0]).ClassType);
  1047. S:=TPasImplCaseStatement(C.Elements[0]);
  1048. AssertEquals('2 expressions for case',2,S.Expressions.Count);
  1049. AssertExpression('With identifier 1',TPasExpr(S.Expressions[0]),pekRange,TBinaryExpr);
  1050. AssertExpression('With identifier 2',TPasExpr(S.Expressions[1]),pekNumber,'5');
  1051. AssertEquals('Empty case label statement',0,S.Elements.Count);
  1052. AssertNull('Empty case label statement',S.Body);
  1053. end;
  1054. procedure TTestStatementParser.TestCase2Cases;
  1055. Var
  1056. C : TPasImplCaseOf;
  1057. S : TPasImplCaseStatement;
  1058. begin
  1059. DeclareVar('integer');
  1060. TestStatement(['case a of','1 : ;','2 : ;','end;']);
  1061. C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
  1062. AssertNotNull('Have case expression',C.CaseExpr);
  1063. AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
  1064. AssertNull('No else branch',C.ElseBranch);
  1065. AssertEquals('Two case labels',2,C.Elements.Count);
  1066. AssertEquals('Correct case for case label 1',TPasImplCaseStatement,TPasElement(C.Elements[0]).ClassType);
  1067. S:=TPasImplCaseStatement(C.Elements[0]);
  1068. AssertEquals('2 expressions for case 1',1,S.Expressions.Count);
  1069. AssertExpression('Case 1 With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'1');
  1070. AssertEquals('Empty case label statement 1',0,S.Elements.Count);
  1071. AssertNull('Empty case label statement 1',S.Body);
  1072. // Two
  1073. AssertEquals('Correct case for case label 2',TPasImplCaseStatement,TPasElement(C.Elements[1]).ClassType);
  1074. S:=TPasImplCaseStatement(C.Elements[1]);
  1075. AssertEquals('2 expressions for case 2',1,S.Expressions.Count);
  1076. AssertExpression('Case 2 With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'2');
  1077. AssertEquals('Empty case label statement 2',0,S.Elements.Count);
  1078. AssertNull('Empty case label statement 2',S.Body);
  1079. end;
  1080. procedure TTestStatementParser.TestCaseBlock;
  1081. Var
  1082. C : TPasImplCaseOf;
  1083. S : TPasImplCaseStatement;
  1084. B : TPasImplbeginBlock;
  1085. begin
  1086. DeclareVar('integer');
  1087. TestStatement(['case a of','1 : begin end;','end;']);
  1088. C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
  1089. AssertNotNull('Have case expression',C.CaseExpr);
  1090. AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
  1091. AssertNull('No else branch',C.ElseBranch);
  1092. AssertEquals('Two case labels',1,C.Elements.Count);
  1093. AssertEquals('Correct case for case label 1',TPasImplCaseStatement,TPasElement(C.Elements[0]).ClassType);
  1094. S:=TPasImplCaseStatement(C.Elements[0]);
  1095. AssertEquals('2 expressions for case 1',1,S.Expressions.Count);
  1096. AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'1');
  1097. AssertEquals('1 case label statement',1,S.Elements.Count);
  1098. AssertEquals('Correct case for case label 1',TPasImplbeginBlock,TPasElement(S.Elements[0]).ClassType);
  1099. B:=TPasImplbeginBlock(S.Elements[0]);
  1100. AssertEquals('0 statements in block',0,B.Elements.Count);
  1101. end;
  1102. procedure TTestStatementParser.TestCaseElseBlockEmpty;
  1103. Var
  1104. C : TPasImplCaseOf;
  1105. S : TPasImplCaseStatement;
  1106. B : TPasImplbeginBlock;
  1107. begin
  1108. DeclareVar('integer');
  1109. TestStatement(['case a of','1 : begin end;','else',' end;']);
  1110. C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
  1111. AssertNotNull('Have case expression',C.CaseExpr);
  1112. AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
  1113. AssertEquals('Two case labels',2,C.Elements.Count);
  1114. AssertEquals('Correct case for case label 1',TPasImplCaseStatement,TPasElement(C.Elements[0]).ClassType);
  1115. S:=TPasImplCaseStatement(C.Elements[0]);
  1116. AssertEquals('2 expressions for case 1',1,S.Expressions.Count);
  1117. AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'1');
  1118. AssertEquals('1 case label statement',1,S.Elements.Count);
  1119. AssertEquals('Correct case for case label 1',TPasImplbeginBlock,TPasElement(S.Elements[0]).ClassType);
  1120. B:=TPasImplbeginBlock(S.Elements[0]);
  1121. AssertEquals('0 statements in block',0,B.Elements.Count);
  1122. AssertNotNull('Have else branch',C.ElseBranch);
  1123. AssertEquals('Correct else branch class',TPasImplCaseElse,C.ElseBranch.ClassType);
  1124. AssertEquals('Zero statements ',0,TPasImplCaseElse(C.ElseBranch).Elements.Count);
  1125. end;
  1126. procedure TTestStatementParser.TestCaseOtherwiseBlockEmpty;
  1127. Var
  1128. C : TPasImplCaseOf;
  1129. begin
  1130. DeclareVar('integer');
  1131. TestStatement(['case a of','1 : begin end;','otherwise',' end;']);
  1132. C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
  1133. AssertNotNull('Have case expression',C.CaseExpr);
  1134. AssertNotNull('Have else branch',C.ElseBranch);
  1135. AssertEquals('Correct else branch class',TPasImplCaseElse,C.ElseBranch.ClassType);
  1136. AssertEquals('Zero statements ',0,TPasImplCaseElse(C.ElseBranch).Elements.Count);
  1137. end;
  1138. procedure TTestStatementParser.TestCaseElseBlockAssignment;
  1139. Var
  1140. C : TPasImplCaseOf;
  1141. S : TPasImplCaseStatement;
  1142. B : TPasImplbeginBlock;
  1143. begin
  1144. DeclareVar('integer');
  1145. TestStatement(['case a of','1 : begin end;','else','a:=1',' end;']);
  1146. C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
  1147. AssertNotNull('Have case expression',C.CaseExpr);
  1148. AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
  1149. AssertEquals('Two case labels',2,C.Elements.Count);
  1150. AssertEquals('Correct case for case label 1',TPasImplCaseStatement,TPasElement(C.Elements[0]).ClassType);
  1151. S:=TPasImplCaseStatement(C.Elements[0]);
  1152. AssertEquals('2 expressions for case 1',1,S.Expressions.Count);
  1153. AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'1');
  1154. AssertEquals('1 case label statement',1,S.Elements.Count);
  1155. AssertEquals('Correct case for case label 1',TPasImplbeginBlock,TPasElement(S.Elements[0]).ClassType);
  1156. B:=TPasImplbeginBlock(S.Elements[0]);
  1157. AssertEquals('0 statements in block',0,B.Elements.Count);
  1158. AssertNotNull('Have else branch',C.ElseBranch);
  1159. AssertEquals('Correct else branch class',TPasImplCaseElse,C.ElseBranch.ClassType);
  1160. AssertEquals('1 statement in else branch ',1,TPasImplCaseElse(C.ElseBranch).Elements.Count);
  1161. end;
  1162. procedure TTestStatementParser.TestCaseElseBlock2Assignments;
  1163. Var
  1164. C : TPasImplCaseOf;
  1165. S : TPasImplCaseStatement;
  1166. B : TPasImplbeginBlock;
  1167. begin
  1168. DeclareVar('integer');
  1169. TestStatement(['case a of','1 : begin end;','else','a:=1;','a:=32;',' end;']);
  1170. C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
  1171. AssertNotNull('Have case expression',C.CaseExpr);
  1172. AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
  1173. AssertEquals('Two case labels',2,C.Elements.Count);
  1174. AssertEquals('Correct case for case label 1',TPasImplCaseStatement,TPasElement(C.Elements[0]).ClassType);
  1175. S:=TPasImplCaseStatement(C.Elements[0]);
  1176. AssertEquals('2 expressions for case 1',1,S.Expressions.Count);
  1177. AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'1');
  1178. AssertEquals('1 case label statement',1,S.Elements.Count);
  1179. AssertEquals('Correct case for case label 1',TPasImplbeginBlock,TPasElement(S.Elements[0]).ClassType);
  1180. B:=TPasImplbeginBlock(S.Elements[0]);
  1181. AssertEquals('0 statements in block',0,B.Elements.Count);
  1182. AssertNotNull('Have else branch',C.ElseBranch);
  1183. AssertEquals('Correct else branch class',TPasImplCaseElse,C.ElseBranch.ClassType);
  1184. AssertEquals('2 statements in else branch ',2,TPasImplCaseElse(C.ElseBranch).Elements.Count);
  1185. end;
  1186. procedure TTestStatementParser.TestCaseIfCaseElse;
  1187. Var
  1188. C : TPasImplCaseOf;
  1189. begin
  1190. DeclareVar('integer');
  1191. DeclareVar('boolean','b');
  1192. TestStatement(['case a of','1 : if b then',' begin end;','else',' end;']);
  1193. C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
  1194. AssertNotNull('Have case expression',C.CaseExpr);
  1195. AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
  1196. AssertEquals('Two case labels',2,C.Elements.Count);
  1197. AssertNotNull('Have else branch',C.ElseBranch);
  1198. AssertEquals('Correct else branch class',TPasImplCaseElse,C.ElseBranch.ClassType);
  1199. AssertEquals('0 statement in else branch ',0,TPasImplCaseElse(C.ElseBranch).Elements.Count);
  1200. end;
  1201. procedure TTestStatementParser.TestCaseIfElse;
  1202. Var
  1203. C : TPasImplCaseOf;
  1204. S : TPasImplCaseStatement;
  1205. begin
  1206. DeclareVar('integer');
  1207. DeclareVar('boolean','b');
  1208. TestStatement(['case a of','1 : if b then',' begin end','else','begin','end',' end;']);
  1209. C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
  1210. AssertNotNull('Have case expression',C.CaseExpr);
  1211. AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
  1212. AssertEquals('One case label',1,C.Elements.Count);
  1213. AssertNull('Have no else branch',C.ElseBranch);
  1214. S:=TPasImplCaseStatement(C.Elements[0]);
  1215. AssertEquals('2 expressions for case 1',1,S.Expressions.Count);
  1216. AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'1');
  1217. AssertEquals('1 case label statement',1,S.Elements.Count);
  1218. AssertEquals('If statement in case label 1',TPasImplIfElse,TPasElement(S.Elements[0]).ClassType);
  1219. AssertNotNull('If statement has else block',TPasImplIfElse(S.Elements[0]).ElseBranch);
  1220. end;
  1221. procedure TTestStatementParser.TestCaseIfCaseElseElse;
  1222. Var
  1223. C : TPasImplCaseOf;
  1224. S : TPasImplCaseStatement;
  1225. begin
  1226. DeclareVar('integer');
  1227. DeclareVar('boolean','b');
  1228. TestStatement(['case a of','1 : if b then',' begin end','else','else','DoElse',' end;']);
  1229. C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
  1230. AssertNotNull('Have case expression',C.CaseExpr);
  1231. AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
  1232. AssertEquals('Two case labels',2,C.Elements.Count);
  1233. AssertNotNull('Have an else branch',C.ElseBranch);
  1234. S:=TPasImplCaseStatement(C.Elements[0]);
  1235. AssertEquals('2 expressions for case 1',1,S.Expressions.Count);
  1236. AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'1');
  1237. AssertEquals('1 case label statement',1,S.Elements.Count);
  1238. AssertEquals('If statement in case label 1',TPasImplIfElse,TPasElement(S.Elements[0]).ClassType);
  1239. AssertNotNull('If statement has else block',TPasImplIfElse(S.Elements[0]).ElseBranch);
  1240. AssertEquals('If statement has a commend as else block',TPasImplCommand,TPasImplIfElse(S.Elements[0]).ElseBranch.ClassType);
  1241. AssertEquals('But ... an empty command','',TPasImplCommand(TPasImplIfElse(S.Elements[0]).ElseBranch).Command);
  1242. end;
  1243. procedure TTestStatementParser.TestCaseElseNoSemicolon;
  1244. Var
  1245. C : TPasImplCaseOf;
  1246. S : TPasImplCaseStatement;
  1247. begin
  1248. DeclareVar('integer');
  1249. TestStatement(['case a of','1 : dosomething;','2 : dosomethingmore','else','a:=1;','end;']);
  1250. C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
  1251. AssertNotNull('Have case expression',C.CaseExpr);
  1252. AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
  1253. AssertEquals('case label count',3,C.Elements.Count);
  1254. S:=TPasImplCaseStatement(C.Elements[0]);
  1255. AssertEquals('case 1',1,S.Expressions.Count);
  1256. AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'1');
  1257. S:=TPasImplCaseStatement(C.Elements[1]);
  1258. AssertEquals('case 2',1,S.Expressions.Count);
  1259. AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'2');
  1260. AssertEquals('third is else',TPasImplCaseElse,TObject(C.Elements[2]).ClassType);
  1261. AssertNotNull('Have else branch',C.ElseBranch);
  1262. AssertEquals('Correct else branch class',TPasImplCaseElse,C.ElseBranch.ClassType);
  1263. AssertEquals('1 statements in else branch ',1,TPasImplCaseElse(C.ElseBranch).Elements.Count);
  1264. end;
  1265. procedure TTestStatementParser.TestCaseIfElseNoSemicolon;
  1266. Var
  1267. C : TPasImplCaseOf;
  1268. S : TPasImplCaseStatement;
  1269. begin
  1270. DeclareVar('integer');
  1271. TestStatement(['case a of','1 : dosomething;','2: if b then',' dosomething','else dosomethingmore','else','a:=1;','end;']);
  1272. C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
  1273. AssertNotNull('Have case expression',C.CaseExpr);
  1274. AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
  1275. AssertEquals('case label count',3,C.Elements.Count);
  1276. S:=TPasImplCaseStatement(C.Elements[0]);
  1277. AssertEquals('case 1',1,S.Expressions.Count);
  1278. AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'1');
  1279. S:=TPasImplCaseStatement(C.Elements[1]);
  1280. AssertEquals('case 2',1,S.Expressions.Count);
  1281. AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'2');
  1282. AssertEquals('third is else',TPasImplCaseElse,TObject(C.Elements[2]).ClassType);
  1283. AssertNotNull('Have else branch',C.ElseBranch);
  1284. AssertEquals('Correct else branch class',TPasImplCaseElse,C.ElseBranch.ClassType);
  1285. AssertEquals('1 statements in else branch ',1,TPasImplCaseElse(C.ElseBranch).Elements.Count);
  1286. end;
  1287. procedure TTestStatementParser.TestCaseIfOtherwiseNoSemicolon;
  1288. Var
  1289. C : TPasImplCaseOf;
  1290. S : TPasImplCaseStatement;
  1291. begin
  1292. DeclareVar('integer');
  1293. TestStatement(['case a of','1 : dosomething;','2: if b then',' dosomething','else dosomethingmore','otherwise','a:=1;','end;']);
  1294. C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
  1295. AssertNotNull('Have case expression',C.CaseExpr);
  1296. AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
  1297. AssertEquals('case label count',3,C.Elements.Count);
  1298. S:=TPasImplCaseStatement(C.Elements[0]);
  1299. AssertEquals('case 1',1,S.Expressions.Count);
  1300. AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'1');
  1301. S:=TPasImplCaseStatement(C.Elements[1]);
  1302. AssertEquals('case 2',1,S.Expressions.Count);
  1303. AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'2');
  1304. AssertEquals('third is else',TPasImplCaseElse,TObject(C.Elements[2]).ClassType);
  1305. AssertNotNull('Have else branch',C.ElseBranch);
  1306. AssertEquals('Correct else branch class',TPasImplCaseElse,C.ElseBranch.ClassType);
  1307. AssertEquals('1 statements in else branch ',1,TPasImplCaseElse(C.ElseBranch).Elements.Count);
  1308. end;
  1309. procedure TTestStatementParser.TestRaise;
  1310. Var
  1311. R : TPasImplRaise;
  1312. begin
  1313. DeclareVar('Exception');
  1314. TestStatement('Raise A;');
  1315. R:=AssertStatement('Raise statement',TPasImplRaise) as TPasImplRaise;
  1316. AssertEquals(0,R.Elements.Count);
  1317. AssertNotNull(R.ExceptObject);
  1318. AssertNull(R.ExceptAddr);
  1319. AssertExpression('Expression object',R.ExceptObject,pekIdent,'A');
  1320. end;
  1321. procedure TTestStatementParser.TestRaiseEmpty;
  1322. Var
  1323. R : TPasImplRaise;
  1324. begin
  1325. TestStatement('Raise;');
  1326. R:=AssertStatement('Raise statement',TPasImplRaise) as TPasImplRaise;
  1327. AssertEquals(0,R.Elements.Count);
  1328. AssertNull(R.ExceptObject);
  1329. AssertNull(R.ExceptAddr);
  1330. end;
  1331. procedure TTestStatementParser.TestRaiseAt;
  1332. Var
  1333. R : TPasImplRaise;
  1334. begin
  1335. DeclareVar('Exception');
  1336. DeclareVar('Pointer','B');
  1337. TestStatement('Raise A at B;');
  1338. R:=AssertStatement('Raise statement',TPasImplRaise) as TPasImplRaise;
  1339. AssertEquals(0,R.Elements.Count);
  1340. AssertNotNull(R.ExceptObject);
  1341. AssertNotNull(R.ExceptAddr);
  1342. AssertExpression('Expression object',R.ExceptAddr,pekIdent,'B');
  1343. end;
  1344. procedure TTestStatementParser.TestGoto;
  1345. Var
  1346. R : TPasImplGoto;
  1347. begin
  1348. TestStatement('Goto A;');
  1349. R:=AssertStatement('Goto statement',TPasImplGoto) as TPasImplGoto;
  1350. AssertEquals(0,R.Elements.Count);
  1351. AssertEquals('A',R.LabelName);
  1352. end;
  1353. procedure TTestStatementParser.TestTryFinally;
  1354. Var
  1355. T : TPasImplTry;
  1356. S : TPasImplSimple;
  1357. F : TPasImplTryFinally;
  1358. begin
  1359. TestStatement(['Try',' DoSomething;','finally',' DoSomethingElse','end']);
  1360. T:=AssertStatement('Try statement',TPasImplTry) as TPasImplTry;
  1361. AssertEquals(1,T.Elements.Count);
  1362. AssertNotNull(T.FinallyExcept);
  1363. AssertNull(T.ElseBranch);
  1364. AssertNotNull(T.Elements[0]);
  1365. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1366. S:=TPasImplSimple(T.Elements[0]);
  1367. AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomething');
  1368. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1369. AssertEquals('Finally statement',TPasImplTryFinally,T.FinallyExcept.ClassType);
  1370. F:=TPasImplTryFinally(T.FinallyExcept);
  1371. AssertEquals(1,F.Elements.Count);
  1372. AssertEquals('Simple statement',TPasImplSimple,TPasElement(F.Elements[0]).ClassType);
  1373. S:=TPasImplSimple(F.Elements[0]);
  1374. AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse');
  1375. end;
  1376. procedure TTestStatementParser.TestTryFinallyEmpty;
  1377. Var
  1378. T : TPasImplTry;
  1379. F : TPasImplTryFinally;
  1380. begin
  1381. TestStatement(['Try','finally','end;']);
  1382. T:=AssertStatement('Try statement',TPasImplTry) as TPasImplTry;
  1383. AssertEquals(0,T.Elements.Count);
  1384. AssertNotNull(T.FinallyExcept);
  1385. AssertNull(T.ElseBranch);
  1386. AssertEquals('Finally statement',TPasImplTryFinally,T.FinallyExcept.ClassType);
  1387. F:=TPasImplTryFinally(T.FinallyExcept);
  1388. AssertEquals(0,F.Elements.Count);
  1389. end;
  1390. procedure TTestStatementParser.TestTryFinallyNested;
  1391. Var
  1392. T : TPasImplTry;
  1393. S : TPasImplSimple;
  1394. F : TPasImplTryFinally;
  1395. begin
  1396. TestStatement(['Try',' DoSomething1;',' Try',' DoSomething2;',' finally',' DoSomethingElse2',' end;','Finally',' DoSomethingElse1','end']);
  1397. T:=AssertStatement('Try statement',TPasImplTry) as TPasImplTry;
  1398. AssertEquals(2,T.Elements.Count);
  1399. AssertNotNull(T.FinallyExcept);
  1400. AssertNull(T.ElseBranch);
  1401. AssertNotNull(T.Elements[0]);
  1402. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1403. S:=TPasImplSimple(T.Elements[0]);
  1404. AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomething1');
  1405. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1406. AssertEquals('Finally statement',TPasImplTryFinally,T.FinallyExcept.ClassType);
  1407. F:=TPasImplTryFinally(T.FinallyExcept);
  1408. AssertEquals(1,F.Elements.Count);
  1409. AssertEquals('Simple statement',TPasImplSimple,TPasElement(F.Elements[0]).ClassType);
  1410. S:=TPasImplSimple(F.Elements[0]);
  1411. AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse1');
  1412. // inner statement
  1413. AssertNotNull(T.Elements[1]);
  1414. AssertEquals('Nested try statement',TPasImplTry,TPasElement(T.Elements[1]).ClassType);
  1415. T:=TPasImplTry(T.Elements[1]);
  1416. AssertEquals(1,T.Elements.Count);
  1417. AssertNotNull(T.FinallyExcept);
  1418. AssertNull(T.ElseBranch);
  1419. AssertNotNull(T.Elements[0]);
  1420. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1421. S:=TPasImplSimple(T.Elements[0]);
  1422. AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomething2');
  1423. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1424. AssertEquals('Finally statement',TPasImplTryFinally,T.FinallyExcept.ClassType);
  1425. F:=TPasImplTryFinally(T.FinallyExcept);
  1426. AssertEquals(1,F.Elements.Count);
  1427. AssertEquals('Simple statement',TPasImplSimple,TPasElement(F.Elements[0]).ClassType);
  1428. S:=TPasImplSimple(F.Elements[0]);
  1429. AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse2');
  1430. end;
  1431. procedure TTestStatementParser.TestTryExcept;
  1432. Var
  1433. T : TPasImplTry;
  1434. S : TPasImplSimple;
  1435. E : TPasImplTryExcept;
  1436. begin
  1437. TestStatement(['Try',' DoSomething;','except',' DoSomethingElse','end']);
  1438. T:=AssertStatement('Try statement',TPasImplTry) as TPasImplTry;
  1439. AssertEquals(1,T.Elements.Count);
  1440. AssertNotNull(T.FinallyExcept);
  1441. AssertNull(T.ElseBranch);
  1442. AssertNotNull(T.Elements[0]);
  1443. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1444. S:=TPasImplSimple(T.Elements[0]);
  1445. AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomething');
  1446. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1447. AssertEquals('Except statement',TPasImplTryExcept,T.FinallyExcept.ClassType);
  1448. E:=TPasImplTryExcept(T.FinallyExcept);
  1449. AssertEquals(1,E.Elements.Count);
  1450. AssertEquals('Simple statement',TPasImplSimple,TPasElement(E.Elements[0]).ClassType);
  1451. S:=TPasImplSimple(E.Elements[0]);
  1452. AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse');
  1453. end;
  1454. procedure TTestStatementParser.TestTryExceptNested;
  1455. Var
  1456. T : TPasImplTry;
  1457. S : TPasImplSimple;
  1458. E : TPasImplTryExcept;
  1459. begin
  1460. TestStatement(['Try',' DoSomething1;',' try',' DoSomething2;',' except',' DoSomethingElse2',' end','except',' DoSomethingElse1','end']);
  1461. T:=AssertStatement('Try statement',TPasImplTry) as TPasImplTry;
  1462. AssertEquals(2,T.Elements.Count);
  1463. AssertNotNull(T.FinallyExcept);
  1464. AssertNull(T.ElseBranch);
  1465. AssertNotNull(T.Elements[0]);
  1466. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1467. S:=TPasImplSimple(T.Elements[0]);
  1468. AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomething1');
  1469. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1470. AssertEquals('Except statement',TPasImplTryExcept,T.FinallyExcept.ClassType);
  1471. E:=TPasImplTryExcept(T.FinallyExcept);
  1472. AssertEquals(1,E.Elements.Count);
  1473. AssertEquals('Simple statement',TPasImplSimple,TPasElement(E.Elements[0]).ClassType);
  1474. S:=TPasImplSimple(E.Elements[0]);
  1475. AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse1');
  1476. AssertNotNull(T.Elements[1]);
  1477. AssertEquals('Simple statement',TPasImplTry,TPasElement(T.Elements[1]).ClassType);
  1478. T:=TPasImplTry(T.Elements[1]);
  1479. AssertEquals(1,T.Elements.Count);
  1480. AssertNotNull(T.FinallyExcept);
  1481. AssertNull(T.ElseBranch);
  1482. AssertNotNull(T.Elements[0]);
  1483. AssertEquals('Simple statement 2',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1484. S:=TPasImplSimple(T.Elements[0]);
  1485. AssertExpression('DoSomething2 call ',S.Expr,pekIdent,'DoSomething2');
  1486. AssertEquals('Simple statement2',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1487. AssertEquals('Except statement2',TPasImplTryExcept,T.FinallyExcept.ClassType);
  1488. E:=TPasImplTryExcept(T.FinallyExcept);
  1489. AssertEquals(1,E.Elements.Count);
  1490. AssertEquals('Simple statement2',TPasImplSimple,TPasElement(E.Elements[0]).ClassType);
  1491. S:=TPasImplSimple(E.Elements[0]);
  1492. AssertExpression('DoSomethingElse2 call',S.Expr,pekIdent,'DoSomethingElse2');
  1493. end;
  1494. procedure TTestStatementParser.TestTryExceptEmpty;
  1495. Var
  1496. T : TPasImplTry;
  1497. E : TPasImplTryExcept;
  1498. begin
  1499. TestStatement(['Try','except','end;']);
  1500. T:=AssertStatement('Try statement',TPasImplTry) as TPasImplTry;
  1501. AssertEquals(0,T.Elements.Count);
  1502. AssertNotNull(T.FinallyExcept);
  1503. AssertNull(T.ElseBranch);
  1504. AssertEquals('Except statement',TPasImplTryExcept,T.FinallyExcept.ClassType);
  1505. E:=TPasImplTryExcept(T.FinallyExcept);
  1506. AssertEquals(0,E.Elements.Count);
  1507. end;
  1508. procedure TTestStatementParser.TestTryExceptOn;
  1509. Var
  1510. T : TPasImplTry;
  1511. S : TPasImplSimple;
  1512. E : TPasImplTryExcept;
  1513. O : TPasImplExceptOn;
  1514. begin
  1515. TestStatement(['Try',' DoSomething;','except','On E : Exception do','DoSomethingElse;','end']);
  1516. T:=AssertStatement('Try statement',TPasImplTry) as TPasImplTry;
  1517. AssertEquals(1,T.Elements.Count);
  1518. AssertNotNull(T.FinallyExcept);
  1519. AssertNull(T.ElseBranch);
  1520. AssertNotNull(T.Elements[0]);
  1521. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1522. S:=TPasImplSimple(T.Elements[0]);
  1523. AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomething');
  1524. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1525. AssertEquals('Except statement',TPasImplTryExcept,T.FinallyExcept.ClassType);
  1526. E:=TPasImplTryExcept(T.FinallyExcept);
  1527. AssertEquals(1,E.Elements.Count);
  1528. AssertEquals('Except on handler',TPasImplExceptOn,TPasElement(E.Elements[0]).ClassType);
  1529. O:=TPasImplExceptOn(E.Elements[0]);
  1530. AssertEquals(1,O.Elements.Count);
  1531. AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
  1532. AssertEquals('Exception Variable name','E',O.VariableName);
  1533. AssertEquals('Exception Type name','Exception',O.TypeName);
  1534. S:=TPasImplSimple(O.Elements[0]);
  1535. AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse');
  1536. // AssertEquals('Variable name',
  1537. end;
  1538. procedure TTestStatementParser.TestTryExceptOn2;
  1539. Var
  1540. T : TPasImplTry;
  1541. S : TPasImplSimple;
  1542. E : TPasImplTryExcept;
  1543. O : TPasImplExceptOn;
  1544. begin
  1545. TestStatement(['Try',' DoSomething;','except',
  1546. 'On E : Exception do','DoSomethingElse;',
  1547. 'On Y : Exception2 do','DoSomethingElse2;',
  1548. 'end']);
  1549. T:=AssertStatement('Try statement',TPasImplTry) as TPasImplTry;
  1550. AssertEquals(1,T.Elements.Count);
  1551. AssertNotNull(T.FinallyExcept);
  1552. AssertNull(T.ElseBranch);
  1553. AssertNotNull(T.Elements[0]);
  1554. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1555. S:=TPasImplSimple(T.Elements[0]);
  1556. AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomething');
  1557. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1558. AssertEquals('Except statement',TPasImplTryExcept,T.FinallyExcept.ClassType);
  1559. E:=TPasImplTryExcept(T.FinallyExcept);
  1560. AssertEquals(2,E.Elements.Count);
  1561. // Exception handler 1
  1562. AssertEquals('Except on handler',TPasImplExceptOn,TPasElement(E.Elements[0]).ClassType);
  1563. O:=TPasImplExceptOn(E.Elements[0]);
  1564. AssertEquals(1,O.Elements.Count);
  1565. AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
  1566. AssertEquals('Exception Variable name','E',O.VariableName);
  1567. AssertEquals('Exception Type name','Exception',O.TypeName);
  1568. S:=TPasImplSimple(O.Elements[0]);
  1569. AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse');
  1570. // Exception handler 2
  1571. AssertEquals('Except on handler',TPasImplExceptOn,TPasElement(E.Elements[1]).ClassType);
  1572. O:=TPasImplExceptOn(E.Elements[1]);
  1573. AssertEquals(1,O.Elements.Count);
  1574. AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
  1575. AssertEquals('Exception Variable name','Y',O.VariableName);
  1576. AssertEquals('Exception Type name','Exception2',O.TypeName);
  1577. S:=TPasImplSimple(O.Elements[0]);
  1578. AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse2');
  1579. end;
  1580. procedure TTestStatementParser.TestTryExceptOnElse;
  1581. Var
  1582. T : TPasImplTry;
  1583. S : TPasImplSimple;
  1584. E : TPasImplTryExcept;
  1585. O : TPasImplExceptOn;
  1586. EE : TPasImplTryExceptElse;
  1587. I : TPasImplIfElse;
  1588. begin
  1589. DeclareVar('Boolean','b');
  1590. // Check that Else belongs to Except, not to IF
  1591. TestStatement(['Try',' DoSomething;','except','On E : Exception do','if b then','DoSomethingElse;','else','DoSomethingMore;','end']);
  1592. T:=AssertStatement('Try statement',TPasImplTry) as TPasImplTry;
  1593. AssertEquals(1,T.Elements.Count);
  1594. AssertNotNull(T.FinallyExcept);
  1595. AssertNotNull(T.ElseBranch);
  1596. AssertNotNull(T.Elements[0]);
  1597. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1598. S:=TPasImplSimple(T.Elements[0]);
  1599. AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomething');
  1600. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1601. AssertEquals('Except statement',TPasImplTryExcept,T.FinallyExcept.ClassType);
  1602. E:=TPasImplTryExcept(T.FinallyExcept);
  1603. AssertEquals(1,E.Elements.Count);
  1604. AssertEquals('Except on handler',TPasImplExceptOn,TPasElement(E.Elements[0]).ClassType);
  1605. O:=TPasImplExceptOn(E.Elements[0]);
  1606. AssertEquals('Exception Variable name','E',O.VariableName);
  1607. AssertEquals('Exception Type name','Exception',O.TypeName);
  1608. AssertEquals(1,O.Elements.Count);
  1609. AssertEquals('Simple statement',TPasImplIfElse,TPasElement(O.Elements[0]).ClassType);
  1610. I:=TPasImplIfElse(O.Elements[0]);
  1611. AssertEquals(1,I.Elements.Count);
  1612. AssertNull('No else barcnh for if',I.ElseBranch);
  1613. AssertEquals('Simple statement',TPasImplSimple,TPasElement(I.Elements[0]).ClassType);
  1614. S:=TPasImplSimple(I.Elements[0]);
  1615. AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse');
  1616. AssertEquals('Except Else statement',TPasImplTryExceptElse,T.ElseBranch.ClassType);
  1617. EE:=TPasImplTryExceptElse(T.ElseBranch);
  1618. AssertEquals(1,EE.Elements.Count);
  1619. AssertNotNull(EE.Elements[0]);
  1620. AssertEquals('Simple statement',TPasImplSimple,TPasElement(EE.Elements[0]).ClassType);
  1621. S:=TPasImplSimple(EE.Elements[0]);
  1622. AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomethingMore');
  1623. end;
  1624. procedure TTestStatementParser.TestTryExceptOnIfElse;
  1625. Var
  1626. T : TPasImplTry;
  1627. S : TPasImplSimple;
  1628. E : TPasImplTryExcept;
  1629. O : TPasImplExceptOn;
  1630. EE : TPasImplTryExceptElse;
  1631. begin
  1632. TestStatement(['Try',' DoSomething;','except','On E : Exception do','DoSomethingElse;','else','DoSomethingMore;','end']);
  1633. T:=AssertStatement('Try statement',TPasImplTry) as TPasImplTry;
  1634. AssertEquals(1,T.Elements.Count);
  1635. AssertNotNull(T.FinallyExcept);
  1636. AssertNotNull(T.ElseBranch);
  1637. AssertNotNull(T.Elements[0]);
  1638. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1639. S:=TPasImplSimple(T.Elements[0]);
  1640. AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomething');
  1641. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1642. AssertEquals('Except statement',TPasImplTryExcept,T.FinallyExcept.ClassType);
  1643. E:=TPasImplTryExcept(T.FinallyExcept);
  1644. AssertEquals(1,E.Elements.Count);
  1645. AssertEquals('Except on handler',TPasImplExceptOn,TPasElement(E.Elements[0]).ClassType);
  1646. O:=TPasImplExceptOn(E.Elements[0]);
  1647. AssertEquals('Exception Variable name','E',O.VariableName);
  1648. AssertEquals('Exception Type name','Exception',O.TypeName);
  1649. AssertEquals(1,O.Elements.Count);
  1650. AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
  1651. S:=TPasImplSimple(O.Elements[0]);
  1652. AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse');
  1653. AssertEquals('Except Else statement',TPasImplTryExceptElse,T.ElseBranch.ClassType);
  1654. EE:=TPasImplTryExceptElse(T.ElseBranch);
  1655. AssertEquals(1,EE.Elements.Count);
  1656. AssertNotNull(EE.Elements[0]);
  1657. AssertEquals('Simple statement',TPasImplSimple,TPasElement(EE.Elements[0]).ClassType);
  1658. S:=TPasImplSimple(EE.Elements[0]);
  1659. AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomethingMore');
  1660. end;
  1661. procedure TTestStatementParser.TestTryExceptOnElseNoSemicolo;
  1662. Var
  1663. T : TPasImplTry;
  1664. S : TPasImplSimple;
  1665. E : TPasImplTryExcept;
  1666. O : TPasImplExceptOn;
  1667. EE : TPasImplTryExceptElse;
  1668. begin
  1669. TestStatement(['Try',' DoSomething;','except','On E : Exception do','DoSomethingElse','else','DoSomethingMore','end']);
  1670. T:=AssertStatement('Try statement',TPasImplTry) as TPasImplTry;
  1671. AssertEquals(1,T.Elements.Count);
  1672. AssertNotNull(T.FinallyExcept);
  1673. AssertNotNull(T.ElseBranch);
  1674. AssertNotNull(T.Elements[0]);
  1675. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1676. S:=TPasImplSimple(T.Elements[0]);
  1677. AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomething');
  1678. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1679. AssertEquals('Except statement',TPasImplTryExcept,T.FinallyExcept.ClassType);
  1680. E:=TPasImplTryExcept(T.FinallyExcept);
  1681. AssertEquals(1,E.Elements.Count);
  1682. AssertEquals('Except on handler',TPasImplExceptOn,TPasElement(E.Elements[0]).ClassType);
  1683. O:=TPasImplExceptOn(E.Elements[0]);
  1684. AssertEquals('Exception Variable name','E',O.VariableName);
  1685. AssertEquals('Exception Type name','Exception',O.TypeName);
  1686. AssertEquals(1,O.Elements.Count);
  1687. AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
  1688. S:=TPasImplSimple(O.Elements[0]);
  1689. AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse');
  1690. AssertEquals('Except Else statement',TPasImplTryExceptElse,T.ElseBranch.ClassType);
  1691. EE:=TPasImplTryExceptElse(T.ElseBranch);
  1692. AssertEquals(1,EE.Elements.Count);
  1693. AssertNotNull(EE.Elements[0]);
  1694. AssertEquals('Simple statement',TPasImplSimple,TPasElement(EE.Elements[0]).ClassType);
  1695. S:=TPasImplSimple(EE.Elements[0]);
  1696. AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomethingMore');
  1697. end;
  1698. procedure TTestStatementParser.TestTryExceptRaise;
  1699. Var
  1700. T : TPasImplTry;
  1701. S : TPasImplSimple;
  1702. E : TPasImplTryExcept;
  1703. begin
  1704. TestStatement(['Try',' DoSomething;','except',' raise','end']);
  1705. T:=AssertStatement('Try statement',TPasImplTry) as TPasImplTry;
  1706. AssertEquals(1,T.Elements.Count);
  1707. AssertNotNull(T.FinallyExcept);
  1708. AssertNull(T.ElseBranch);
  1709. AssertNotNull(T.Elements[0]);
  1710. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1711. S:=TPasImplSimple(T.Elements[0]);
  1712. AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomething');
  1713. AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
  1714. AssertEquals('Except statement',TPasImplTryExcept,T.FinallyExcept.ClassType);
  1715. E:=TPasImplTryExcept(T.FinallyExcept);
  1716. AssertEquals(1,E.Elements.Count);
  1717. AssertEquals('Raise statement',TPasImplRaise,TPasElement(E.Elements[0]).ClassType);
  1718. end;
  1719. procedure TTestStatementParser.TestAsm;
  1720. Var
  1721. T : TPasImplAsmStatement;
  1722. begin
  1723. TestStatement(['asm',' mov eax,1','end;']);
  1724. T:=AssertStatement('Asm statement',TPasImplAsmStatement) as TPasImplAsmStatement;
  1725. AssertEquals('Asm tokens',4,T.Tokens.Count);
  1726. AssertEquals('token 1 ','mov',T.Tokens[0]);
  1727. AssertEquals('token 2 ','eax',T.Tokens[1]);
  1728. AssertEquals('token 3 ',',',T.Tokens[2]);
  1729. AssertEquals('token 4 ','1',T.Tokens[3]);
  1730. end;
  1731. procedure TTestStatementParser.TestAsmBlock;
  1732. begin
  1733. Source.Add('{$MODE DELPHI}');
  1734. Source.Add('function BitsHighest(X: Cardinal): Integer;');
  1735. Source.Add('asm');
  1736. Source.Add('end;');
  1737. Source.Add('begin');
  1738. Source.Add('end.');
  1739. ParseModule;
  1740. end;
  1741. procedure TTestStatementParser.TestAsmBlockWithEndLabel;
  1742. begin
  1743. Source.Add('{$MODE DELPHI}');
  1744. Source.Add('function BitsHighest(X: Cardinal): Integer;');
  1745. Source.Add('asm');
  1746. Source.Add(' MOV ECX, EAX');
  1747. Source.Add(' MOV EAX, -1');
  1748. Source.Add(' BSR EAX, ECX');
  1749. Source.Add(' JNZ @@End');
  1750. Source.Add(' MOV EAX, -1');
  1751. Source.Add('@@End:');
  1752. Source.Add('end;');
  1753. Source.Add('begin');
  1754. Source.Add('end.');
  1755. ParseModule;
  1756. end;
  1757. procedure TTestStatementParser.TestAsmBlockInIfThen;
  1758. begin
  1759. Source.Add('{$MODE DELPHI}');
  1760. Source.Add('function Get8087StatusWord(ClearExceptions: Boolean): Word;');
  1761. Source.Add(' begin');
  1762. Source.Add(' if ClearExceptions then');
  1763. Source.Add(' asm');
  1764. Source.Add(' end');
  1765. Source.Add(' else');
  1766. Source.Add(' asm');
  1767. Source.Add(' end;');
  1768. Source.Add(' end;');
  1769. Source.Add(' begin');
  1770. Source.Add(' end.');
  1771. ParseModule;
  1772. end;
  1773. procedure TTestStatementParser.TestAssignToAddress;
  1774. begin
  1775. AddStatements(['@Proc:=Nil']);
  1776. ParseModule;
  1777. end;
  1778. procedure TTestStatementParser.TestFinalizationNoSemicolon;
  1779. begin
  1780. Source.Add('unit afile;');
  1781. Source.Add('{$mode objfpc}');
  1782. Source.Add('interface');
  1783. Source.Add('implementation');
  1784. Source.Add('initialization');
  1785. Source.Add(' writeln(''qqq'')');
  1786. Source.Add('finalization');
  1787. Source.Add(' write(''rrr'')');
  1788. ParseModule;
  1789. end;
  1790. procedure TTestStatementParser.TestMacroComment;
  1791. begin
  1792. AddStatements(['{$MACRO ON}',
  1793. '{$DEFINE func := //}',
  1794. ' calltest;',
  1795. ' func (''1'',''2'',''3'');',
  1796. 'CallTest2;'
  1797. ]);
  1798. ParseModule;
  1799. end;
  1800. procedure TTestStatementParser.TestPlatformIdentifier;
  1801. begin
  1802. AddStatements(['write(platform);']);
  1803. ParseModule;
  1804. end;
  1805. procedure TTestStatementParser.TestPlatformIdentifier2;
  1806. begin
  1807. AddStatements(['write(libs+platform);']);
  1808. ParseModule;
  1809. end;
  1810. procedure TTestStatementParser.TestArgumentNameOn;
  1811. begin
  1812. Source.Add('function TryOn(const on: boolean): boolean;');
  1813. Source.Add(' begin');
  1814. Source.Add(' end;');
  1815. Source.Add(' begin');
  1816. Source.Add(' end.');
  1817. ParseModule;
  1818. end;
  1819. procedure TTestStatementParser.TestInlineVarDeclaration;
  1820. begin
  1821. AddStatements([
  1822. '{$modeswitch inlinevars}',
  1823. 'var a : integer;'
  1824. ]);
  1825. ParseModule;
  1826. AssertStatement('Var declaration statement',TPasInlineVarDeclStatement);
  1827. end;
  1828. procedure TTestStatementParser.TestInlineVarDeclarationDotted;
  1829. begin
  1830. AddStatements([
  1831. '{$modeswitch inlinevars}',
  1832. 'var a := c.d(x);'
  1833. ]);
  1834. ParseModule;
  1835. AssertStatement('Var declaration statement',TPasInlineVarDeclStatement);
  1836. end;
  1837. procedure TTestStatementParser.TestInlineVarDeclarationNoType;
  1838. begin
  1839. AddStatements([
  1840. '{$modeswitch inlinevars}',
  1841. 'var a := 1;'
  1842. ]);
  1843. ParseModule;
  1844. AssertStatement('Var declaration statement',TPasInlineVarDeclStatement);
  1845. end;
  1846. procedure TTestStatementParser.TestGotoInIfThen;
  1847. begin
  1848. AddStatements([
  1849. '{$goto on}',
  1850. 'if expr then',
  1851. ' dosomething',
  1852. ' else if expr2 then',
  1853. ' goto try_qword',
  1854. ' else',
  1855. ' dosomething;',
  1856. ' try_qword:',
  1857. ' dosomething;']);
  1858. ParseModule;
  1859. end;
  1860. initialization
  1861. RegisterTests([TTestStatementParser]);
  1862. end.