tcstatements.pas 64 KB

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