tcstatements.pas 72 KB

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