tcstatements.pas 62 KB

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