tcpaswritestatements.pas 98 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595
  1. {
  2. Examples:
  3. ./testpassrc --suite=TTestStatementParser.TestCallQualified2
  4. }
  5. unit tcPasWriteStatements;
  6. {$mode objfpc}{$H+}
  7. interface
  8. uses
  9. Classes, SysUtils, fpcunit, PasTree, PScanner, PParser, PasWrite,
  10. tcbaseparser, testregistry;
  11. type
  12. { TTestStatementWriterBase }
  13. TTestStatementWriterBase = class(TTestParser)
  14. private
  15. FPasWriter: TPasWriter;
  16. FStatement: TPasImplBlock;
  17. FTestStream: TMemoryStream;
  18. FVariables: TStrings;
  19. procedure TestCallFormat(FN: string; AddPrecision: boolean;
  20. AddSecondParam: boolean = False);
  21. protected
  22. procedure SetUp; override;
  23. procedure TearDown; override;
  24. procedure AddStatements(ASource: array of string);
  25. function BuildString(ASource: array of string): string;
  26. procedure DeclareVar(const AVarType: string; const AVarName: string = 'A');
  27. function TestStatement(ASource: string): TPasImplElement;
  28. function TestStatement(ASource: array of string): TPasImplElement;
  29. procedure ExpectParserError(const Msg: string);
  30. procedure ExpectParserError(const Msg: string; ASource: array of string);
  31. function AssertStatement(Msg: string;
  32. AClass: TClass; AIndex: integer = 0): TPasImplBlock;
  33. procedure AssertPasWriteOutput(Msg, ExpResult: string; aProgram: TPasElement);
  34. property Statement: TPasImplBlock read FStatement;
  35. published
  36. end;
  37. { TTestStatementWriterEmpty }
  38. TTestStatementWriterEmpty = class(TTestStatementWriterBase)
  39. published
  40. procedure TestEmpty;
  41. procedure TestEmptyStatement;
  42. procedure TestEmptyStatements;
  43. end;
  44. { TTestStatementWriterBlock }
  45. TTestStatementWriterBlock = class(TTestStatementWriterBase)
  46. published
  47. procedure TestBlock;
  48. procedure TestBlockComment;
  49. procedure TestBlock2Comments;
  50. end;
  51. { TTestStatementWriterAssignment }
  52. TTestStatementWriterAssignment = class(TTestStatementWriterBase)
  53. published
  54. procedure TestAssignment;
  55. procedure TestAssignmentAdd;
  56. procedure TestAssignmentMinus;
  57. procedure TestAssignmentMul;
  58. procedure TestAssignmentDivision;
  59. // Procedure TestAssignmentMissingSemicolonError;
  60. end;
  61. { TTestStatementWriterCall }
  62. TTestStatementWriterCall = class(TTestStatementWriterBase)
  63. published
  64. procedure TestCall;
  65. procedure TestCallComment;
  66. procedure TestCallQualified;
  67. procedure TestCallQualified2;
  68. procedure TestCallNoArgs;
  69. procedure TestCallOneArg;
  70. procedure TestCallWriteFormat1;
  71. procedure TestCallWriteFormat2;
  72. procedure TestCallWriteFormat3;
  73. procedure TestCallWriteFormat4;
  74. procedure TestCallWritelnFormat1;
  75. procedure TestCallWritelnFormat2;
  76. procedure TestCallStrFormat1;
  77. procedure TestCallStrFormat2;
  78. end;
  79. { TTestStatementWriterIf }
  80. TTestStatementWriterIf = class(TTestStatementWriterBase)
  81. published
  82. procedure TestIf;
  83. procedure TestIfBlock;
  84. procedure TestIfAssignment;
  85. procedure TestIfElse;
  86. procedure TestIfElseBlock;
  87. procedure TestIfElseInBlock;
  88. procedure TestIfforElseBlock;
  89. procedure TestIfRaiseElseBlock;
  90. procedure TestIfWithBlock;
  91. procedure TestNestedIf;
  92. procedure TestNestedIfElse;
  93. procedure TestNestedIfElseElse;
  94. procedure TestIfIfElseElseBlock;
  95. end;
  96. { TTestStatementWriterLoops }
  97. TTestStatementWriterLoops = class(TTestStatementWriterBase)
  98. published
  99. procedure TestWhile;
  100. procedure TestWhileBlock;
  101. procedure TestWhileNested;
  102. procedure TestRepeat;
  103. procedure TestRepeatBlock;
  104. procedure TestRepeatBlockNosemicolon;
  105. procedure TestRepeatNested;
  106. procedure TestFor;
  107. procedure TestForIn;
  108. procedure TestForExpr;
  109. procedure TestForBlock;
  110. procedure TestDowntoBlock;
  111. procedure TestForNested;
  112. end;
  113. { TTestStatementWriterWith }
  114. TTestStatementWriterWith = class(TTestStatementWriterBase)
  115. published
  116. procedure TestWith;
  117. procedure TestWithMultiple;
  118. end;
  119. { TTestStatementWriterCase }
  120. TTestStatementWriterCase = class(TTestStatementWriterBase)
  121. published
  122. //Procedure TestCaseEmpty;
  123. procedure TestCaseOneInteger;
  124. procedure TestCaseTwoIntegers;
  125. procedure TestCaseRange;
  126. procedure TestCaseRangeSeparate;
  127. procedure TestCase2Cases;
  128. procedure TestCaseBlock;
  129. procedure TestCaseElseBlockEmpty;
  130. procedure TestCaseOtherwiseBlockEmpty;
  131. procedure TestCaseElseBlockAssignment;
  132. procedure TestCaseElseBlock2Assignments;
  133. procedure TestCaseIfCaseElse;
  134. procedure TestCaseIfCaseElseElse;
  135. procedure TestCaseIfElse;
  136. procedure TestCaseElseNoSemicolon;
  137. procedure TestCaseIfElseNoSemicolon;
  138. procedure TestCaseIfOtherwiseNoSemicolon;
  139. end;
  140. { TTestStatementWriterRaise }
  141. TTestStatementWriterRaise = class(TTestStatementWriterBase)
  142. published
  143. procedure TestRaise;
  144. procedure TestRaiseEmpty;
  145. procedure TestRaiseAt;
  146. end;
  147. { TTestStatementWriterTry }
  148. TTestStatementWriterTry = class(TTestStatementWriterBase)
  149. published
  150. procedure TestTryFinally;
  151. procedure TestTryFinallyEmpty;
  152. procedure TestTryFinallyNested;
  153. procedure TestTryExcept;
  154. procedure TestTryExceptNested;
  155. procedure TestTryExceptEmpty;
  156. procedure TestTryExceptOn;
  157. procedure TestTryExceptOn2;
  158. procedure TestTryExceptOnElse;
  159. procedure TestTryExceptOnIfElse;
  160. procedure TestTryExceptOnElseNoSemicolo;
  161. procedure TestTryExceptRaise;
  162. end;
  163. { TTestStatementWriterAsm }
  164. TTestStatementWriterAsm = class(TTestStatementWriterBase)
  165. published
  166. procedure TestAsm;
  167. procedure TestAsmBlock;
  168. procedure TestAsmBlockWithEndLabel;
  169. procedure TestAsmBlockInIfThen;
  170. end;
  171. { TTestStatementWriterSpecials }
  172. TTestStatementWriterSpecials = class(TTestStatementWriterBase)
  173. published
  174. procedure TestGotoInIfThen;
  175. procedure TestAssignToAddress;
  176. procedure TestFinalizationNoSemicolon;
  177. procedure TestMacroComment;
  178. procedure TestPlatformIdentifier;
  179. procedure TestPlatformIdentifier2;
  180. procedure TestArgumentNameOn;
  181. end;
  182. implementation
  183. { TTestStatementWriterBase }
  184. procedure TTestStatementWriterBase.SetUp;
  185. begin
  186. inherited SetUp;
  187. FVariables := TStringList.Create;
  188. FTestStream := TMemoryStream.Create;
  189. FPasWriter := TPasWriter.Create(FTestStream);
  190. end;
  191. procedure TTestStatementWriterBase.TearDown;
  192. begin
  193. FreeAndNil(FPasWriter);
  194. FreeAndNil(FTestStream);
  195. FreeAndNil(FVariables);
  196. inherited TearDown;
  197. end;
  198. procedure TTestStatementWriterBase.AddStatements(ASource: array of string);
  199. var
  200. I: integer;
  201. begin
  202. StartProgram(ExtractFileUnitName(MainFilename));
  203. if FVariables.Count > 0 then
  204. begin
  205. Add('Var');
  206. for I := 0 to FVariables.Count - 1 do
  207. Add(' ' + Fvariables[I]);
  208. end;
  209. Add('begin');
  210. for I := Low(ASource) to High(ASource) do
  211. Add(' ' + ASource[i]);
  212. end;
  213. function TTestStatementWriterBase.BuildString(ASource: array of string): string;
  214. begin
  215. Result := string.Join(LineEnding, ASource);
  216. end;
  217. procedure TTestStatementWriterBase.DeclareVar(const AVarType: string;
  218. const AVarName: string);
  219. begin
  220. FVariables.Add(AVarName + ' : ' + AVarType + ';');
  221. end;
  222. function TTestStatementWriterBase.TestStatement(ASource: string): TPasImplElement;
  223. begin
  224. Result := TestStatement([ASource]);
  225. end;
  226. function TTestStatementWriterBase.TestStatement(ASource: array of string):
  227. TPasImplElement;
  228. begin
  229. Result := nil;
  230. FStatement := nil;
  231. AddStatements(ASource);
  232. ParseModule;
  233. AssertEquals('Have program', TPasProgram, Module.ClassType);
  234. AssertNotNull('Have program section', PasProgram.ProgramSection);
  235. AssertNotNull('Have initialization section', PasProgram.InitializationSection);
  236. if (PasProgram.InitializationSection.Elements.Count > 0) then
  237. if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then
  238. FStatement := TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
  239. Result := FStatement;
  240. end;
  241. procedure TTestStatementWriterBase.ExpectParserError(const Msg: string);
  242. begin
  243. AssertException(Msg, EParserError, @ParseModule);
  244. end;
  245. procedure TTestStatementWriterBase.ExpectParserError(const Msg: string;
  246. ASource: array of string);
  247. begin
  248. AddStatements(ASource);
  249. ExpectParserError(Msg);
  250. end;
  251. function TTestStatementWriterBase.AssertStatement(Msg: string;
  252. AClass: TClass; AIndex: integer): TPasImplBlock;
  253. begin
  254. if not (AIndex < PasProgram.InitializationSection.Elements.Count) then
  255. Fail(Msg + ': No such statement : ' + IntToStr(AIndex));
  256. AssertNotNull(Msg + ' Have statement', PasProgram.InitializationSection.Elements[AIndex]);
  257. AssertEquals(Msg + ' statement class', AClass, TObject(
  258. PasProgram.InitializationSection.Elements[AIndex]).ClassType);
  259. Result := TObject(PasProgram.InitializationSection.Elements[AIndex]) as TPasImplBlock;
  260. end;
  261. procedure TTestStatementWriterBase.AssertPasWriteOutput(Msg, ExpResult: string;
  262. aProgram: TPasElement);
  263. var
  264. aString: string;
  265. begin
  266. FPasWriter.WriteElement(aProgram);
  267. FTestStream.Seek(0, soBeginning);
  268. setlength(aString, FTestStream.Size);
  269. FTestStream.ReadBuffer(aString[1], FTestStream.Size);
  270. AssertEquals(Testname + ': ' + Msg, ExpResult, aString);
  271. AssertEquals(Testname + ': Streamsize', length(expResult), FTestStream.Size);
  272. end;
  273. // Tests -----------------------------------------------------------------
  274. procedure TTestStatementWriterEmpty.TestEmpty;
  275. begin
  276. //TestStatement(';');
  277. TestStatement('');
  278. AssertEquals('No statements', 0, PasProgram.InitializationSection.Elements.Count);
  279. AssertPasWriteOutput('output', 'program afile;'#13#10#13#10#13#10'begin'#13#10'end.'#13#10, PasProgram);
  280. end;
  281. procedure TTestStatementWriterEmpty.TestEmptyStatement;
  282. begin
  283. TestStatement(';');
  284. AssertEquals('0 statement', 0, PasProgram.InitializationSection.Elements.Count);
  285. AssertPasWriteOutput('output', 'program afile;'#13#10#13#10#13#10'begin'#13#10'end.'#13#10, PasProgram);
  286. end;
  287. procedure TTestStatementWriterEmpty.TestEmptyStatements;
  288. begin
  289. TestStatement(';;');
  290. AssertEquals('0 statement', 0, PasProgram.InitializationSection.Elements.Count);
  291. AssertPasWriteOutput('output', BuildString(['program afile;',
  292. '', '', 'begin', 'end.', '']), PasProgram);
  293. end;
  294. procedure TTestStatementWriterBlock.TestBlock;
  295. var
  296. B: TPasImplBeginBlock;
  297. begin
  298. TestStatement(['begin', 'end']);
  299. AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
  300. AssertNotNull('Statement assigned', PasProgram.InitializationSection.Elements[0]);
  301. AssertEquals('Block statement', TPasImplBeginBlock, Statement.ClassType);
  302. B := Statement as TPasImplBeginBlock;
  303. AssertEquals('Empty block', 0, B.Elements.Count);
  304. AssertPasWriteOutput('output', BuildString(['program afile;',
  305. '', '', 'begin', 'begin', 'end;', 'end.', '']),
  306. PasProgram);
  307. end;
  308. procedure TTestStatementWriterBlock.TestBlockComment;
  309. var
  310. B: TPasImplBeginBlock;
  311. begin
  312. Engine.NeedComments := True;
  313. TestStatement(['{ This is a comment }', 'begin', 'end']);
  314. AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
  315. AssertNotNull('Statement assigned', PasProgram.InitializationSection.Elements[0]);
  316. AssertEquals('Block statement', TPasImplBeginBlock, Statement.ClassType);
  317. B := Statement as TPasImplBeginBlock;
  318. AssertEquals('Empty block', 0, B.Elements.Count);
  319. AssertEquals('No DocComment', '', B.DocComment);
  320. AssertPasWriteOutput('output', BuildString(['program afile;',
  321. '', '', 'begin', 'begin', 'end;', 'end.', '']),
  322. PasProgram);
  323. end;
  324. procedure TTestStatementWriterBlock.TestBlock2Comments;
  325. var
  326. B: TPasImplBeginBlock;
  327. begin
  328. Engine.NeedComments := True;
  329. TestStatement(['{ This is a comment }', '// Another comment', 'begin', 'end']);
  330. AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
  331. AssertNotNull('Statement assigned', PasProgram.InitializationSection.Elements[0]);
  332. AssertEquals('Block statement', TPasImplBeginBlock, Statement.ClassType);
  333. B := Statement as TPasImplBeginBlock;
  334. AssertEquals('Empty block', 0, B.Elements.Count);
  335. AssertEquals('No DocComment', '', B.DocComment);
  336. AssertPasWriteOutput('output', BuildString(['program afile;',
  337. '', '', 'begin', 'begin', 'end;', 'end.', '']),
  338. PasProgram);
  339. end;
  340. procedure TTestStatementWriterAssignment.TestAssignment;
  341. var
  342. A: TPasImplAssign;
  343. begin
  344. DeclareVar('integer');
  345. TestStatement(['a:=1;']);
  346. AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
  347. AssertEquals('Assignment statement', TPasImplAssign, Statement.ClassType);
  348. A := Statement as TPasImplAssign;
  349. AssertEquals('Normal assignment', akDefault, A.Kind);
  350. AssertExpression('Right side is constant', A.Right, pekNumber, '1');
  351. AssertExpression('Left side is variable', A.Left, pekIdent, 'a');
  352. AssertPasWriteOutput('output', BuildString(['program afile;',
  353. '', 'var', ' A: Integer;', '', 'begin',
  354. ' a := 1;', 'end.', '']), PasProgram);
  355. end;
  356. procedure TTestStatementWriterAssignment.TestAssignmentAdd;
  357. var
  358. A: TPasImplAssign;
  359. begin
  360. Parser.Scanner.Options := [po_cassignments];
  361. DeclareVar('integer');
  362. TestStatement(['a+=1;']);
  363. AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
  364. AssertEquals('Assignment statement', TPasImplAssign, Statement.ClassType);
  365. A := Statement as TPasImplAssign;
  366. AssertEquals('Add assignment', akAdd, A.Kind);
  367. AssertExpression('Right side is constant', A.Right, pekNumber, '1');
  368. AssertExpression('Left side is variable', A.Left, pekIdent, 'a');
  369. AssertPasWriteOutput('output', BuildString(['program afile;',
  370. '', 'var', ' A: Integer;', '', 'begin',
  371. ' a += 1;', 'end.', '']), PasProgram);
  372. end;
  373. procedure TTestStatementWriterAssignment.TestAssignmentMinus;
  374. var
  375. A: TPasImplAssign;
  376. begin
  377. Parser.Scanner.Options := [po_cassignments];
  378. DeclareVar('integer');
  379. TestStatement(['a-=1;']);
  380. AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
  381. AssertEquals('Assignment statement', TPasImplAssign, Statement.ClassType);
  382. A := Statement as TPasImplAssign;
  383. AssertEquals('Minus assignment', akMinus, A.Kind);
  384. AssertExpression('Right side is constant', A.Right, pekNumber, '1');
  385. AssertExpression('Left side is variable', A.Left, pekIdent, 'a');
  386. AssertPasWriteOutput('output', BuildString(['program afile;',
  387. '', 'var', ' A: Integer;', '', 'begin',
  388. ' a -= 1;', 'end.', '']), PasProgram);
  389. end;
  390. procedure TTestStatementWriterAssignment.TestAssignmentMul;
  391. var
  392. A: TPasImplAssign;
  393. begin
  394. Parser.Scanner.Options := [po_cassignments];
  395. DeclareVar('integer');
  396. TestStatement(['a*=1;']);
  397. AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
  398. AssertEquals('Assignment statement', TPasImplAssign, Statement.ClassType);
  399. A := Statement as TPasImplAssign;
  400. AssertEquals('Mul assignment', akMul, A.Kind);
  401. AssertExpression('Right side is constant', A.Right, pekNumber, '1');
  402. AssertExpression('Left side is variable', A.Left, pekIdent, 'a');
  403. AssertPasWriteOutput('output', BuildString(['program afile;',
  404. '', 'var', ' A: Integer;', '', 'begin',
  405. ' a *= 1;', 'end.', '']), PasProgram);
  406. end;
  407. procedure TTestStatementWriterAssignment.TestAssignmentDivision;
  408. var
  409. A: TPasImplAssign;
  410. begin
  411. Parser.Scanner.Options := [po_cassignments];
  412. DeclareVar('integer');
  413. TestStatement(['a/=1;']);
  414. AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
  415. AssertEquals('Assignment statement', TPasImplAssign, Statement.ClassType);
  416. A := Statement as TPasImplAssign;
  417. AssertEquals('Division assignment', akDivision, A.Kind);
  418. AssertExpression('Right side is constant', A.Right, pekNumber, '1');
  419. AssertExpression('Left side is variable', A.Left, pekIdent, 'a');
  420. AssertPasWriteOutput('output', BuildString(['program afile;',
  421. '', 'var', ' A: Integer;', '', 'begin',
  422. ' a /= 1;', 'end.', '']), PasProgram);
  423. end;
  424. procedure TTestStatementWriterCall.TestCall;
  425. var
  426. S: TPasImplSimple;
  427. begin
  428. TestStatement('Doit;');
  429. AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
  430. AssertEquals('Simple statement', TPasImplSimple, Statement.ClassType);
  431. S := Statement as TPasImplSimple;
  432. AssertExpression('Doit call', S.Expr, pekIdent, 'Doit');
  433. AssertPasWriteOutput('output', BuildString(['program afile;',
  434. '', '', 'begin', ' Doit;', 'end.', '']), PasProgram);
  435. end;
  436. procedure TTestStatementWriterCall.TestCallComment;
  437. var
  438. S: TPasImplSimple;
  439. begin
  440. Engine.NeedComments := True;
  441. TestStatement(['//comment line', 'Doit;']);
  442. AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
  443. AssertEquals('Simple statement', TPasImplSimple, Statement.ClassType);
  444. AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
  445. S := Statement as TPasImplSimple;
  446. AssertExpression('Doit call', S.Expr, pekIdent, 'Doit');
  447. AssertEquals('No DocComment', '', S.DocComment);
  448. AssertPasWriteOutput('output', BuildString(['program afile;',
  449. '', '', 'begin', ' Doit;', 'end.', '']), PasProgram);
  450. end;
  451. procedure TTestStatementWriterCall.TestCallQualified;
  452. var
  453. S: TPasImplSimple;
  454. B: TBinaryExpr;
  455. begin
  456. TestStatement('Unita.Doit;');
  457. AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
  458. AssertEquals('Simple statement', TPasImplSimple, Statement.ClassType);
  459. S := Statement as TPasImplSimple;
  460. AssertExpression('Doit call', S.Expr, pekBinary, TBinaryExpr);
  461. B := S.Expr as TBinaryExpr;
  462. TAssert.AssertSame('B.left.Parent=B', B, B.left.Parent);
  463. TAssert.AssertSame('B.right.Parent=B', B, B.right.Parent);
  464. AssertExpression('Unit name', B.Left, pekIdent, 'Unita');
  465. AssertExpression('Doit call', B.Right, pekIdent, 'Doit');
  466. AssertPasWriteOutput('output', BuildString(['program afile;',
  467. '', '', 'begin', ' Unita.Doit;', 'end.', '']),
  468. PasProgram);
  469. end;
  470. procedure TTestStatementWriterCall.TestCallQualified2;
  471. var
  472. S: TPasImplSimple;
  473. B: TBinaryExpr;
  474. begin
  475. TestStatement('Unita.ClassB.Doit;');
  476. AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
  477. AssertEquals('Simple statement', TPasImplSimple, Statement.ClassType);
  478. S := Statement as TPasImplSimple;
  479. AssertExpression('Doit call', S.Expr, pekBinary, TBinaryExpr);
  480. B := S.Expr as TBinaryExpr;
  481. AssertExpression('Doit call', B.Right, pekIdent, 'Doit');
  482. AssertExpression('First two parts of unit name', B.left, pekBinary, TBinaryExpr);
  483. B := B.left as TBinaryExpr;
  484. AssertExpression('Unit name part 1', B.Left, pekIdent, 'Unita');
  485. AssertExpression('Unit name part 2', B.right, pekIdent, 'ClassB');
  486. AssertPasWriteOutput('output', BuildString(['program afile;',
  487. '', '', 'begin', ' Unita.ClassB.Doit;', 'end.', '']),
  488. PasProgram);
  489. end;
  490. procedure TTestStatementWriterCall.TestCallNoArgs;
  491. var
  492. S: TPasImplSimple;
  493. P: TParamsExpr;
  494. begin
  495. TestStatement('Doit();');
  496. AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
  497. AssertEquals('Simple statement', TPasImplSimple, Statement.ClassType);
  498. S := Statement as TPasImplSimple;
  499. AssertExpression('Doit call', S.Expr, pekFuncParams, TParamsExpr);
  500. P := S.Expr as TParamsExpr;
  501. AssertExpression('Correct function call name', P.Value, pekIdent, 'Doit');
  502. AssertEquals('No params', 0, Length(P.Params));
  503. AssertPasWriteOutput('output', BuildString(['program afile;',
  504. '', '', 'begin', ' Doit();', 'end.', '']), PasProgram);
  505. end;
  506. procedure TTestStatementWriterCall.TestCallOneArg;
  507. var
  508. S: TPasImplSimple;
  509. P: TParamsExpr;
  510. begin
  511. TestStatement('Doit(1);');
  512. AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
  513. AssertEquals('Simple statement', TPasImplSimple, Statement.ClassType);
  514. S := Statement as TPasImplSimple;
  515. AssertExpression('Doit call', S.Expr, pekFuncParams, TParamsExpr);
  516. P := S.Expr as TParamsExpr;
  517. AssertExpression('Correct function call name', P.Value, pekIdent, 'Doit');
  518. AssertEquals('One param', 1, Length(P.Params));
  519. AssertExpression('Parameter is constant', P.Params[0], pekNumber, '1');
  520. AssertPasWriteOutput('output', BuildString(['program afile;',
  521. '', '', 'begin', ' Doit(1);', 'end.', '']), PasProgram);
  522. end;
  523. procedure TTestStatementWriterBase.TestCallFormat(FN: string;
  524. AddPrecision: boolean; AddSecondParam: boolean);
  525. var
  526. P: TParamsExpr;
  527. procedure CheckParam(Index: integer; const aParamName: string);
  528. begin
  529. AssertExpression('Parameter[' + IntToStr(Index) + '] is identifier',
  530. P.Params[Index], pekIdent, aParamName);
  531. AssertExpression('Parameter[' + IntToStr(Index) + '] has formatting constant 1'
  532. , P.Params[Index].format1, pekNumber, '3');
  533. if AddPrecision then
  534. AssertExpression('Parameter[' + IntToStr(Index) + '] has formatting constant 2',
  535. P.Params[Index].format2, pekNumber, '2');
  536. end;
  537. var
  538. S: TPasImplSimple;
  539. N: string;
  540. ArgCnt: integer;
  541. begin
  542. N := fn + '(a:3';
  543. if AddPrecision then
  544. N := N + ':2';
  545. ArgCnt := 1;
  546. if AddSecondParam then
  547. begin
  548. ArgCnt := 2;
  549. N := N + ',b:3';
  550. if AddPrecision then
  551. N := N + ':2';
  552. end;
  553. N := N + ');';
  554. TestStatement(N);
  555. AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
  556. AssertEquals('Simple statement', TPasImplSimple, Statement.ClassType);
  557. S := Statement as TPasImplSimple;
  558. AssertExpression('Doit call', S.Expr, pekFuncParams, TParamsExpr);
  559. P := S.Expr as TParamsExpr;
  560. AssertExpression('Correct function call name', P.Value, pekIdent, FN);
  561. AssertEquals(IntToStr(ArgCnt) + ' param', ArgCnt, Length(P.Params));
  562. CheckParam(0, 'a');
  563. if AddSecondParam then
  564. CheckParam(1, 'b');
  565. end;
  566. procedure TTestStatementWriterCall.TestCallWriteFormat1;
  567. begin
  568. TestCallFormat('write', False);
  569. AssertPasWriteOutput('output', BuildString(['program afile;',
  570. '', '', 'begin', ' write(a:3);', 'end.', '']),
  571. PasProgram);
  572. end;
  573. procedure TTestStatementWriterCall.TestCallWriteFormat2;
  574. begin
  575. TestCallFormat('write', True);
  576. AssertPasWriteOutput('output', BuildString(['program afile;',
  577. '', '', 'begin', ' write(a:3:2);', 'end.', '']),
  578. PasProgram);
  579. end;
  580. procedure TTestStatementWriterCall.TestCallWriteFormat3;
  581. begin
  582. TestCallFormat('write', False, True);
  583. AssertPasWriteOutput('output', BuildString(['program afile;',
  584. '', '', 'begin', ' write(a:3, b:3);', 'end.', '']),
  585. PasProgram);
  586. end;
  587. procedure TTestStatementWriterCall.TestCallWriteFormat4;
  588. begin
  589. TestCallFormat('write', True, True);
  590. AssertPasWriteOutput('output', BuildString(['program afile;',
  591. '', '', 'begin', ' write(a:3:2, b:3:2);',
  592. 'end.', '']), PasProgram);
  593. end;
  594. procedure TTestStatementWriterCall.TestCallWritelnFormat1;
  595. begin
  596. TestCallFormat('writeln', False);
  597. AssertPasWriteOutput('output', BuildString(['program afile;',
  598. '', '', 'begin', ' writeln(a:3);', 'end.', '']),
  599. PasProgram);
  600. end;
  601. procedure TTestStatementWriterCall.TestCallWritelnFormat2;
  602. begin
  603. TestCallFormat('writeln', True);
  604. AssertPasWriteOutput('output', BuildString(['program afile;',
  605. '', '', 'begin', ' writeln(a:3:2);', 'end.', '']),
  606. PasProgram);
  607. end;
  608. procedure TTestStatementWriterCall.TestCallStrFormat1;
  609. begin
  610. TestCallFormat('str', False);
  611. AssertPasWriteOutput('output', BuildString(['program afile;',
  612. '', '', 'begin', ' str(a:3);', 'end.', '']), PasProgram);
  613. end;
  614. procedure TTestStatementWriterCall.TestCallStrFormat2;
  615. begin
  616. TestCallFormat('str', True);
  617. AssertPasWriteOutput('output', BuildString(['program afile;',
  618. '', '', 'begin', ' str(a:3:2);', 'end.', '']),
  619. PasProgram);
  620. end;
  621. procedure TTestStatementWriterIf.TestIf;
  622. var
  623. I: TPasImplIfElse;
  624. begin
  625. DeclareVar('boolean');
  626. TestStatement(['if a then', ';']);
  627. I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
  628. AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
  629. AssertNull('No else', i.ElseBranch);
  630. AssertNull('No if branch', I.IfBranch);
  631. AssertPasWriteOutput('output', BuildString(['program afile;',
  632. '', 'var', ' A: Boolean;', '', 'begin',
  633. ' if a then;', 'end.', '']), PasProgram);
  634. end;
  635. procedure TTestStatementWriterIf.TestIfBlock;
  636. var
  637. I: TPasImplIfElse;
  638. begin
  639. DeclareVar('boolean');
  640. TestStatement(['if a then', ' begin', ' end']);
  641. I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
  642. AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
  643. AssertNull('No else', i.ElseBranch);
  644. AssertNotNull('if branch', I.IfBranch);
  645. AssertEquals('begin end block', TPasImplBeginBlock, I.ifBranch.ClassType);
  646. AssertPasWriteOutput('output', BuildString(['program afile;',
  647. '', 'var', ' A: Boolean;', '', 'begin',
  648. ' if a then', ' begin', ' end;', 'end.', '']),
  649. PasProgram);
  650. end;
  651. procedure TTestStatementWriterIf.TestIfAssignment;
  652. var
  653. I: TPasImplIfElse;
  654. begin
  655. DeclareVar('boolean');
  656. TestStatement(['if a then', ' a:=False;']);
  657. I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
  658. AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
  659. AssertNull('No else', i.ElseBranch);
  660. AssertNotNull('if branch', I.IfBranch);
  661. AssertEquals('assignment statement', TPasImplAssign, I.ifBranch.ClassType);
  662. AssertPasWriteOutput('output', BuildString(['program afile;',
  663. '', 'var', ' A: Boolean;', '', 'begin',
  664. ' if a then', ' a := False;', 'end.', '']), PasProgram);
  665. end;
  666. procedure TTestStatementWriterIf.TestIfElse;
  667. var
  668. I: TPasImplIfElse;
  669. begin
  670. DeclareVar('boolean');
  671. TestStatement(['if a then', ' begin', ' end', 'else', ';']);
  672. I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
  673. AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
  674. AssertNull('No else', i.ElseBranch);
  675. AssertNotNull('if branch', I.IfBranch);
  676. AssertEquals('begin end block', TPasImplBeginBlock, I.ifBranch.ClassType);
  677. AssertPasWriteOutput('output', BuildString(['program afile;',
  678. '', 'var', ' A: Boolean;', '', 'begin',
  679. ' if a then', ' begin', ' end;', 'end.', '']),
  680. PasProgram);
  681. end;
  682. procedure TTestStatementWriterIf.TestIfElseBlock;
  683. var
  684. I: TPasImplIfElse;
  685. begin
  686. DeclareVar('boolean');
  687. TestStatement(['if a then', ' begin', ' end', 'else', ' begin', ' end']);
  688. I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
  689. AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
  690. AssertNotNull('if branch', I.IfBranch);
  691. AssertEquals('begin end block', TPasImplBeginBlock, I.ifBranch.ClassType);
  692. AssertNotNull('Else branch', i.ElseBranch);
  693. AssertEquals('begin end block', TPasImplBeginBlock, I.ElseBranch.ClassType);
  694. AssertPasWriteOutput('output', BuildString(['program afile;',
  695. '', 'var', ' A: Boolean;', '', 'begin',
  696. ' if a then', ' begin', ' end else', ' begin',
  697. ' end;', 'end.', '']), PasProgram);
  698. end;
  699. procedure TTestStatementWriterIf.TestIfElseInBlock;
  700. var
  701. B: TPasImplBeginBlock;
  702. I: TPasImplIfElse;
  703. begin
  704. DeclareVar('boolean');
  705. TestStatement(['begin', ' if a then', ' DoA',
  706. ' else', 'end']);
  707. B := AssertStatement('begin block', TPasImplBeginBlock) as TPasImplBeginBlock;
  708. AssertEquals('One Element', 1, B.Elements.Count);
  709. AssertEquals('If statement', TPasImplIfElse, TObject(B.Elements[0]).ClassType);
  710. I := TPasImplIfElse(B.Elements[0]);
  711. AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
  712. AssertNotNull('if branch', I.IfBranch);
  713. AssertEquals('i_br: simple command', TPasImplSimple, I.ifBranch.ClassType);
  714. AssertExpression('Doit call', TPasImplSimple(I.ifBranch).Expr, pekIdent, 'DoA');
  715. AssertNull('Else branch', i.ElseBranch);
  716. AssertPasWriteOutput('output', BuildString(['program afile;',
  717. '', 'var', ' A: Boolean;', '', 'begin',
  718. 'begin', ' if a then', ' DoA;', 'end;',
  719. 'end.', '']), PasProgram);
  720. end;
  721. procedure TTestStatementWriterIf.TestIfforElseBlock;
  722. var
  723. I: TPasImplIfElse;
  724. begin
  725. TestStatement(['if a then', 'for X := 1 downto 0 do Writeln(X)', 'else',
  726. 'for X := 0 to 1 do Writeln(X)']);
  727. I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
  728. AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
  729. AssertEquals('For statement', TPasImplForLoop, I.ifBranch.ClassType);
  730. AssertEquals('For statement', TPasImplForLoop, I.ElseBranch.ClassType);
  731. AssertPasWriteOutput('output', BuildString(['program afile;',
  732. '', '', 'begin', ' if a then', ' begin',
  733. ' for X:=1 downto 0 do', ' Writeln(X);', ' end else',
  734. ' for X:=0 to 1 do', ' Writeln(X);', 'end.', '']),
  735. PasProgram);
  736. end;
  737. procedure TTestStatementWriterIf.TestIfRaiseElseBlock;
  738. // Error: to be searched for
  739. var
  740. I: TPasImplIfElse;
  741. begin
  742. TestStatement(['if a then', 'raise', 'else', 'for X := 0 to 1 do Writeln(X)']);
  743. I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
  744. AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
  745. AssertEquals('For statement', TPasImplRaise, I.ifBranch.ClassType);
  746. AssertEquals('For statement', TPasImplForLoop, I.ElseBranch.ClassType);
  747. AssertPasWriteOutput('output', BuildString(['program afile;', '',
  748. '', 'begin', ' if a then', ' begin', ' raise;', ' end else',
  749. ' for X:=0 to 1 do', ' Writeln(X);', 'end.', '']), PasProgram);
  750. end;
  751. procedure TTestStatementWriterIf.TestIfWithBlock;
  752. // Error: With not implemented
  753. var
  754. I: TPasImplIfElse;
  755. begin
  756. TestStatement(['if a then', 'with b do something', 'else',
  757. 'for X := 0 to 1 do Writeln(X)']);
  758. I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
  759. AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
  760. AssertEquals('For statement', TPasImplWithDo, I.ifBranch.ClassType);
  761. AssertEquals('For statement', TPasImplForLoop, I.ElseBranch.ClassType);
  762. AssertPasWriteOutput('output', BuildString(['program afile;',
  763. '', 'var', ' A: Boolean;', '', 'begin',
  764. ' if a then', ' with b do', ' something',
  765. ' else', ' for X:=0 to 1 do', ' Writeln(X);',
  766. 'end.', '']), PasProgram);
  767. end;
  768. procedure TTestStatementWriterIf.TestNestedIf;
  769. var
  770. I: TPasImplIfElse;
  771. begin
  772. DeclareVar('boolean');
  773. DeclareVar('boolean', 'b');
  774. TestStatement(['if a then', ' if b then', ' begin', ' end',
  775. 'else', ' begin', ' end']);
  776. I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
  777. AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
  778. AssertNotNull('if branch', I.IfBranch);
  779. AssertNull('Else branch', i.ElseBranch);
  780. AssertEquals('if in if branch', TPasImplIfElse, I.ifBranch.ClassType);
  781. I := I.Ifbranch as TPasImplIfElse;
  782. AssertEquals('begin end block', TPasImplBeginBlock, I.ElseBranch.ClassType);
  783. AssertPasWriteOutput('output', BuildString(['program afile;',
  784. '', 'var', ' A: Boolean;', ' b: Boolean;',
  785. '', 'begin', ' if a then', ' if b then',
  786. ' begin', ' end else', ' begin', ' end;',
  787. 'end.', '']), PasProgram);
  788. end;
  789. procedure TTestStatementWriterIf.TestNestedIfElse;
  790. var
  791. I: TPasImplIfElse;
  792. begin
  793. DeclareVar('boolean');
  794. TestStatement(['if a then', ' if b then', ' begin', ' end',
  795. ' else', ' begin', ' end', 'else', ' begin', 'end']);
  796. I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
  797. AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
  798. AssertNotNull('if branch', I.IfBranch);
  799. AssertNotNull('Else branch', i.ElseBranch);
  800. AssertEquals('begin end block', TPasImplBeginBlock, I.ElseBranch.ClassType);
  801. AssertEquals('if in if branch', TPasImplIfElse, I.ifBranch.ClassType);
  802. I := I.Ifbranch as TPasImplIfElse;
  803. AssertEquals('begin end block', TPasImplBeginBlock, I.ElseBranch.ClassType);
  804. AssertPasWriteOutput('output', BuildString(['program afile;',
  805. '', 'var', ' A: Boolean;', '', 'begin',
  806. ' if a then', ' begin', ' if b then', ' begin',
  807. ' end else', ' begin', ' end;', ' end else',
  808. ' begin', ' end;', 'end.', '']), PasProgram);
  809. end;
  810. procedure TTestStatementWriterIf.TestNestedIfElseElse;
  811. // Bug ID 37760
  812. var
  813. I, I2: TPasImplIfElse;
  814. begin
  815. DeclareVar('boolean');
  816. TestStatement(['if a then', ' if b then',
  817. ' DoA ', ' else', ' else',
  818. ' DoB']);
  819. I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
  820. AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
  821. AssertNotNull('if branch', I.IfBranch);
  822. AssertNotNull('Have else for outer if', I.ElseBranch);
  823. AssertEquals('Have if in if branch', TPasImplIfElse, I.ifBranch.ClassType);
  824. I2 := I.Ifbranch as TPasImplIfElse;
  825. AssertExpression('IF condition', I2.ConditionExpr, pekIdent, 'b');
  826. AssertNotNull('Have then for inner if', I2.ifBranch);
  827. AssertnotNull('Empty else for inner if', I2.ElseBranch);
  828. AssertEquals('Have a commend for inner if else', TPasImplCommand,
  829. I2.ElseBranch.ClassType);
  830. AssertEquals('... an empty command', '', TPasImplCommand(I2.ElseBranch).Command);
  831. AssertPasWriteOutput('output', BuildString(['program afile;',
  832. '', 'var', ' A: Boolean;', '', 'begin',
  833. ' if a then', ' begin', ' if b then', ' begin',
  834. ' DoA;', ' end else', ' end else', ' DoB;',
  835. 'end.', '']), PasProgram);
  836. end;
  837. procedure TTestStatementWriterIf.TestIfIfElseElseBlock;
  838. var
  839. OuterIf, InnerIf: TPasImplIfElse;
  840. begin
  841. DeclareVar('boolean');
  842. DeclareVar('boolean', 'B');
  843. TestStatement(['if a then', 'if b then', ' begin', ' end', 'else',
  844. 'else', ' begin', ' end']);
  845. OuterIf := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
  846. AssertExpression('IF condition', OuterIf.ConditionExpr, pekIdent, 'a');
  847. AssertNotNull('if branch', OuterIf.IfBranch);
  848. AssertEquals('if else block', TPasImplIfElse, OuterIf.ifBranch.ClassType);
  849. InnerIf := OuterIf.IfBranch as TPasImplIfElse;
  850. AssertExpression('IF condition', InnerIf.ConditionExpr, pekIdent, 'b');
  851. AssertNotNull('if branch', InnerIf.IfBranch);
  852. AssertEquals('begin end block', TPasImplBeginBlock, InnerIf.ifBranch.ClassType);
  853. AssertNotNull('Else branch', InnerIf.ElseBranch);
  854. AssertEquals('empty statement', TPasImplCommand, InnerIf.ElseBranch.ClassType);
  855. AssertEquals('empty command', '', TPasImplCommand(InnerIf.ElseBranch).Command);
  856. AssertNotNull('Else branch', OuterIf.ElseBranch);
  857. AssertEquals('begin end block', TPasImplBeginBlock, OuterIf.ElseBranch.ClassType);
  858. AssertPasWriteOutput('output', BuildString(['program afile;',
  859. '', 'var', ' A: Boolean;', ' B: Boolean;',
  860. '', 'begin', ' if a then', ' begin',
  861. ' if b then', ' begin', ' end else',
  862. ' end else', ' begin', ' end;', 'end.', '']), PasProgram);
  863. end;
  864. procedure TTestStatementWriterLoops.TestWhile;
  865. var
  866. W: TPasImplWhileDo;
  867. begin
  868. DeclareVar('boolean');
  869. TestStatement(['While a do ;']);
  870. W := AssertStatement('While statement', TPasImplWhileDo) as TPasImplWhileDo;
  871. AssertExpression('While condition', W.ConditionExpr, pekIdent, 'a');
  872. AssertNull('Empty body', W.Body);
  873. AssertPasWriteOutput('output', BuildString(['program afile;',
  874. '', 'var', ' A: Boolean;', '', 'begin',
  875. ' While a do;', 'end.', '']), PasProgram);
  876. end;
  877. procedure TTestStatementWriterLoops.TestWhileBlock;
  878. var
  879. W: TPasImplWhileDo;
  880. begin
  881. DeclareVar('boolean');
  882. TestStatement(['While a do', ' begin', ' end']);
  883. W := AssertStatement('While statement', TPasImplWhileDo) as TPasImplWhileDo;
  884. AssertExpression('While condition', W.ConditionExpr, pekIdent, 'a');
  885. AssertNotNull('Have while body', W.Body);
  886. AssertEquals('begin end block', TPasImplBeginBlock, W.Body.ClassType);
  887. AssertEquals('Empty block', 0, TPasImplBeginBlock(W.Body).ELements.Count);
  888. AssertPasWriteOutput('output', BuildString(['program afile;',
  889. '', 'var', ' A: Boolean;', '', 'begin',
  890. ' While a do', ' begin', ' end;', 'end.', '']), PasProgram);
  891. end;
  892. procedure TTestStatementWriterLoops.TestWhileNested;
  893. var
  894. W: TPasImplWhileDo;
  895. begin
  896. DeclareVar('boolean');
  897. DeclareVar('boolean', 'b');
  898. TestStatement(['While a do', ' while b do', ' begin', ' end']);
  899. W := AssertStatement('While statement', TPasImplWhileDo) as TPasImplWhileDo;
  900. AssertExpression('While condition', W.ConditionExpr, pekIdent, 'a');
  901. AssertNotNull('Have while body', W.Body);
  902. AssertEquals('Nested while', TPasImplWhileDo, W.Body.ClassType);
  903. W := W.Body as TPasImplWhileDo;
  904. AssertExpression('While condition', W.ConditionExpr, pekIdent, 'b');
  905. AssertNotNull('Have nested while body', W.Body);
  906. AssertEquals('Nested begin end block', TPasImplBeginBlock, W.Body.ClassType);
  907. AssertEquals('Empty nested block', 0, TPasImplBeginBlock(W.Body).ELements.Count);
  908. AssertPasWriteOutput('output', BuildString(['program afile;',
  909. '', 'var', ' A: Boolean;', ' b: Boolean;',
  910. '', 'begin', ' While a do', ' While b do',
  911. ' begin', ' end;', 'end.', '']), PasProgram);
  912. end;
  913. procedure TTestStatementWriterLoops.TestRepeat;
  914. var
  915. R: TPasImplRepeatUntil;
  916. begin
  917. DeclareVar('boolean');
  918. TestStatement(['Repeat', 'Until a;']);
  919. R := AssertStatement('Repeat statement', TPasImplRepeatUntil) as TPasImplRepeatUntil;
  920. AssertExpression('repeat condition', R.ConditionExpr, pekIdent, 'a');
  921. AssertEquals('Empty body', 0, R.Elements.Count);
  922. AssertPasWriteOutput('output', BuildString(['program afile;',
  923. '', 'var', ' A: Boolean;', '', 'begin',
  924. ' repeat', ' until a;', 'end.', '']), PasProgram);
  925. end;
  926. procedure TTestStatementWriterLoops.TestRepeatBlock;
  927. var
  928. R: TPasImplRepeatUntil;
  929. begin
  930. DeclareVar('boolean');
  931. TestStatement(['Repeat', 'begin', 'end;', 'Until a;']);
  932. R := AssertStatement('repeat statement', TPasImplRepeatUntil) as TPasImplRepeatUntil;
  933. AssertExpression('repeat condition', R.ConditionExpr, pekIdent, 'a');
  934. AssertEquals('Have statement', 1, R.Elements.Count);
  935. AssertEquals('begin end block', TPasImplBeginBlock, TObject(R.Elements[0]).ClassType);
  936. AssertEquals('Empty block', 0, TPasImplBeginBlock(R.Elements[0]).ELements.Count);
  937. AssertPasWriteOutput('output', BuildString(['program afile;',
  938. '', 'var', ' A: Boolean;', '', 'begin',
  939. ' repeat', ' begin', ' end;', ' until a;',
  940. 'end.', '']), PasProgram);
  941. end;
  942. procedure TTestStatementWriterLoops.TestRepeatBlockNosemicolon;
  943. var
  944. R: TPasImplRepeatUntil;
  945. begin
  946. DeclareVar('boolean');
  947. TestStatement(['Repeat', 'begin', 'end', 'Until a;']);
  948. R := AssertStatement('repeat statement', TPasImplRepeatUntil) as TPasImplRepeatUntil;
  949. AssertExpression('repeat condition', R.ConditionExpr, pekIdent, 'a');
  950. AssertEquals('Have statement', 1, R.Elements.Count);
  951. AssertEquals('begin end block', TPasImplBeginBlock, TObject(R.Elements[0]).ClassType);
  952. AssertEquals('Empty block', 0, TPasImplBeginBlock(R.Elements[0]).ELements.Count);
  953. AssertPasWriteOutput('output', BuildString(['program afile;',
  954. '', 'var', ' A: Boolean;', '', 'begin',
  955. ' repeat', ' begin', ' end;', ' until a;',
  956. 'end.', '']), PasProgram);
  957. end;
  958. procedure TTestStatementWriterLoops.TestRepeatNested;
  959. var
  960. R: TPasImplRepeatUntil;
  961. begin
  962. DeclareVar('boolean');
  963. DeclareVar('boolean', 'b');
  964. TestStatement(['Repeat', 'repeat', 'begin', 'end', 'until b', 'Until a;']);
  965. R := AssertStatement('repeat statement', TPasImplRepeatUntil) as TPasImplRepeatUntil;
  966. AssertExpression('repeat condition', R.ConditionExpr, pekIdent, 'a');
  967. AssertEquals('Have statement', 1, R.Elements.Count);
  968. AssertEquals('Nested repeat', TPasImplRepeatUntil, TObject(R.Elements[0]).ClassType);
  969. R := TPasImplRepeatUntil(R.Elements[0]);
  970. AssertExpression('repeat condition', R.ConditionExpr, pekIdent, 'b');
  971. AssertEquals('Have statement', 1, R.Elements.Count);
  972. AssertEquals('begin end block', TPasImplBeginBlock, TObject(R.Elements[0]).ClassType);
  973. AssertEquals('Empty block', 0, TPasImplBeginBlock(R.Elements[0]).ELements.Count);
  974. AssertPasWriteOutput('output', BuildString(['program afile;',
  975. '', 'var', ' A: Boolean;', ' b: Boolean;',
  976. '', 'begin', ' repeat', ' repeat', ' begin',
  977. ' end;', ' until b;', ' until a;', 'end.', '']),
  978. PasProgram);
  979. end;
  980. procedure TTestStatementWriterLoops.TestFor;
  981. var
  982. F: TPasImplForLoop;
  983. begin
  984. DeclareVar('integer');
  985. TestStatement(['For a:=1 to 10 do', ';']);
  986. F := AssertStatement('For statement', TPasImplForLoop) as TPasImplForLoop;
  987. AssertExpression('Loop variable name', F.VariableName, pekIdent, 'a');
  988. AssertEquals('Loop type', ltNormal, F.Looptype);
  989. AssertEquals('Up loop', False, F.Down);
  990. AssertExpression('Start value', F.StartExpr, pekNumber, '1');
  991. AssertExpression('End value', F.EndExpr, pekNumber, '10');
  992. AssertNull('Empty body', F.Body);
  993. AssertPasWriteOutput('output', BuildString(['program afile;',
  994. '', 'var', ' A: Integer;', '', 'begin',
  995. ' for a:=1 to 10 do;', 'end.', '']), PasProgram);
  996. end;
  997. procedure TTestStatementWriterLoops.TestForIn;
  998. var
  999. F: TPasImplForLoop;
  1000. begin
  1001. DeclareVar('integer');
  1002. TestStatement(['For a in SomeSet Do', ';']);
  1003. F := AssertStatement('For statement', TPasImplForLoop) as TPasImplForLoop;
  1004. AssertExpression('Loop variable name', F.VariableName, pekIdent, 'a');
  1005. AssertEquals('Loop type', ltIn, F.Looptype);
  1006. AssertEquals('In loop', False, F.Down);
  1007. AssertExpression('Start value', F.StartExpr, pekIdent, 'SomeSet');
  1008. AssertNull('Loop type', F.EndExpr);
  1009. AssertNull('Empty body', F.Body);
  1010. AssertPasWriteOutput('output', BuildString(['program afile;',
  1011. '', 'var', ' A: Integer;', '', 'begin',
  1012. ' for a in SomeSet do;', 'end.', '']), PasProgram);
  1013. end;
  1014. procedure TTestStatementWriterLoops.TestForExpr;
  1015. var
  1016. F: TPasImplForLoop;
  1017. B: TBinaryExpr;
  1018. begin
  1019. DeclareVar('integer');
  1020. TestStatement(['For a:=1+1 to 5+5 do', ';']);
  1021. F := AssertStatement('For statement', TPasImplForLoop) as TPasImplForLoop;
  1022. AssertExpression('Loop variable name', F.VariableName, pekIdent, 'a');
  1023. AssertEquals('Up loop', False, F.Down);
  1024. AssertExpression('Start expression', F.StartExpr, pekBinary, TBinaryExpr);
  1025. B := F.StartExpr as TBinaryExpr;
  1026. AssertExpression('Start value left', B.left, pekNumber, '1');
  1027. AssertExpression('Start value right', B.right, pekNumber, '1');
  1028. AssertExpression('Start expression', F.StartExpr, pekBinary, TBinaryExpr);
  1029. B := F.EndExpr as TBinaryExpr;
  1030. AssertExpression('End value left', B.left, pekNumber, '5');
  1031. AssertExpression('End value right', B.right, pekNumber, '5');
  1032. AssertNull('Empty body', F.Body);
  1033. AssertPasWriteOutput('output', BuildString(['program afile;',
  1034. '', 'var', ' A: Integer;', '', 'begin',
  1035. ' for a:=1 + 1 to 5 + 5 do;', 'end.', '']), PasProgram);
  1036. end;
  1037. procedure TTestStatementWriterLoops.TestForBlock;
  1038. var
  1039. F: TPasImplForLoop;
  1040. begin
  1041. DeclareVar('integer');
  1042. TestStatement(['For a:=1 to 10 do', 'begin', 'end']);
  1043. F := AssertStatement('For statement', TPasImplForLoop) as TPasImplForLoop;
  1044. AssertExpression('Loop variable name', F.VariableName, pekIdent, 'a');
  1045. AssertEquals('Up loop', False, F.Down);
  1046. AssertExpression('Start value', F.StartExpr, pekNumber, '1');
  1047. AssertExpression('End value', F.EndExpr, pekNumber, '10');
  1048. AssertNotNull('Have for body', F.Body);
  1049. AssertEquals('begin end block', TPasImplBeginBlock, F.Body.ClassType);
  1050. AssertEquals('Empty block', 0, TPasImplBeginBlock(F.Body).ELements.Count);
  1051. AssertPasWriteOutput('output', BuildString(['program afile;',
  1052. '', 'var', ' A: Integer;', '', 'begin',
  1053. ' for a:=1 to 10 do', ' begin', ' end;', 'end.', '']),
  1054. PasProgram);
  1055. end;
  1056. procedure TTestStatementWriterLoops.TestDowntoBlock;
  1057. var
  1058. F: TPasImplForLoop;
  1059. begin
  1060. DeclareVar('integer');
  1061. TestStatement(['For a:=10 downto 1 do', 'begin', 'end']);
  1062. F := AssertStatement('For statement', TPasImplForLoop) as TPasImplForLoop;
  1063. AssertExpression('Loop variable name', F.VariableName, pekIdent, 'a');
  1064. AssertEquals('Down loop', True, F.Down);
  1065. AssertExpression('Start value', F.StartExpr, pekNumber, '10');
  1066. AssertExpression('End value', F.EndExpr, pekNumber, '1');
  1067. AssertNotNull('Have for body', F.Body);
  1068. AssertEquals('begin end block', TPasImplBeginBlock, F.Body.ClassType);
  1069. AssertEquals('Empty block', 0, TPasImplBeginBlock(F.Body).ELements.Count);
  1070. AssertPasWriteOutput('output', BuildString(['program afile;',
  1071. '', 'var', ' A: Integer;', '', 'begin',
  1072. ' for a:=10 downto 1 do', ' begin', ' end;',
  1073. 'end.', '']), PasProgram);
  1074. end;
  1075. procedure TTestStatementWriterLoops.TestForNested;
  1076. var
  1077. F: TPasImplForLoop;
  1078. begin
  1079. DeclareVar('integer');
  1080. DeclareVar('integer', 'b');
  1081. TestStatement(['For a:=1 to 10 do', 'For b:=11 to 20 do', 'begin', 'end']);
  1082. F := AssertStatement('For statement', TPasImplForLoop) as TPasImplForLoop;
  1083. AssertExpression('Loop variable name', F.VariableName, pekIdent, 'a');
  1084. AssertEquals('Up loop', False, F.Down);
  1085. AssertExpression('Start value', F.StartExpr, pekNumber, '1');
  1086. AssertExpression('End value', F.EndExpr, pekNumber, '10');
  1087. AssertNotNull('Have while body', F.Body);
  1088. AssertEquals('begin end block', TPasImplForLoop, F.Body.ClassType);
  1089. F := F.Body as TPasImplForLoop;
  1090. AssertExpression('Loop variable name', F.VariableName, pekIdent, 'b');
  1091. AssertEquals('Up loop', False, F.Down);
  1092. AssertExpression('Start value', F.StartExpr, pekNumber, '11');
  1093. AssertExpression('End value', F.EndExpr, pekNumber, '20');
  1094. AssertNotNull('Have for body', F.Body);
  1095. AssertEquals('begin end block', TPasImplBeginBlock, F.Body.ClassType);
  1096. AssertEquals('Empty block', 0, TPasImplBeginBlock(F.Body).ELements.Count);
  1097. AssertPasWriteOutput('output', BuildString(['program afile;',
  1098. '', 'var', ' A: Integer;', ' b: Integer;',
  1099. '', 'begin', ' for a:=1 to 10 do', ' for b:=11 to 20 do',
  1100. ' begin', ' end;', 'end.', '']), PasProgram);
  1101. end;
  1102. procedure TTestStatementWriterWith.TestWith;
  1103. // not implemented yet
  1104. var
  1105. W: TpasImplWithDo;
  1106. begin
  1107. DeclareVar('record X,Y : Integer; end');
  1108. TestStatement(['With a do', 'begin', 'end']);
  1109. W := AssertStatement('For statement', TpasImplWithDo) as TpasImplWithDo;
  1110. AssertEquals('1 expression', 1, W.Expressions.Count);
  1111. AssertExpression('With identifier', TPasExpr(W.Expressions[0]), pekIdent, 'a');
  1112. AssertNotNull('Have with body', W.Body);
  1113. AssertEquals('begin end block', TPasImplBeginBlock, W.Body.ClassType);
  1114. AssertEquals('Empty block', 0, TPasImplBeginBlock(W.Body).ELements.Count);
  1115. AssertPasWriteOutput('output', BuildString(['program afile;',
  1116. '', 'var', ' A: record', ' X,Y: Integer;',
  1117. ' end;', '', 'begin', ' with a do', ' begin',
  1118. ' end;', 'end.', '']), PasProgram);
  1119. end;
  1120. procedure TTestStatementWriterWith.TestWithMultiple;
  1121. // not implemented yet
  1122. var
  1123. W: TpasImplWithDo;
  1124. begin
  1125. DeclareVar('record X,Y : Integer; end');
  1126. DeclareVar('record W,Z : Integer; end', 'b');
  1127. TestStatement(['With a,b do', 'begin', 'end']);
  1128. W := AssertStatement('For statement', TpasImplWithDo) as TpasImplWithDo;
  1129. AssertEquals('2 expressions', 2, W.Expressions.Count);
  1130. AssertExpression('With identifier 1', TPasExpr(W.Expressions[0]), pekIdent, 'a');
  1131. AssertExpression('With identifier 2', TPasExpr(W.Expressions[1]), pekIdent, 'b');
  1132. AssertNotNull('Have with body', W.Body);
  1133. AssertEquals('begin end block', TPasImplBeginBlock, W.Body.ClassType);
  1134. AssertEquals('Empty block', 0, TPasImplBeginBlock(W.Body).ELements.Count);
  1135. AssertPasWriteOutput('output', BuildString(['program afile;',
  1136. '', 'var', ' A: record', ' X,Y: Integer;',
  1137. ' end;', ' b: record', ' W,Z: Integer;',
  1138. ' end;', '', 'begin', ' with a, b do',
  1139. ' begin', ' end;', 'end.', '']), PasProgram);
  1140. end;
  1141. procedure TTestStatementWriterCase.TestCaseOneInteger;
  1142. var
  1143. C: TPasImplCaseOf;
  1144. S: TPasImplCaseStatement;
  1145. begin
  1146. DeclareVar('integer');
  1147. TestStatement(['case a of', '1 : ;', 'end;']);
  1148. C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
  1149. AssertNotNull('Have case expression', C.CaseExpr);
  1150. AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
  1151. AssertNull('No else branch', C.ElseBranch);
  1152. AssertEquals('One case label', 1, C.Elements.Count);
  1153. AssertEquals('Correct case for case label', TPasImplCaseStatement,
  1154. TPasElement(C.Elements[0]).ClassType);
  1155. S := TPasImplCaseStatement(C.Elements[0]);
  1156. AssertEquals('1 expression for case', 1, S.Expressions.Count);
  1157. AssertExpression('With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
  1158. AssertEquals('Empty case label statement', 0, S.Elements.Count);
  1159. AssertNull('Empty case label statement', S.Body);
  1160. AssertPasWriteOutput('output', BuildString(['program afile;',
  1161. '', 'var', ' A: Integer;', '', 'begin', ' case a of',
  1162. ' 1: ;', ' end;', 'end.', '']), PasProgram);
  1163. end;
  1164. procedure TTestStatementWriterCase.TestCaseTwoIntegers;
  1165. var
  1166. C: TPasImplCaseOf;
  1167. S: TPasImplCaseStatement;
  1168. begin
  1169. DeclareVar('integer');
  1170. TestStatement(['case a of', '1,2 : ;', 'end;']);
  1171. C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
  1172. AssertNotNull('Have case expression', C.CaseExpr);
  1173. AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
  1174. AssertNull('No else branch', C.ElseBranch);
  1175. AssertEquals('One case label', 1, C.Elements.Count);
  1176. AssertEquals('Correct case for case label', TPasImplCaseStatement,
  1177. TPasElement(C.Elements[0]).ClassType);
  1178. S := TPasImplCaseStatement(C.Elements[0]);
  1179. AssertEquals('2 expressions for case', 2, S.Expressions.Count);
  1180. AssertExpression('With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
  1181. AssertExpression('With identifier 2', TPasExpr(S.Expressions[1]), pekNumber, '2');
  1182. AssertEquals('Empty case label statement', 0, S.Elements.Count);
  1183. AssertNull('Empty case label statement', S.Body);
  1184. AssertPasWriteOutput('output', BuildString(['program afile;',
  1185. '', 'var', ' A: Integer;', '', 'begin', ' case a of',
  1186. ' 1, 2: ;', ' end;', 'end.', '']), PasProgram);
  1187. end;
  1188. procedure TTestStatementWriterCase.TestCaseRange;
  1189. var
  1190. C: TPasImplCaseOf;
  1191. S: TPasImplCaseStatement;
  1192. begin
  1193. DeclareVar('integer');
  1194. TestStatement(['case a of', '1..3 : ;', 'end;']);
  1195. C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
  1196. AssertNotNull('Have case expression', C.CaseExpr);
  1197. AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
  1198. AssertNull('No else branch', C.ElseBranch);
  1199. AssertEquals('One case label', 1, C.Elements.Count);
  1200. AssertEquals('Correct case for case label', TPasImplCaseStatement,
  1201. TPasElement(C.Elements[0]).ClassType);
  1202. S := TPasImplCaseStatement(C.Elements[0]);
  1203. AssertEquals('1 expression for case', 1, S.Expressions.Count);
  1204. AssertExpression('With identifier 1', TPasExpr(S.Expressions[0]), pekRange, TBinaryExpr);
  1205. AssertEquals('Empty case label statement', 0, S.Elements.Count);
  1206. AssertNull('Empty case label statement', S.Body);
  1207. AssertPasWriteOutput('output', BuildString(['program afile;',
  1208. '', 'var', ' A: Integer;', '', 'begin', ' case a of',
  1209. ' 1..3: ;', ' end;', 'end.', '']), PasProgram);
  1210. end;
  1211. procedure TTestStatementWriterCase.TestCaseRangeSeparate;
  1212. var
  1213. C: TPasImplCaseOf;
  1214. S: TPasImplCaseStatement;
  1215. begin
  1216. DeclareVar('integer');
  1217. TestStatement(['case a of', '1..3,5 : ;', 'end;']);
  1218. C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
  1219. AssertNotNull('Have case expression', C.CaseExpr);
  1220. AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
  1221. AssertNull('No else branch', C.ElseBranch);
  1222. AssertEquals('One case label', 1, C.Elements.Count);
  1223. AssertEquals('Correct case for case label', TPasImplCaseStatement,
  1224. TPasElement(C.Elements[0]).ClassType);
  1225. S := TPasImplCaseStatement(C.Elements[0]);
  1226. AssertEquals('2 expressions for case', 2, S.Expressions.Count);
  1227. AssertExpression('With identifier 1', TPasExpr(S.Expressions[0]), pekRange, TBinaryExpr);
  1228. AssertExpression('With identifier 2', TPasExpr(S.Expressions[1]), pekNumber, '5');
  1229. AssertEquals('Empty case label statement', 0, S.Elements.Count);
  1230. AssertNull('Empty case label statement', S.Body);
  1231. AssertPasWriteOutput('output', BuildString(['program afile;',
  1232. '', 'var', ' A: Integer;', '', 'begin', ' case a of',
  1233. ' 1..3, 5: ;', ' end;', 'end.', '']), PasProgram);
  1234. end;
  1235. procedure TTestStatementWriterCase.TestCase2Cases;
  1236. var
  1237. C: TPasImplCaseOf;
  1238. S: TPasImplCaseStatement;
  1239. begin
  1240. DeclareVar('integer');
  1241. TestStatement(['case a of', '1 : ;', '2 : ;', 'end;']);
  1242. C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
  1243. AssertNotNull('Have case expression', C.CaseExpr);
  1244. AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
  1245. AssertNull('No else branch', C.ElseBranch);
  1246. AssertEquals('Two case labels', 2, C.Elements.Count);
  1247. AssertEquals('Correct case for case label 1', TPasImplCaseStatement,
  1248. TPasElement(C.Elements[0]).ClassType);
  1249. S := TPasImplCaseStatement(C.Elements[0]);
  1250. AssertEquals('2 expressions for case 1', 1, S.Expressions.Count);
  1251. AssertExpression('Case 1 With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
  1252. AssertEquals('Empty case label statement 1', 0, S.Elements.Count);
  1253. AssertNull('Empty case label statement 1', S.Body);
  1254. // Two
  1255. AssertEquals('Correct case for case label 2', TPasImplCaseStatement,
  1256. TPasElement(C.Elements[1]).ClassType);
  1257. S := TPasImplCaseStatement(C.Elements[1]);
  1258. AssertEquals('2 expressions for case 2', 1, S.Expressions.Count);
  1259. AssertExpression('Case 2 With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '2');
  1260. AssertEquals('Empty case label statement 2', 0, S.Elements.Count);
  1261. AssertNull('Empty case label statement 2', S.Body);
  1262. AssertPasWriteOutput('output', BuildString(['program afile;',
  1263. '', 'var', ' A: Integer;', '', 'begin', ' case a of',
  1264. ' 1: ;', ' 2: ;', ' end;', 'end.', '']), PasProgram);
  1265. end;
  1266. procedure TTestStatementWriterCase.TestCaseBlock;
  1267. var
  1268. C: TPasImplCaseOf;
  1269. S: TPasImplCaseStatement;
  1270. B: TPasImplbeginBlock;
  1271. begin
  1272. DeclareVar('integer');
  1273. TestStatement(['case a of', '1 : begin end;', 'end;']);
  1274. C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
  1275. AssertNotNull('Have case expression', C.CaseExpr);
  1276. AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
  1277. AssertNull('No else branch', C.ElseBranch);
  1278. AssertEquals('Two case labels', 1, C.Elements.Count);
  1279. AssertEquals('Correct case for case label 1', TPasImplCaseStatement,
  1280. TPasElement(C.Elements[0]).ClassType);
  1281. S := TPasImplCaseStatement(C.Elements[0]);
  1282. AssertEquals('2 expressions for case 1', 1, S.Expressions.Count);
  1283. AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
  1284. AssertEquals('1 case label statement', 1, S.Elements.Count);
  1285. AssertEquals('Correct case for case label 1', TPasImplbeginBlock,
  1286. TPasElement(S.Elements[0]).ClassType);
  1287. B := TPasImplbeginBlock(S.Elements[0]);
  1288. AssertEquals('0 statements in block', 0, B.Elements.Count);
  1289. AssertPasWriteOutput('output', BuildString(['program afile;',
  1290. '', 'var', ' A: Integer;', '', 'begin', ' case a of',
  1291. ' 1: begin', ' end;', ' end;', 'end.', '']), PasProgram);
  1292. end;
  1293. procedure TTestStatementWriterCase.TestCaseElseBlockEmpty;
  1294. var
  1295. C: TPasImplCaseOf;
  1296. S: TPasImplCaseStatement;
  1297. B: TPasImplbeginBlock;
  1298. begin
  1299. DeclareVar('integer');
  1300. TestStatement(['case a of', '1 : begin end;', 'else', ' end;']);
  1301. C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
  1302. AssertNotNull('Have case expression', C.CaseExpr);
  1303. AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
  1304. AssertEquals('Two case labels', 2, C.Elements.Count);
  1305. AssertEquals('Correct case for case label 1', TPasImplCaseStatement,
  1306. TPasElement(C.Elements[0]).ClassType);
  1307. S := TPasImplCaseStatement(C.Elements[0]);
  1308. AssertEquals('2 expressions for case 1', 1, S.Expressions.Count);
  1309. AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
  1310. AssertEquals('1 case label statement', 1, S.Elements.Count);
  1311. AssertEquals('Correct case for case label 1', TPasImplbeginBlock,
  1312. TPasElement(S.Elements[0]).ClassType);
  1313. B := TPasImplbeginBlock(S.Elements[0]);
  1314. AssertEquals('0 statements in block', 0, B.Elements.Count);
  1315. AssertNotNull('Have else branch', C.ElseBranch);
  1316. AssertEquals('Correct else branch class', TPasImplCaseElse, C.ElseBranch.ClassType);
  1317. AssertEquals('Zero statements ', 0, TPasImplCaseElse(C.ElseBranch).Elements.Count);
  1318. AssertPasWriteOutput('output', BuildString(['program afile;',
  1319. '',
  1320. 'var',
  1321. ' A: Integer;',
  1322. '',
  1323. 'begin',
  1324. ' case a of',
  1325. ' 1: begin',
  1326. ' end',
  1327. ' else',
  1328. ' end;',
  1329. 'end.', '']), PasProgram);
  1330. end;
  1331. procedure TTestStatementWriterCase.TestCaseOtherwiseBlockEmpty;
  1332. var
  1333. C: TPasImplCaseOf;
  1334. begin
  1335. DeclareVar('integer');
  1336. TestStatement(['case a of', '1 : begin end;', 'otherwise', ' end;']);
  1337. C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
  1338. AssertNotNull('Have case expression', C.CaseExpr);
  1339. AssertNotNull('Have else branch', C.ElseBranch);
  1340. AssertEquals('Correct else branch class', TPasImplCaseElse, C.ElseBranch.ClassType);
  1341. AssertEquals('Zero statements ', 0, TPasImplCaseElse(C.ElseBranch).Elements.Count);
  1342. AssertPasWriteOutput('output', BuildString(['program afile;',
  1343. '',
  1344. 'var',
  1345. ' A: Integer;',
  1346. '',
  1347. 'begin',
  1348. ' case a of',
  1349. ' 1: begin',
  1350. ' end',
  1351. ' else',
  1352. ' end;',
  1353. 'end.', '']), PasProgram);
  1354. end;
  1355. procedure TTestStatementWriterCase.TestCaseElseBlockAssignment;
  1356. var
  1357. C: TPasImplCaseOf;
  1358. S: TPasImplCaseStatement;
  1359. B: TPasImplbeginBlock;
  1360. begin
  1361. DeclareVar('integer');
  1362. TestStatement(['case a of', '1 : begin end;', 'else', 'a:=1', ' end;']);
  1363. C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
  1364. AssertNotNull('Have case expression', C.CaseExpr);
  1365. AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
  1366. AssertEquals('Two case labels', 2, C.Elements.Count);
  1367. AssertEquals('Correct case for case label 1', TPasImplCaseStatement,
  1368. TPasElement(C.Elements[0]).ClassType);
  1369. S := TPasImplCaseStatement(C.Elements[0]);
  1370. AssertEquals('2 expressions for case 1', 1, S.Expressions.Count);
  1371. AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
  1372. AssertEquals('1 case label statement', 1, S.Elements.Count);
  1373. AssertEquals('Correct case for case label 1', TPasImplbeginBlock,
  1374. TPasElement(S.Elements[0]).ClassType);
  1375. B := TPasImplbeginBlock(S.Elements[0]);
  1376. AssertEquals('0 statements in block', 0, B.Elements.Count);
  1377. AssertNotNull('Have else branch', C.ElseBranch);
  1378. AssertEquals('Correct else branch class', TPasImplCaseElse, C.ElseBranch.ClassType);
  1379. AssertEquals('1 statement in else branch ', 1, TPasImplCaseElse(
  1380. C.ElseBranch).Elements.Count);
  1381. AssertPasWriteOutput('output', BuildString(['program afile;',
  1382. '',
  1383. 'var',
  1384. ' A: Integer;',
  1385. '',
  1386. 'begin',
  1387. ' case a of',
  1388. ' 1: begin',
  1389. ' end',
  1390. ' else',
  1391. ' a := 1;',
  1392. ' end;',
  1393. 'end.', '']), PasProgram);
  1394. end;
  1395. procedure TTestStatementWriterCase.TestCaseElseBlock2Assignments;
  1396. var
  1397. C: TPasImplCaseOf;
  1398. S: TPasImplCaseStatement;
  1399. B: TPasImplbeginBlock;
  1400. begin
  1401. DeclareVar('integer');
  1402. TestStatement(['case a of', '1 : begin end;', 'else', 'a:=1;', 'a:=32;', ' end;']);
  1403. C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
  1404. AssertNotNull('Have case expression', C.CaseExpr);
  1405. AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
  1406. AssertEquals('Two case labels', 2, C.Elements.Count);
  1407. AssertEquals('Correct case for case label 1', TPasImplCaseStatement,
  1408. TPasElement(C.Elements[0]).ClassType);
  1409. S := TPasImplCaseStatement(C.Elements[0]);
  1410. AssertEquals('2 expressions for case 1', 1, S.Expressions.Count);
  1411. AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
  1412. AssertEquals('1 case label statement', 1, S.Elements.Count);
  1413. AssertEquals('Correct case for case label 1', TPasImplbeginBlock,
  1414. TPasElement(S.Elements[0]).ClassType);
  1415. B := TPasImplbeginBlock(S.Elements[0]);
  1416. AssertEquals('0 statements in block', 0, B.Elements.Count);
  1417. AssertNotNull('Have else branch', C.ElseBranch);
  1418. AssertEquals('Correct else branch class', TPasImplCaseElse, C.ElseBranch.ClassType);
  1419. AssertEquals('2 statements in else branch ', 2, TPasImplCaseElse(
  1420. C.ElseBranch).Elements.Count);
  1421. AssertPasWriteOutput('output', BuildString(['program afile;',
  1422. '',
  1423. 'var',
  1424. ' A: Integer;',
  1425. '',
  1426. 'begin',
  1427. ' case a of',
  1428. ' 1: begin',
  1429. ' end',
  1430. ' else',
  1431. ' a := 1;',
  1432. ' a := 32;',
  1433. ' end;',
  1434. 'end.', '']), PasProgram);
  1435. end;
  1436. procedure TTestStatementWriterCase.TestCaseIfCaseElse;
  1437. var
  1438. C: TPasImplCaseOf;
  1439. begin
  1440. DeclareVar('integer');
  1441. DeclareVar('boolean', 'b');
  1442. TestStatement(['case a of', '1 : if b then', ' begin end;', 'else', ' end;']);
  1443. C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
  1444. AssertNotNull('Have case expression', C.CaseExpr);
  1445. AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
  1446. AssertEquals('Two case labels', 2, C.Elements.Count);
  1447. AssertNotNull('Have else branch', C.ElseBranch);
  1448. AssertEquals('Correct else branch class', TPasImplCaseElse, C.ElseBranch.ClassType);
  1449. AssertEquals('0 statement in else branch ', 0, TPasImplCaseElse(
  1450. C.ElseBranch).Elements.Count);
  1451. AssertPasWriteOutput('output', BuildString(['program afile;',
  1452. '',
  1453. 'var',
  1454. ' A: Integer;',
  1455. ' b: Boolean;',
  1456. '',
  1457. 'begin',
  1458. ' case a of',
  1459. ' 1: begin',
  1460. ' if b then',
  1461. ' end',
  1462. ' else',
  1463. ' end;',
  1464. 'end.', '']), PasProgram);
  1465. end;
  1466. procedure TTestStatementWriterCase.TestCaseIfElse;
  1467. var
  1468. C: TPasImplCaseOf;
  1469. S: TPasImplCaseStatement;
  1470. begin
  1471. DeclareVar('integer');
  1472. DeclareVar('boolean', 'b');
  1473. TestStatement(['case a of', '1 : if b then', ' begin end', 'else', 'begin', 'end', ' end;']);
  1474. C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
  1475. AssertNotNull('Have case expression', C.CaseExpr);
  1476. AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
  1477. AssertEquals('One case label', 1, C.Elements.Count);
  1478. AssertNull('Have no else branch', C.ElseBranch);
  1479. S := TPasImplCaseStatement(C.Elements[0]);
  1480. AssertEquals('2 expressions for case 1', 1, S.Expressions.Count);
  1481. AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
  1482. AssertEquals('1 case label statement', 1, S.Elements.Count);
  1483. AssertEquals('If statement in case label 1', TPasImplIfElse, TPasElement(
  1484. S.Elements[0]).ClassType);
  1485. AssertNotNull('If statement has else block', TPasImplIfElse(S.Elements[0]).ElseBranch);
  1486. AssertPasWriteOutput('output', BuildString(['program afile;',
  1487. '',
  1488. 'var',
  1489. ' A: Integer;',
  1490. ' b: Boolean;',
  1491. '',
  1492. 'begin',
  1493. ' case a of',
  1494. ' 1: begin',
  1495. ' if b then',
  1496. ' begin',
  1497. ' end else',
  1498. ' begin',
  1499. ' end;',
  1500. ' end;',
  1501. ' end;',
  1502. 'end.', '']), PasProgram);
  1503. end;
  1504. procedure TTestStatementWriterCase.TestCaseIfCaseElseElse;
  1505. var
  1506. C: TPasImplCaseOf;
  1507. S: TPasImplCaseStatement;
  1508. begin
  1509. DeclareVar('integer');
  1510. DeclareVar('boolean', 'b');
  1511. TestStatement(['case a of', '1 : if b then', ' begin end', 'else',
  1512. 'else', 'DoElse', ' end;']);
  1513. C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
  1514. AssertNotNull('Have case expression', C.CaseExpr);
  1515. AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
  1516. AssertEquals('Two case labels', 2, C.Elements.Count);
  1517. AssertNotNull('Have an else branch', C.ElseBranch);
  1518. S := TPasImplCaseStatement(C.Elements[0]);
  1519. AssertEquals('2 expressions for case 1', 1, S.Expressions.Count);
  1520. AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
  1521. AssertEquals('1 case label statement', 1, S.Elements.Count);
  1522. AssertEquals('If statement in case label 1', TPasImplIfElse, TPasElement(
  1523. S.Elements[0]).ClassType);
  1524. AssertNotNull('If statement has else block', TPasImplIfElse(S.Elements[0]).ElseBranch);
  1525. AssertEquals('If statement has a commend as else block', TPasImplCommand,
  1526. TPasImplIfElse(S.Elements[0]).ElseBranch.ClassType);
  1527. AssertEquals('But ... an empty command', '', TPasImplCommand(
  1528. TPasImplIfElse(S.Elements[0]).ElseBranch).Command);
  1529. AssertPasWriteOutput('output', BuildString(['program afile;',
  1530. '',
  1531. 'var',
  1532. ' A: Integer;',
  1533. ' b: Boolean;',
  1534. '',
  1535. 'begin',
  1536. ' case a of',
  1537. ' 1: begin',
  1538. ' if b then',
  1539. ' begin',
  1540. ' end else',
  1541. ' end',
  1542. ' else',
  1543. ' DoElse;',
  1544. ' end;',
  1545. 'end.','']), PasProgram);
  1546. end;
  1547. procedure TTestStatementWriterCase.TestCaseElseNoSemicolon;
  1548. var
  1549. C: TPasImplCaseOf;
  1550. S: TPasImplCaseStatement;
  1551. begin
  1552. DeclareVar('integer');
  1553. TestStatement(['case a of', '1 : dosomething;', '2 : dosomethingmore',
  1554. 'else', 'a:=1;', 'end;']);
  1555. C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
  1556. AssertNotNull('Have case expression', C.CaseExpr);
  1557. AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
  1558. AssertEquals('case label count', 3, C.Elements.Count);
  1559. S := TPasImplCaseStatement(C.Elements[0]);
  1560. AssertEquals('case 1', 1, S.Expressions.Count);
  1561. AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
  1562. S := TPasImplCaseStatement(C.Elements[1]);
  1563. AssertEquals('case 2', 1, S.Expressions.Count);
  1564. AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '2');
  1565. AssertEquals('third is else', TPasImplCaseElse, TObject(C.Elements[2]).ClassType);
  1566. AssertNotNull('Have else branch', C.ElseBranch);
  1567. AssertEquals('Correct else branch class', TPasImplCaseElse, C.ElseBranch.ClassType);
  1568. AssertEquals('1 statements in else branch ', 1, TPasImplCaseElse(
  1569. C.ElseBranch).Elements.Count);
  1570. AssertPasWriteOutput('output', BuildString(['program afile;',
  1571. '',
  1572. 'var',
  1573. ' A: Integer;',
  1574. '',
  1575. 'begin',
  1576. ' case a of',
  1577. ' 1: begin',
  1578. ' dosomething;',
  1579. ' end;',
  1580. ' 2: begin',
  1581. ' dosomethingmore;',
  1582. ' end',
  1583. ' else',
  1584. ' a := 1;',
  1585. ' end;',
  1586. 'end.', '']), PasProgram);
  1587. end;
  1588. procedure TTestStatementWriterCase.TestCaseIfElseNoSemicolon;
  1589. var
  1590. C: TPasImplCaseOf;
  1591. S: TPasImplCaseStatement;
  1592. begin
  1593. DeclareVar('integer');
  1594. TestStatement(['case a of', '1 : dosomething;', '2: if b then',
  1595. ' dosomething', 'else dosomethingmore', 'else', 'a:=1;', 'end;']);
  1596. C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
  1597. AssertNotNull('Have case expression', C.CaseExpr);
  1598. AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
  1599. AssertEquals('case label count', 3, C.Elements.Count);
  1600. S := TPasImplCaseStatement(C.Elements[0]);
  1601. AssertEquals('case 1', 1, S.Expressions.Count);
  1602. AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
  1603. S := TPasImplCaseStatement(C.Elements[1]);
  1604. AssertEquals('case 2', 1, S.Expressions.Count);
  1605. AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '2');
  1606. AssertEquals('third is else', TPasImplCaseElse, TObject(C.Elements[2]).ClassType);
  1607. AssertNotNull('Have else branch', C.ElseBranch);
  1608. AssertEquals('Correct else branch class', TPasImplCaseElse, C.ElseBranch.ClassType);
  1609. AssertEquals('1 statements in else branch ', 1, TPasImplCaseElse(
  1610. C.ElseBranch).Elements.Count);
  1611. AssertPasWriteOutput('output', BuildString(['program afile;',
  1612. '',
  1613. 'var',
  1614. ' A: Integer;',
  1615. '',
  1616. 'begin',
  1617. ' case a of',
  1618. ' 1: begin',
  1619. ' dosomething;',
  1620. ' end;',
  1621. ' 2: begin',
  1622. ' if b then',
  1623. ' begin',
  1624. ' dosomething;',
  1625. ' end else',
  1626. ' dosomethingmore;',
  1627. ' end',
  1628. ' else',
  1629. ' a := 1;',
  1630. ' end;',
  1631. 'end.', '']), PasProgram);
  1632. end;
  1633. procedure TTestStatementWriterCase.TestCaseIfOtherwiseNoSemicolon;
  1634. var
  1635. C: TPasImplCaseOf;
  1636. S: TPasImplCaseStatement;
  1637. begin
  1638. DeclareVar('integer');
  1639. TestStatement(['case a of', '1 : dosomething;', '2: if b then',
  1640. ' dosomething', 'else dosomethingmore', 'otherwise', 'a:=1;', 'end;']);
  1641. C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
  1642. AssertNotNull('Have case expression', C.CaseExpr);
  1643. AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
  1644. AssertEquals('case label count', 3, C.Elements.Count);
  1645. S := TPasImplCaseStatement(C.Elements[0]);
  1646. AssertEquals('case 1', 1, S.Expressions.Count);
  1647. AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
  1648. S := TPasImplCaseStatement(C.Elements[1]);
  1649. AssertEquals('case 2', 1, S.Expressions.Count);
  1650. AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '2');
  1651. AssertEquals('third is else', TPasImplCaseElse, TObject(C.Elements[2]).ClassType);
  1652. AssertNotNull('Have else branch', C.ElseBranch);
  1653. AssertEquals('Correct else branch class', TPasImplCaseElse, C.ElseBranch.ClassType);
  1654. AssertEquals('1 statements in else branch ', 1, TPasImplCaseElse(
  1655. C.ElseBranch).Elements.Count);
  1656. AssertPasWriteOutput('output', BuildString(['program afile;',
  1657. '',
  1658. 'var',
  1659. ' A: Integer;',
  1660. '',
  1661. 'begin',
  1662. ' case a of',
  1663. ' 1: begin',
  1664. ' dosomething;',
  1665. ' end;',
  1666. ' 2: begin',
  1667. ' if b then',
  1668. ' begin',
  1669. ' dosomething;',
  1670. ' end else',
  1671. ' dosomethingmore;',
  1672. ' end',
  1673. ' else',
  1674. ' a := 1;',
  1675. ' end;',
  1676. 'end.', '']), PasProgram);
  1677. end;
  1678. procedure TTestStatementWriterRaise.TestRaise;
  1679. var
  1680. R: TPasImplRaise;
  1681. begin
  1682. DeclareVar('Exception');
  1683. TestStatement('Raise A;');
  1684. R := AssertStatement('Raise statement', TPasImplRaise) as TPasImplRaise;
  1685. AssertEquals(0, R.Elements.Count);
  1686. AssertNotNull(R.ExceptObject);
  1687. AssertNull(R.ExceptAddr);
  1688. AssertExpression('Expression object', R.ExceptObject, pekIdent, 'A');
  1689. AssertPasWriteOutput('output', BuildString(['program afile;',
  1690. '',
  1691. 'var',
  1692. ' A: Exception;',
  1693. '',
  1694. 'begin',
  1695. ' raise A;',
  1696. 'end.', '']), PasProgram);
  1697. end;
  1698. procedure TTestStatementWriterRaise.TestRaiseEmpty;
  1699. var
  1700. R: TPasImplRaise;
  1701. begin
  1702. TestStatement('Raise;');
  1703. R := AssertStatement('Raise statement', TPasImplRaise) as TPasImplRaise;
  1704. AssertEquals(0, R.Elements.Count);
  1705. AssertNull(R.ExceptObject);
  1706. AssertNull(R.ExceptAddr);
  1707. AssertPasWriteOutput('output', BuildString(['program afile;',
  1708. '',
  1709. '',
  1710. 'begin',
  1711. ' raise;',
  1712. 'end.', '']), PasProgram);
  1713. end;
  1714. procedure TTestStatementWriterRaise.TestRaiseAt;
  1715. var
  1716. R: TPasImplRaise;
  1717. begin
  1718. DeclareVar('Exception');
  1719. DeclareVar('Pointer', 'B');
  1720. TestStatement('Raise A at B;');
  1721. R := AssertStatement('Raise statement', TPasImplRaise) as TPasImplRaise;
  1722. AssertEquals(0, R.Elements.Count);
  1723. AssertNotNull(R.ExceptObject);
  1724. AssertNotNull(R.ExceptAddr);
  1725. AssertExpression('Expression object', R.ExceptAddr, pekIdent, 'B');
  1726. AssertPasWriteOutput('output', BuildString(['program afile;',
  1727. '',
  1728. 'var',
  1729. ' A: Exception;',
  1730. ' B: Pointer;',
  1731. '',
  1732. 'begin',
  1733. ' raise A at B;',
  1734. 'end.', '']), PasProgram);
  1735. end;
  1736. procedure TTestStatementWriterTry.TestTryFinally;
  1737. var
  1738. T: TPasImplTry;
  1739. S: TPasImplSimple;
  1740. F: TPasImplTryFinally;
  1741. begin
  1742. TestStatement(['Try', ' DoSomething;', 'finally', ' DoSomethingElse', 'end']);
  1743. T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
  1744. AssertEquals(1, T.Elements.Count);
  1745. AssertNotNull(T.FinallyExcept);
  1746. AssertNull(T.ElseBranch);
  1747. AssertNotNull(T.Elements[0]);
  1748. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  1749. S := TPasImplSimple(T.Elements[0]);
  1750. AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething');
  1751. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  1752. AssertEquals('Finally statement', TPasImplTryFinally, T.FinallyExcept.ClassType);
  1753. F := TPasImplTryFinally(T.FinallyExcept);
  1754. AssertEquals(1, F.Elements.Count);
  1755. AssertEquals('Simple statement', TPasImplSimple, TPasElement(F.Elements[0]).ClassType);
  1756. S := TPasImplSimple(F.Elements[0]);
  1757. AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse');
  1758. AssertPasWriteOutput('output', BuildString(['program afile;',
  1759. '', '', 'begin', ' try', ' DoSomething;',
  1760. ' finally', ' DoSomethingElse;', ' end;', 'end.', '']),
  1761. PasProgram);
  1762. end;
  1763. procedure TTestStatementWriterTry.TestTryFinallyEmpty;
  1764. var
  1765. T: TPasImplTry;
  1766. F: TPasImplTryFinally;
  1767. begin
  1768. TestStatement(['Try', 'finally', 'end;']);
  1769. T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
  1770. AssertEquals(0, T.Elements.Count);
  1771. AssertNotNull(T.FinallyExcept);
  1772. AssertNull(T.ElseBranch);
  1773. AssertEquals('Finally statement', TPasImplTryFinally, T.FinallyExcept.ClassType);
  1774. F := TPasImplTryFinally(T.FinallyExcept);
  1775. AssertEquals(0, F.Elements.Count);
  1776. AssertPasWriteOutput('output', BuildString(['program afile;',
  1777. '', '', 'begin', ' try', ' finally', ' end;',
  1778. 'end.', '']), PasProgram);
  1779. end;
  1780. procedure TTestStatementWriterTry.TestTryFinallyNested;
  1781. var
  1782. T: TPasImplTry;
  1783. S: TPasImplSimple;
  1784. F: TPasImplTryFinally;
  1785. begin
  1786. TestStatement(['Try', ' DoSomething1;', ' Try', ' DoSomething2;',
  1787. ' finally', ' DoSomethingElse2', ' end;', 'Finally', ' DoSomethingElse1', 'end']);
  1788. T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
  1789. AssertEquals(2, T.Elements.Count);
  1790. AssertNotNull(T.FinallyExcept);
  1791. AssertNull(T.ElseBranch);
  1792. AssertNotNull(T.Elements[0]);
  1793. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  1794. S := TPasImplSimple(T.Elements[0]);
  1795. AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething1');
  1796. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  1797. AssertEquals('Finally statement', TPasImplTryFinally, T.FinallyExcept.ClassType);
  1798. F := TPasImplTryFinally(T.FinallyExcept);
  1799. AssertEquals(1, F.Elements.Count);
  1800. AssertEquals('Simple statement', TPasImplSimple, TPasElement(F.Elements[0]).ClassType);
  1801. S := TPasImplSimple(F.Elements[0]);
  1802. AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse1');
  1803. // inner statement
  1804. AssertNotNull(T.Elements[1]);
  1805. AssertEquals('Nested try statement', TPasImplTry, TPasElement(T.Elements[1]).ClassType);
  1806. T := TPasImplTry(T.Elements[1]);
  1807. AssertEquals(1, T.Elements.Count);
  1808. AssertNotNull(T.FinallyExcept);
  1809. AssertNull(T.ElseBranch);
  1810. AssertNotNull(T.Elements[0]);
  1811. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  1812. S := TPasImplSimple(T.Elements[0]);
  1813. AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething2');
  1814. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  1815. AssertEquals('Finally statement', TPasImplTryFinally, T.FinallyExcept.ClassType);
  1816. F := TPasImplTryFinally(T.FinallyExcept);
  1817. AssertEquals(1, F.Elements.Count);
  1818. AssertEquals('Simple statement', TPasImplSimple, TPasElement(F.Elements[0]).ClassType);
  1819. S := TPasImplSimple(F.Elements[0]);
  1820. AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse2');
  1821. AssertPasWriteOutput('output', BuildString(['program afile;',
  1822. '', '', 'begin', ' try', ' DoSomething1;',
  1823. ' try', ' DoSomething2;', ' finally',
  1824. ' DoSomethingElse2;', ' end;', ' finally',
  1825. ' DoSomethingElse1;', ' end;', 'end.', '']), PasProgram);
  1826. end;
  1827. procedure TTestStatementWriterTry.TestTryExcept;
  1828. var
  1829. T: TPasImplTry;
  1830. S: TPasImplSimple;
  1831. E: TPasImplTryExcept;
  1832. begin
  1833. TestStatement(['Try', ' DoSomething;', 'except', ' DoSomethingElse', 'end']);
  1834. T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
  1835. AssertEquals(1, T.Elements.Count);
  1836. AssertNotNull(T.FinallyExcept);
  1837. AssertNull(T.ElseBranch);
  1838. AssertNotNull(T.Elements[0]);
  1839. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  1840. S := TPasImplSimple(T.Elements[0]);
  1841. AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething');
  1842. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  1843. AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
  1844. E := TPasImplTryExcept(T.FinallyExcept);
  1845. AssertEquals(1, E.Elements.Count);
  1846. AssertEquals('Simple statement', TPasImplSimple, TPasElement(E.Elements[0]).ClassType);
  1847. S := TPasImplSimple(E.Elements[0]);
  1848. AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse');
  1849. AssertPasWriteOutput('output', BuildString(['program afile;',
  1850. '', '', 'begin', ' try', ' DoSomething;',
  1851. ' except', ' DoSomethingElse;', ' end;', 'end.', '']),
  1852. PasProgram);
  1853. end;
  1854. procedure TTestStatementWriterTry.TestTryExceptNested;
  1855. var
  1856. T: TPasImplTry;
  1857. S: TPasImplSimple;
  1858. E: TPasImplTryExcept;
  1859. begin
  1860. TestStatement(['Try', ' DoSomething1;', ' try', ' DoSomething2;',
  1861. ' except', ' DoSomethingElse2', ' end', 'except', ' DoSomethingElse1', 'end']);
  1862. T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
  1863. AssertEquals(2, T.Elements.Count);
  1864. AssertNotNull(T.FinallyExcept);
  1865. AssertNull(T.ElseBranch);
  1866. AssertNotNull(T.Elements[0]);
  1867. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  1868. S := TPasImplSimple(T.Elements[0]);
  1869. AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething1');
  1870. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  1871. AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
  1872. E := TPasImplTryExcept(T.FinallyExcept);
  1873. AssertEquals(1, E.Elements.Count);
  1874. AssertEquals('Simple statement', TPasImplSimple, TPasElement(E.Elements[0]).ClassType);
  1875. S := TPasImplSimple(E.Elements[0]);
  1876. AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse1');
  1877. AssertNotNull(T.Elements[1]);
  1878. AssertEquals('Simple statement', TPasImplTry, TPasElement(T.Elements[1]).ClassType);
  1879. T := TPasImplTry(T.Elements[1]);
  1880. AssertEquals(1, T.Elements.Count);
  1881. AssertNotNull(T.FinallyExcept);
  1882. AssertNull(T.ElseBranch);
  1883. AssertNotNull(T.Elements[0]);
  1884. AssertEquals('Simple statement 2', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  1885. S := TPasImplSimple(T.Elements[0]);
  1886. AssertExpression('DoSomething2 call ', S.Expr, pekIdent, 'DoSomething2');
  1887. AssertEquals('Simple statement2', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  1888. AssertEquals('Except statement2', TPasImplTryExcept, T.FinallyExcept.ClassType);
  1889. E := TPasImplTryExcept(T.FinallyExcept);
  1890. AssertEquals(1, E.Elements.Count);
  1891. AssertEquals('Simple statement2', TPasImplSimple, TPasElement(E.Elements[0]).ClassType);
  1892. S := TPasImplSimple(E.Elements[0]);
  1893. AssertExpression('DoSomethingElse2 call', S.Expr, pekIdent, 'DoSomethingElse2');
  1894. AssertPasWriteOutput('output', BuildString(['program afile;',
  1895. '', '', 'begin', ' try', ' DoSomething1;',
  1896. ' try', ' DoSomething2;', ' except',
  1897. ' DoSomethingElse2;', ' end;', ' except',
  1898. ' DoSomethingElse1;', ' end;', 'end.', '']), PasProgram);
  1899. end;
  1900. procedure TTestStatementWriterTry.TestTryExceptEmpty;
  1901. var
  1902. T: TPasImplTry;
  1903. E: TPasImplTryExcept;
  1904. begin
  1905. TestStatement(['Try', 'except', 'end;']);
  1906. T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
  1907. AssertEquals(0, T.Elements.Count);
  1908. AssertNotNull(T.FinallyExcept);
  1909. AssertNull(T.ElseBranch);
  1910. AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
  1911. E := TPasImplTryExcept(T.FinallyExcept);
  1912. AssertEquals(0, E.Elements.Count);
  1913. AssertPasWriteOutput('output', BuildString(['program afile;',
  1914. '', '', 'begin', ' try', ' except', ' end;',
  1915. 'end.', '']), PasProgram);
  1916. end;
  1917. procedure TTestStatementWriterTry.TestTryExceptOn;
  1918. var
  1919. T: TPasImplTry;
  1920. S: TPasImplSimple;
  1921. E: TPasImplTryExcept;
  1922. O: TPasImplExceptOn;
  1923. begin
  1924. TestStatement(['Try', ' DoSomething;', 'except', 'On E : Exception do',
  1925. 'DoSomethingElse;', 'end']);
  1926. T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
  1927. AssertEquals(1, T.Elements.Count);
  1928. AssertNotNull(T.FinallyExcept);
  1929. AssertNull(T.ElseBranch);
  1930. AssertNotNull(T.Elements[0]);
  1931. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  1932. S := TPasImplSimple(T.Elements[0]);
  1933. AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething');
  1934. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  1935. AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
  1936. E := TPasImplTryExcept(T.FinallyExcept);
  1937. AssertEquals(1, E.Elements.Count);
  1938. AssertEquals('Except on handler', TPasImplExceptOn, TPasElement(
  1939. E.Elements[0]).ClassType);
  1940. O := TPasImplExceptOn(E.Elements[0]);
  1941. AssertEquals(1, O.Elements.Count);
  1942. AssertEquals('Simple statement', TPasImplSimple, TPasElement(O.Elements[0]).ClassType);
  1943. AssertEquals('Exception Variable name', 'E', O.VariableName);
  1944. AssertEquals('Exception Type name', 'Exception', O.TypeName);
  1945. S := TPasImplSimple(O.Elements[0]);
  1946. AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse');
  1947. // AssertEquals('Variable name',
  1948. AssertPasWriteOutput('output', BuildString(['program afile;', '',
  1949. '', 'begin', ' try', ' DoSomething;', ' except',
  1950. ' On E : Exception do', ' DoSomethingElse;', ' end;',
  1951. 'end.', '']), PasProgram);
  1952. end;
  1953. procedure TTestStatementWriterTry.TestTryExceptOn2;
  1954. var
  1955. T: TPasImplTry;
  1956. S: TPasImplSimple;
  1957. E: TPasImplTryExcept;
  1958. O: TPasImplExceptOn;
  1959. begin
  1960. TestStatement(['Try', ' DoSomething;', 'except',
  1961. 'On E : Exception do', 'DoSomethingElse;',
  1962. 'On Y : Exception2 do', 'DoSomethingElse2;', 'end']);
  1963. T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
  1964. AssertEquals(1, T.Elements.Count);
  1965. AssertNotNull(T.FinallyExcept);
  1966. AssertNull(T.ElseBranch);
  1967. AssertNotNull(T.Elements[0]);
  1968. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  1969. S := TPasImplSimple(T.Elements[0]);
  1970. AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething');
  1971. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  1972. AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
  1973. E := TPasImplTryExcept(T.FinallyExcept);
  1974. AssertEquals(2, E.Elements.Count);
  1975. // Exception handler 1
  1976. AssertEquals('Except on handler', TPasImplExceptOn, TPasElement(
  1977. E.Elements[0]).ClassType);
  1978. O := TPasImplExceptOn(E.Elements[0]);
  1979. AssertEquals(1, O.Elements.Count);
  1980. AssertEquals('Simple statement', TPasImplSimple, TPasElement(O.Elements[0]).ClassType);
  1981. AssertEquals('Exception Variable name', 'E', O.VariableName);
  1982. AssertEquals('Exception Type name', 'Exception', O.TypeName);
  1983. S := TPasImplSimple(O.Elements[0]);
  1984. AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse');
  1985. // Exception handler 2
  1986. AssertEquals('Except on handler', TPasImplExceptOn, TPasElement(
  1987. E.Elements[1]).ClassType);
  1988. O := TPasImplExceptOn(E.Elements[1]);
  1989. AssertEquals(1, O.Elements.Count);
  1990. AssertEquals('Simple statement', TPasImplSimple, TPasElement(O.Elements[0]).ClassType);
  1991. AssertEquals('Exception Variable name', 'Y', O.VariableName);
  1992. AssertEquals('Exception Type name', 'Exception2', O.TypeName);
  1993. S := TPasImplSimple(O.Elements[0]);
  1994. AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse2');
  1995. AssertPasWriteOutput('output', BuildString(['program afile;',
  1996. '', '', 'begin', ' try', ' DoSomething;',
  1997. ' except', ' On E : Exception do', ' DoSomethingElse;',
  1998. ' On Y : Exception2 do', ' DoSomethingElse2;', ' end;',
  1999. 'end.', '']), PasProgram);
  2000. end;
  2001. procedure TTestStatementWriterTry.TestTryExceptOnElse;
  2002. var
  2003. T: TPasImplTry;
  2004. S: TPasImplSimple;
  2005. E: TPasImplTryExcept;
  2006. O: TPasImplExceptOn;
  2007. EE: TPasImplTryExceptElse;
  2008. I: TPasImplIfElse;
  2009. begin
  2010. DeclareVar('Boolean', 'b');
  2011. // Check that Else belongs to Except, not to IF
  2012. TestStatement(['Try', ' DoSomething;', 'except', 'On E : Exception do',
  2013. 'if b then', 'DoSomethingElse;', 'else', 'DoSomethingMore;', 'end']);
  2014. T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
  2015. AssertEquals(1, T.Elements.Count);
  2016. AssertNotNull(T.FinallyExcept);
  2017. AssertNotNull(T.ElseBranch);
  2018. AssertNotNull(T.Elements[0]);
  2019. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  2020. S := TPasImplSimple(T.Elements[0]);
  2021. AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething');
  2022. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  2023. AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
  2024. E := TPasImplTryExcept(T.FinallyExcept);
  2025. AssertEquals(1, E.Elements.Count);
  2026. AssertEquals('Except on handler', TPasImplExceptOn, TPasElement(
  2027. E.Elements[0]).ClassType);
  2028. O := TPasImplExceptOn(E.Elements[0]);
  2029. AssertEquals('Exception Variable name', 'E', O.VariableName);
  2030. AssertEquals('Exception Type name', 'Exception', O.TypeName);
  2031. AssertEquals(1, O.Elements.Count);
  2032. AssertEquals('Simple statement', TPasImplIfElse, TPasElement(O.Elements[0]).ClassType);
  2033. I := TPasImplIfElse(O.Elements[0]);
  2034. AssertEquals(1, I.Elements.Count);
  2035. AssertNull('No else barcnh for if', I.ElseBranch);
  2036. AssertEquals('Simple statement', TPasImplSimple, TPasElement(I.Elements[0]).ClassType);
  2037. S := TPasImplSimple(I.Elements[0]);
  2038. AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse');
  2039. AssertEquals('Except Else statement', TPasImplTryExceptElse, T.ElseBranch.ClassType);
  2040. EE := TPasImplTryExceptElse(T.ElseBranch);
  2041. AssertEquals(1, EE.Elements.Count);
  2042. AssertNotNull(EE.Elements[0]);
  2043. AssertEquals('Simple statement', TPasImplSimple, TPasElement(EE.Elements[0]).ClassType);
  2044. S := TPasImplSimple(EE.Elements[0]);
  2045. AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomethingMore');
  2046. AssertPasWriteOutput('output', BuildString(['program afile;',
  2047. '', 'var', ' b: Boolean;', '', 'begin',
  2048. ' try', ' DoSomething;', ' except', ' On E : Exception do',
  2049. ' if b then', ' DoSomethingElse;', ' else',
  2050. ' DoSomethingMore;', ' end;', 'end.', '']), PasProgram);
  2051. end;
  2052. procedure TTestStatementWriterTry.TestTryExceptOnIfElse;
  2053. var
  2054. T: TPasImplTry;
  2055. S: TPasImplSimple;
  2056. E: TPasImplTryExcept;
  2057. O: TPasImplExceptOn;
  2058. EE: TPasImplTryExceptElse;
  2059. begin
  2060. TestStatement(['Try', ' DoSomething;', 'except', 'On E : Exception do',
  2061. 'DoSomethingElse;', 'else', 'DoSomethingMore;', 'end']);
  2062. T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
  2063. AssertEquals(1, T.Elements.Count);
  2064. AssertNotNull(T.FinallyExcept);
  2065. AssertNotNull(T.ElseBranch);
  2066. AssertNotNull(T.Elements[0]);
  2067. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  2068. S := TPasImplSimple(T.Elements[0]);
  2069. AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething');
  2070. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  2071. AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
  2072. E := TPasImplTryExcept(T.FinallyExcept);
  2073. AssertEquals(1, E.Elements.Count);
  2074. AssertEquals('Except on handler', TPasImplExceptOn, TPasElement(
  2075. E.Elements[0]).ClassType);
  2076. O := TPasImplExceptOn(E.Elements[0]);
  2077. AssertEquals('Exception Variable name', 'E', O.VariableName);
  2078. AssertEquals('Exception Type name', 'Exception', O.TypeName);
  2079. AssertEquals(1, O.Elements.Count);
  2080. AssertEquals('Simple statement', TPasImplSimple, TPasElement(O.Elements[0]).ClassType);
  2081. S := TPasImplSimple(O.Elements[0]);
  2082. AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse');
  2083. AssertEquals('Except Else statement', TPasImplTryExceptElse, T.ElseBranch.ClassType);
  2084. EE := TPasImplTryExceptElse(T.ElseBranch);
  2085. AssertEquals(1, EE.Elements.Count);
  2086. AssertNotNull(EE.Elements[0]);
  2087. AssertEquals('Simple statement', TPasImplSimple, TPasElement(EE.Elements[0]).ClassType);
  2088. S := TPasImplSimple(EE.Elements[0]);
  2089. AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomethingMore');
  2090. AssertPasWriteOutput('output', BuildString(
  2091. ['program afile;', '', '', 'begin', ' try', ' DoSomething;',
  2092. ' except', ' On E : Exception do', ' DoSomethingElse;', ' else',
  2093. ' DoSomethingMore;', ' end;', 'end.', '']), PasProgram);
  2094. end;
  2095. procedure TTestStatementWriterTry.TestTryExceptOnElseNoSemicolo;
  2096. var
  2097. T: TPasImplTry;
  2098. S: TPasImplSimple;
  2099. E: TPasImplTryExcept;
  2100. O: TPasImplExceptOn;
  2101. EE: TPasImplTryExceptElse;
  2102. begin
  2103. TestStatement(['Try', ' DoSomething;', 'except', 'On E : Exception do',
  2104. 'DoSomethingElse', 'else', 'DoSomethingMore', 'end']);
  2105. T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
  2106. AssertEquals(1, T.Elements.Count);
  2107. AssertNotNull(T.FinallyExcept);
  2108. AssertNotNull(T.ElseBranch);
  2109. AssertNotNull(T.Elements[0]);
  2110. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  2111. S := TPasImplSimple(T.Elements[0]);
  2112. AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething');
  2113. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  2114. AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
  2115. E := TPasImplTryExcept(T.FinallyExcept);
  2116. AssertEquals(1, E.Elements.Count);
  2117. AssertEquals('Except on handler', TPasImplExceptOn, TPasElement(
  2118. E.Elements[0]).ClassType);
  2119. O := TPasImplExceptOn(E.Elements[0]);
  2120. AssertEquals('Exception Variable name', 'E', O.VariableName);
  2121. AssertEquals('Exception Type name', 'Exception', O.TypeName);
  2122. AssertEquals(1, O.Elements.Count);
  2123. AssertEquals('Simple statement', TPasImplSimple, TPasElement(O.Elements[0]).ClassType);
  2124. S := TPasImplSimple(O.Elements[0]);
  2125. AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse');
  2126. AssertEquals('Except Else statement', TPasImplTryExceptElse, T.ElseBranch.ClassType);
  2127. EE := TPasImplTryExceptElse(T.ElseBranch);
  2128. AssertEquals(1, EE.Elements.Count);
  2129. AssertNotNull(EE.Elements[0]);
  2130. AssertEquals('Simple statement', TPasImplSimple, TPasElement(EE.Elements[0]).ClassType);
  2131. S := TPasImplSimple(EE.Elements[0]);
  2132. AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomethingMore');
  2133. AssertPasWriteOutput('output', BuildString(
  2134. ['program afile;', '', '', 'begin', ' try', ' DoSomething;',
  2135. ' except', ' On E : Exception do', ' DoSomethingElse;', ' else',
  2136. ' DoSomethingMore;', ' end;', 'end.', '']), PasProgram);
  2137. end;
  2138. procedure TTestStatementWriterTry.TestTryExceptRaise;
  2139. var
  2140. T: TPasImplTry;
  2141. S: TPasImplSimple;
  2142. E: TPasImplTryExcept;
  2143. begin
  2144. TestStatement(['Try', ' DoSomething;', 'except', ' raise', 'end']);
  2145. T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
  2146. AssertEquals(1, T.Elements.Count);
  2147. AssertNotNull(T.FinallyExcept);
  2148. AssertNull(T.ElseBranch);
  2149. AssertNotNull(T.Elements[0]);
  2150. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  2151. S := TPasImplSimple(T.Elements[0]);
  2152. AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething');
  2153. AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
  2154. AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
  2155. E := TPasImplTryExcept(T.FinallyExcept);
  2156. AssertEquals(1, E.Elements.Count);
  2157. AssertEquals('Raise statement', TPasImplRaise, TPasElement(E.Elements[0]).ClassType);
  2158. AssertPasWriteOutput('output', BuildString(
  2159. ['program afile;', '', '', 'begin', ' try', ' DoSomething;',
  2160. ' except', ' raise;', ' end;', 'end.', '']), PasProgram);
  2161. end;
  2162. procedure TTestStatementWriterAsm.TestAsm;
  2163. var
  2164. T: TPasImplAsmStatement;
  2165. begin
  2166. TestStatement(['asm', ' mov eax,1', 'end;']);
  2167. T := AssertStatement('Asm statement', TPasImplAsmStatement) as TPasImplAsmStatement;
  2168. AssertEquals('Asm tokens', 4, T.Tokens.Count);
  2169. AssertEquals('token 1 ', 'mov', T.Tokens[0]);
  2170. AssertEquals('token 2 ', 'eax', T.Tokens[1]);
  2171. AssertEquals('token 3 ', ',', T.Tokens[2]);
  2172. AssertEquals('token 4 ', '1', T.Tokens[3]);
  2173. AssertPasWriteOutput('output', BuildString(['program afile;',
  2174. '', '', 'begin', 'end.', '']), PasProgram);
  2175. end;
  2176. procedure TTestStatementWriterAsm.TestAsmBlock;
  2177. begin
  2178. Source.Add('{$MODE DELPHI}');
  2179. Source.Add('function BitsHighest(X: Cardinal): Integer;');
  2180. Source.Add('asm');
  2181. Source.Add('end;');
  2182. Source.Add('begin');
  2183. Source.Add('end.');
  2184. ParseModule;
  2185. AssertPasWriteOutput('output', BuildString(['program afile;',
  2186. '', 'function BitsHighest(X: Cardinal): Integer;', 'begin',
  2187. 'end;', '', '', 'begin', 'end.', '']), PasProgram);
  2188. end;
  2189. procedure TTestStatementWriterAsm.TestAsmBlockWithEndLabel;
  2190. begin
  2191. Source.Add('{$MODE DELPHI}');
  2192. Source.Add('function BitsHighest(X: Cardinal): Integer;');
  2193. Source.Add('asm');
  2194. Source.Add(' MOV ECX, EAX');
  2195. Source.Add(' MOV EAX, -1');
  2196. Source.Add(' BSR EAX, ECX');
  2197. Source.Add(' JNZ @@End');
  2198. Source.Add(' MOV EAX, -1');
  2199. Source.Add('@@End:');
  2200. Source.Add('end;');
  2201. Source.Add('begin');
  2202. Source.Add('end.');
  2203. ParseModule;
  2204. AssertPasWriteOutput('output', BuildString(['program afile;',
  2205. '', 'function BitsHighest(X: Cardinal): Integer;', 'begin',
  2206. 'end;', '', '', 'begin', 'end.', '']), PasProgram);
  2207. end;
  2208. procedure TTestStatementWriterAsm.TestAsmBlockInIfThen;
  2209. begin
  2210. Source.Add('{$MODE DELPHI}');
  2211. Source.Add('function Get8087StatusWord(ClearExceptions: Boolean): Word;');
  2212. Source.Add(' begin');
  2213. Source.Add(' if ClearExceptions then');
  2214. Source.Add(' asm');
  2215. Source.Add(' end');
  2216. Source.Add(' else');
  2217. Source.Add(' asm');
  2218. Source.Add(' end;');
  2219. Source.Add(' end;');
  2220. Source.Add(' begin');
  2221. Source.Add(' end.');
  2222. ParseModule;
  2223. AssertPasWriteOutput('output', BuildString(['program afile;',
  2224. '', '', 'begin', 'end.', '']), PasProgram);
  2225. end;
  2226. procedure TTestStatementWriterSpecials.TestAssignToAddress;
  2227. begin
  2228. AddStatements(['@Proc:=Nil']);
  2229. ParseModule;
  2230. AssertPasWriteOutput('output', BuildString(['program afile;',
  2231. '', '', 'begin', ' @ Proc := Nil;', 'end.', '']), PasProgram);
  2232. end;
  2233. procedure TTestStatementWriterSpecials.TestFinalizationNoSemicolon;
  2234. begin
  2235. Source.Add('unit afile;');
  2236. Source.Add('{$mode objfpc}');
  2237. Source.Add('interface');
  2238. Source.Add('implementation');
  2239. Source.Add('initialization');
  2240. Source.Add(' writeln(''qqq'')');
  2241. Source.Add('finalization');
  2242. Source.Add(' write(''rrr'')');
  2243. ParseModule;
  2244. AssertPasWriteOutput('output', BuildString(['unit afile;',
  2245. '',
  2246. 'interface',
  2247. '',
  2248. '',
  2249. '',
  2250. 'implementation',
  2251. '',
  2252. '',
  2253. 'initialization',
  2254. ' writeln(''qqq'');',
  2255. 'finalization',
  2256. ' write(''rrr'');',
  2257. 'end.','']), Module);
  2258. end;
  2259. procedure TTestStatementWriterSpecials.TestMacroComment;
  2260. begin
  2261. AddStatements(['{$MACRO ON}', '{$DEFINE func := //}', ' calltest;',
  2262. ' func (''1'',''2'',''3'');', 'CallTest2;']);
  2263. ParseModule;
  2264. AssertPasWriteOutput('output', BuildString(['program afile;',
  2265. '', '', 'begin', ' calltest;', ' CallTest2;',
  2266. 'end.', '']), PasProgram);
  2267. end;
  2268. procedure TTestStatementWriterSpecials.TestPlatformIdentifier;
  2269. begin
  2270. AddStatements(['write(platform);']);
  2271. ParseModule;
  2272. AssertPasWriteOutput('output', BuildString(['program afile;',
  2273. '', '', 'begin', ' write(platform);', 'end.', '']), PasProgram);
  2274. end;
  2275. procedure TTestStatementWriterSpecials.TestPlatformIdentifier2;
  2276. begin
  2277. AddStatements(['write(libs+platform);']);
  2278. ParseModule;
  2279. AssertPasWriteOutput('output', BuildString(['program afile;',
  2280. '', '', 'begin', ' write(libs + platform);', 'end.', '']),
  2281. PasProgram);
  2282. end;
  2283. procedure TTestStatementWriterSpecials.TestArgumentNameOn;
  2284. begin
  2285. Source.Add('function TryOn(const on: boolean): boolean;');
  2286. Source.Add(' begin');
  2287. Source.Add(' end;');
  2288. Source.Add(' begin');
  2289. Source.Add(' end.');
  2290. ParseModule;
  2291. AssertPasWriteOutput('output', BuildString(['program afile;',
  2292. '', 'function TryOn(const on: Boolean): Boolean;', 'begin',
  2293. 'end;', '', '', 'begin', 'end.', '']), PasProgram);
  2294. end;
  2295. procedure TTestStatementWriterSpecials.TestGotoInIfThen;
  2296. begin
  2297. AddStatements(['{$goto on}', 'if expr then', ' dosomething',
  2298. ' else if expr2 then', ' goto try_qword', ' else',
  2299. ' dosomething;', ' try_qword:', ' dosomething;']);
  2300. ParseModule;
  2301. AssertPasWriteOutput('output', BuildString(['program afile;',
  2302. '', '', 'begin', ' if expr then', ' dosomething',
  2303. ' else if expr2 then', ' goto try_qword', ' else',
  2304. ' dosomething;', ' try_qword:', ' dosomething;',
  2305. 'end.', '']), PasProgram);
  2306. end;
  2307. initialization
  2308. RegisterTests('TestPasSrcWriter',
  2309. [TTestStatementWriterEmpty, TTestStatementWriterBlock, TTestStatementWriterAssignment,
  2310. TTestStatementWriterCall, TTestStatementWriterIf, TTestStatementWriterCase,
  2311. TTestStatementWriterWith, TTestStatementWriterLoops, TTestStatementWriterRaise,
  2312. TTestStatementWriterTry, TTestStatementWriterAsm, TTestStatementWriterSpecials]);
  2313. end.