tcstatements.pas 68 KB

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