tcstatements.pas 72 KB

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