tcstatements.pas 63 KB

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