123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595 |
- {
- Examples:
- ./testpassrc --suite=TTestStatementParser.TestCallQualified2
- }
- unit tcPasWriteStatements;
- {$mode objfpc}{$H+}
- interface
- uses
- Classes, SysUtils, fpcunit, PasTree, PScanner, PParser, PasWrite,
- tcbaseparser, testregistry;
- type
- { TTestStatementWriterBase }
- TTestStatementWriterBase = class(TTestParser)
- private
- FPasWriter: TPasWriter;
- FStatement: TPasImplBlock;
- FTestStream: TMemoryStream;
- FVariables: TStrings;
- procedure TestCallFormat(FN: string; AddPrecision: boolean;
- AddSecondParam: boolean = False);
- protected
- procedure SetUp; override;
- procedure TearDown; override;
- procedure AddStatements(ASource: array of string);
- function BuildString(ASource: array of string): string;
- procedure DeclareVar(const AVarType: string; const AVarName: string = 'A');
- function TestStatement(ASource: string): TPasImplElement;
- function TestStatement(ASource: array of string): TPasImplElement;
- procedure ExpectParserError(const Msg: string);
- procedure ExpectParserError(const Msg: string; ASource: array of string);
- function AssertStatement(Msg: string;
- AClass: TClass; AIndex: integer = 0): TPasImplBlock;
- procedure AssertPasWriteOutput(Msg, ExpResult: string; aProgram: TPasElement);
- property Statement: TPasImplBlock read FStatement;
- published
- end;
- { TTestStatementWriterEmpty }
- TTestStatementWriterEmpty = class(TTestStatementWriterBase)
- published
- procedure TestEmpty;
- procedure TestEmptyStatement;
- procedure TestEmptyStatements;
- end;
- { TTestStatementWriterBlock }
- TTestStatementWriterBlock = class(TTestStatementWriterBase)
- published
- procedure TestBlock;
- procedure TestBlockComment;
- procedure TestBlock2Comments;
- end;
- { TTestStatementWriterAssignment }
- TTestStatementWriterAssignment = class(TTestStatementWriterBase)
- published
- procedure TestAssignment;
- procedure TestAssignmentAdd;
- procedure TestAssignmentMinus;
- procedure TestAssignmentMul;
- procedure TestAssignmentDivision;
- // Procedure TestAssignmentMissingSemicolonError;
- end;
- { TTestStatementWriterCall }
- TTestStatementWriterCall = class(TTestStatementWriterBase)
- published
- procedure TestCall;
- procedure TestCallComment;
- procedure TestCallQualified;
- procedure TestCallQualified2;
- procedure TestCallNoArgs;
- procedure TestCallOneArg;
- procedure TestCallWriteFormat1;
- procedure TestCallWriteFormat2;
- procedure TestCallWriteFormat3;
- procedure TestCallWriteFormat4;
- procedure TestCallWritelnFormat1;
- procedure TestCallWritelnFormat2;
- procedure TestCallStrFormat1;
- procedure TestCallStrFormat2;
- end;
- { TTestStatementWriterIf }
- TTestStatementWriterIf = class(TTestStatementWriterBase)
- published
- procedure TestIf;
- procedure TestIfBlock;
- procedure TestIfAssignment;
- procedure TestIfElse;
- procedure TestIfElseBlock;
- procedure TestIfElseInBlock;
- procedure TestIfforElseBlock;
- procedure TestIfRaiseElseBlock;
- procedure TestIfWithBlock;
- procedure TestNestedIf;
- procedure TestNestedIfElse;
- procedure TestNestedIfElseElse;
- procedure TestIfIfElseElseBlock;
- end;
- { TTestStatementWriterLoops }
- TTestStatementWriterLoops = class(TTestStatementWriterBase)
- published
- procedure TestWhile;
- procedure TestWhileBlock;
- procedure TestWhileNested;
- procedure TestRepeat;
- procedure TestRepeatBlock;
- procedure TestRepeatBlockNosemicolon;
- procedure TestRepeatNested;
- procedure TestFor;
- procedure TestForIn;
- procedure TestForExpr;
- procedure TestForBlock;
- procedure TestDowntoBlock;
- procedure TestForNested;
- end;
- { TTestStatementWriterWith }
- TTestStatementWriterWith = class(TTestStatementWriterBase)
- published
- procedure TestWith;
- procedure TestWithMultiple;
- end;
- { TTestStatementWriterCase }
- TTestStatementWriterCase = class(TTestStatementWriterBase)
- published
- //Procedure TestCaseEmpty;
- procedure TestCaseOneInteger;
- procedure TestCaseTwoIntegers;
- procedure TestCaseRange;
- procedure TestCaseRangeSeparate;
- procedure TestCase2Cases;
- procedure TestCaseBlock;
- procedure TestCaseElseBlockEmpty;
- procedure TestCaseOtherwiseBlockEmpty;
- procedure TestCaseElseBlockAssignment;
- procedure TestCaseElseBlock2Assignments;
- procedure TestCaseIfCaseElse;
- procedure TestCaseIfCaseElseElse;
- procedure TestCaseIfElse;
- procedure TestCaseElseNoSemicolon;
- procedure TestCaseIfElseNoSemicolon;
- procedure TestCaseIfOtherwiseNoSemicolon;
- end;
- { TTestStatementWriterRaise }
- TTestStatementWriterRaise = class(TTestStatementWriterBase)
- published
- procedure TestRaise;
- procedure TestRaiseEmpty;
- procedure TestRaiseAt;
- end;
- { TTestStatementWriterTry }
- TTestStatementWriterTry = class(TTestStatementWriterBase)
- published
- procedure TestTryFinally;
- procedure TestTryFinallyEmpty;
- procedure TestTryFinallyNested;
- procedure TestTryExcept;
- procedure TestTryExceptNested;
- procedure TestTryExceptEmpty;
- procedure TestTryExceptOn;
- procedure TestTryExceptOn2;
- procedure TestTryExceptOnElse;
- procedure TestTryExceptOnIfElse;
- procedure TestTryExceptOnElseNoSemicolo;
- procedure TestTryExceptRaise;
- end;
- { TTestStatementWriterAsm }
- TTestStatementWriterAsm = class(TTestStatementWriterBase)
- published
- procedure TestAsm;
- procedure TestAsmBlock;
- procedure TestAsmBlockWithEndLabel;
- procedure TestAsmBlockInIfThen;
- end;
- { TTestStatementWriterSpecials }
- TTestStatementWriterSpecials = class(TTestStatementWriterBase)
- published
- procedure TestGotoInIfThen;
- procedure TestAssignToAddress;
- procedure TestFinalizationNoSemicolon;
- procedure TestMacroComment;
- procedure TestPlatformIdentifier;
- procedure TestPlatformIdentifier2;
- procedure TestArgumentNameOn;
- end;
- implementation
- { TTestStatementWriterBase }
- procedure TTestStatementWriterBase.SetUp;
- begin
- inherited SetUp;
- FVariables := TStringList.Create;
- FTestStream := TMemoryStream.Create;
- FPasWriter := TPasWriter.Create(FTestStream);
- end;
- procedure TTestStatementWriterBase.TearDown;
- begin
- FreeAndNil(FPasWriter);
- FreeAndNil(FTestStream);
- FreeAndNil(FVariables);
- inherited TearDown;
- end;
- procedure TTestStatementWriterBase.AddStatements(ASource: array of string);
- var
- I: integer;
- begin
- StartProgram(ExtractFileUnitName(MainFilename));
- if FVariables.Count > 0 then
- begin
- Add('Var');
- for I := 0 to FVariables.Count - 1 do
- Add(' ' + Fvariables[I]);
- end;
- Add('begin');
- for I := Low(ASource) to High(ASource) do
- Add(' ' + ASource[i]);
- end;
- function TTestStatementWriterBase.BuildString(ASource: array of string): string;
- begin
- Result := string.Join(LineEnding, ASource);
- end;
- procedure TTestStatementWriterBase.DeclareVar(const AVarType: string;
- const AVarName: string);
- begin
- FVariables.Add(AVarName + ' : ' + AVarType + ';');
- end;
- function TTestStatementWriterBase.TestStatement(ASource: string): TPasImplElement;
- begin
- Result := TestStatement([ASource]);
- end;
- function TTestStatementWriterBase.TestStatement(ASource: array of string):
- TPasImplElement;
- begin
- Result := nil;
- FStatement := nil;
- AddStatements(ASource);
- ParseModule;
- AssertEquals('Have program', TPasProgram, Module.ClassType);
- AssertNotNull('Have program section', PasProgram.ProgramSection);
- AssertNotNull('Have initialization section', PasProgram.InitializationSection);
- if (PasProgram.InitializationSection.Elements.Count > 0) then
- if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then
- FStatement := TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
- Result := FStatement;
- end;
- procedure TTestStatementWriterBase.ExpectParserError(const Msg: string);
- begin
- AssertException(Msg, EParserError, @ParseModule);
- end;
- procedure TTestStatementWriterBase.ExpectParserError(const Msg: string;
- ASource: array of string);
- begin
- AddStatements(ASource);
- ExpectParserError(Msg);
- end;
- function TTestStatementWriterBase.AssertStatement(Msg: string;
- AClass: TClass; AIndex: integer): TPasImplBlock;
- begin
- if not (AIndex < PasProgram.InitializationSection.Elements.Count) then
- Fail(Msg + ': No such statement : ' + IntToStr(AIndex));
- AssertNotNull(Msg + ' Have statement', PasProgram.InitializationSection.Elements[AIndex]);
- AssertEquals(Msg + ' statement class', AClass, TObject(
- PasProgram.InitializationSection.Elements[AIndex]).ClassType);
- Result := TObject(PasProgram.InitializationSection.Elements[AIndex]) as TPasImplBlock;
- end;
- procedure TTestStatementWriterBase.AssertPasWriteOutput(Msg, ExpResult: string;
- aProgram: TPasElement);
- var
- aString: string;
- begin
- FPasWriter.WriteElement(aProgram);
- FTestStream.Seek(0, soBeginning);
- setlength(aString, FTestStream.Size);
- FTestStream.ReadBuffer(aString[1], FTestStream.Size);
- AssertEquals(Testname + ': ' + Msg, ExpResult, aString);
- AssertEquals(Testname + ': Streamsize', length(expResult), FTestStream.Size);
- end;
- // Tests -----------------------------------------------------------------
- procedure TTestStatementWriterEmpty.TestEmpty;
- begin
- //TestStatement(';');
- TestStatement('');
- AssertEquals('No statements', 0, PasProgram.InitializationSection.Elements.Count);
- AssertPasWriteOutput('output', 'program afile;'#13#10#13#10#13#10'begin'#13#10'end.'#13#10, PasProgram);
- end;
- procedure TTestStatementWriterEmpty.TestEmptyStatement;
- begin
- TestStatement(';');
- AssertEquals('0 statement', 0, PasProgram.InitializationSection.Elements.Count);
- AssertPasWriteOutput('output', 'program afile;'#13#10#13#10#13#10'begin'#13#10'end.'#13#10, PasProgram);
- end;
- procedure TTestStatementWriterEmpty.TestEmptyStatements;
- begin
- TestStatement(';;');
- AssertEquals('0 statement', 0, PasProgram.InitializationSection.Elements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterBlock.TestBlock;
- var
- B: TPasImplBeginBlock;
- begin
- TestStatement(['begin', 'end']);
- AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
- AssertNotNull('Statement assigned', PasProgram.InitializationSection.Elements[0]);
- AssertEquals('Block statement', TPasImplBeginBlock, Statement.ClassType);
- B := Statement as TPasImplBeginBlock;
- AssertEquals('Empty block', 0, B.Elements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', 'begin', 'end;', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterBlock.TestBlockComment;
- var
- B: TPasImplBeginBlock;
- begin
- Engine.NeedComments := True;
- TestStatement(['{ This is a comment }', 'begin', 'end']);
- AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
- AssertNotNull('Statement assigned', PasProgram.InitializationSection.Elements[0]);
- AssertEquals('Block statement', TPasImplBeginBlock, Statement.ClassType);
- B := Statement as TPasImplBeginBlock;
- AssertEquals('Empty block', 0, B.Elements.Count);
- AssertEquals('No DocComment', '', B.DocComment);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', 'begin', 'end;', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterBlock.TestBlock2Comments;
- var
- B: TPasImplBeginBlock;
- begin
- Engine.NeedComments := True;
- TestStatement(['{ This is a comment }', '// Another comment', 'begin', 'end']);
- AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
- AssertNotNull('Statement assigned', PasProgram.InitializationSection.Elements[0]);
- AssertEquals('Block statement', TPasImplBeginBlock, Statement.ClassType);
- B := Statement as TPasImplBeginBlock;
- AssertEquals('Empty block', 0, B.Elements.Count);
- AssertEquals('No DocComment', '', B.DocComment);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', 'begin', 'end;', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterAssignment.TestAssignment;
- var
- A: TPasImplAssign;
- begin
- DeclareVar('integer');
- TestStatement(['a:=1;']);
- AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
- AssertEquals('Assignment statement', TPasImplAssign, Statement.ClassType);
- A := Statement as TPasImplAssign;
- AssertEquals('Normal assignment', akDefault, A.Kind);
- AssertExpression('Right side is constant', A.Right, pekNumber, '1');
- AssertExpression('Left side is variable', A.Left, pekIdent, 'a');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', '', 'begin',
- ' a := 1;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterAssignment.TestAssignmentAdd;
- var
- A: TPasImplAssign;
- begin
- Parser.Scanner.Options := [po_cassignments];
- DeclareVar('integer');
- TestStatement(['a+=1;']);
- AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
- AssertEquals('Assignment statement', TPasImplAssign, Statement.ClassType);
- A := Statement as TPasImplAssign;
- AssertEquals('Add assignment', akAdd, A.Kind);
- AssertExpression('Right side is constant', A.Right, pekNumber, '1');
- AssertExpression('Left side is variable', A.Left, pekIdent, 'a');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', '', 'begin',
- ' a += 1;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterAssignment.TestAssignmentMinus;
- var
- A: TPasImplAssign;
- begin
- Parser.Scanner.Options := [po_cassignments];
- DeclareVar('integer');
- TestStatement(['a-=1;']);
- AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
- AssertEquals('Assignment statement', TPasImplAssign, Statement.ClassType);
- A := Statement as TPasImplAssign;
- AssertEquals('Minus assignment', akMinus, A.Kind);
- AssertExpression('Right side is constant', A.Right, pekNumber, '1');
- AssertExpression('Left side is variable', A.Left, pekIdent, 'a');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', '', 'begin',
- ' a -= 1;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterAssignment.TestAssignmentMul;
- var
- A: TPasImplAssign;
- begin
- Parser.Scanner.Options := [po_cassignments];
- DeclareVar('integer');
- TestStatement(['a*=1;']);
- AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
- AssertEquals('Assignment statement', TPasImplAssign, Statement.ClassType);
- A := Statement as TPasImplAssign;
- AssertEquals('Mul assignment', akMul, A.Kind);
- AssertExpression('Right side is constant', A.Right, pekNumber, '1');
- AssertExpression('Left side is variable', A.Left, pekIdent, 'a');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', '', 'begin',
- ' a *= 1;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterAssignment.TestAssignmentDivision;
- var
- A: TPasImplAssign;
- begin
- Parser.Scanner.Options := [po_cassignments];
- DeclareVar('integer');
- TestStatement(['a/=1;']);
- AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
- AssertEquals('Assignment statement', TPasImplAssign, Statement.ClassType);
- A := Statement as TPasImplAssign;
- AssertEquals('Division assignment', akDivision, A.Kind);
- AssertExpression('Right side is constant', A.Right, pekNumber, '1');
- AssertExpression('Left side is variable', A.Left, pekIdent, 'a');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', '', 'begin',
- ' a /= 1;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCall.TestCall;
- var
- S: TPasImplSimple;
- begin
- TestStatement('Doit;');
- AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, Statement.ClassType);
- S := Statement as TPasImplSimple;
- AssertExpression('Doit call', S.Expr, pekIdent, 'Doit');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' Doit;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCall.TestCallComment;
- var
- S: TPasImplSimple;
- begin
- Engine.NeedComments := True;
- TestStatement(['//comment line', 'Doit;']);
- AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, Statement.ClassType);
- AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
- S := Statement as TPasImplSimple;
- AssertExpression('Doit call', S.Expr, pekIdent, 'Doit');
- AssertEquals('No DocComment', '', S.DocComment);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' Doit;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCall.TestCallQualified;
- var
- S: TPasImplSimple;
- B: TBinaryExpr;
- begin
- TestStatement('Unita.Doit;');
- AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, Statement.ClassType);
- S := Statement as TPasImplSimple;
- AssertExpression('Doit call', S.Expr, pekBinary, TBinaryExpr);
- B := S.Expr as TBinaryExpr;
- TAssert.AssertSame('B.left.Parent=B', B, B.left.Parent);
- TAssert.AssertSame('B.right.Parent=B', B, B.right.Parent);
- AssertExpression('Unit name', B.Left, pekIdent, 'Unita');
- AssertExpression('Doit call', B.Right, pekIdent, 'Doit');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' Unita.Doit;', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterCall.TestCallQualified2;
- var
- S: TPasImplSimple;
- B: TBinaryExpr;
- begin
- TestStatement('Unita.ClassB.Doit;');
- AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, Statement.ClassType);
- S := Statement as TPasImplSimple;
- AssertExpression('Doit call', S.Expr, pekBinary, TBinaryExpr);
- B := S.Expr as TBinaryExpr;
- AssertExpression('Doit call', B.Right, pekIdent, 'Doit');
- AssertExpression('First two parts of unit name', B.left, pekBinary, TBinaryExpr);
- B := B.left as TBinaryExpr;
- AssertExpression('Unit name part 1', B.Left, pekIdent, 'Unita');
- AssertExpression('Unit name part 2', B.right, pekIdent, 'ClassB');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' Unita.ClassB.Doit;', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterCall.TestCallNoArgs;
- var
- S: TPasImplSimple;
- P: TParamsExpr;
- begin
- TestStatement('Doit();');
- AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, Statement.ClassType);
- S := Statement as TPasImplSimple;
- AssertExpression('Doit call', S.Expr, pekFuncParams, TParamsExpr);
- P := S.Expr as TParamsExpr;
- AssertExpression('Correct function call name', P.Value, pekIdent, 'Doit');
- AssertEquals('No params', 0, Length(P.Params));
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' Doit();', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCall.TestCallOneArg;
- var
- S: TPasImplSimple;
- P: TParamsExpr;
- begin
- TestStatement('Doit(1);');
- AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, Statement.ClassType);
- S := Statement as TPasImplSimple;
- AssertExpression('Doit call', S.Expr, pekFuncParams, TParamsExpr);
- P := S.Expr as TParamsExpr;
- AssertExpression('Correct function call name', P.Value, pekIdent, 'Doit');
- AssertEquals('One param', 1, Length(P.Params));
- AssertExpression('Parameter is constant', P.Params[0], pekNumber, '1');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' Doit(1);', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterBase.TestCallFormat(FN: string;
- AddPrecision: boolean; AddSecondParam: boolean);
- var
- P: TParamsExpr;
- procedure CheckParam(Index: integer; const aParamName: string);
- begin
- AssertExpression('Parameter[' + IntToStr(Index) + '] is identifier',
- P.Params[Index], pekIdent, aParamName);
- AssertExpression('Parameter[' + IntToStr(Index) + '] has formatting constant 1'
- , P.Params[Index].format1, pekNumber, '3');
- if AddPrecision then
- AssertExpression('Parameter[' + IntToStr(Index) + '] has formatting constant 2',
- P.Params[Index].format2, pekNumber, '2');
- end;
- var
- S: TPasImplSimple;
- N: string;
- ArgCnt: integer;
- begin
- N := fn + '(a:3';
- if AddPrecision then
- N := N + ':2';
- ArgCnt := 1;
- if AddSecondParam then
- begin
- ArgCnt := 2;
- N := N + ',b:3';
- if AddPrecision then
- N := N + ':2';
- end;
- N := N + ');';
- TestStatement(N);
- AssertEquals('1 statement', 1, PasProgram.InitializationSection.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, Statement.ClassType);
- S := Statement as TPasImplSimple;
- AssertExpression('Doit call', S.Expr, pekFuncParams, TParamsExpr);
- P := S.Expr as TParamsExpr;
- AssertExpression('Correct function call name', P.Value, pekIdent, FN);
- AssertEquals(IntToStr(ArgCnt) + ' param', ArgCnt, Length(P.Params));
- CheckParam(0, 'a');
- if AddSecondParam then
- CheckParam(1, 'b');
- end;
- procedure TTestStatementWriterCall.TestCallWriteFormat1;
- begin
- TestCallFormat('write', False);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' write(a:3);', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterCall.TestCallWriteFormat2;
- begin
- TestCallFormat('write', True);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' write(a:3:2);', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterCall.TestCallWriteFormat3;
- begin
- TestCallFormat('write', False, True);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' write(a:3, b:3);', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterCall.TestCallWriteFormat4;
- begin
- TestCallFormat('write', True, True);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' write(a:3:2, b:3:2);',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCall.TestCallWritelnFormat1;
- begin
- TestCallFormat('writeln', False);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' writeln(a:3);', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterCall.TestCallWritelnFormat2;
- begin
- TestCallFormat('writeln', True);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' writeln(a:3:2);', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterCall.TestCallStrFormat1;
- begin
- TestCallFormat('str', False);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' str(a:3);', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCall.TestCallStrFormat2;
- begin
- TestCallFormat('str', True);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' str(a:3:2);', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterIf.TestIf;
- var
- I: TPasImplIfElse;
- begin
- DeclareVar('boolean');
- TestStatement(['if a then', ';']);
- I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
- AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
- AssertNull('No else', i.ElseBranch);
- AssertNull('No if branch', I.IfBranch);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', '', 'begin',
- ' if a then;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterIf.TestIfBlock;
- var
- I: TPasImplIfElse;
- begin
- DeclareVar('boolean');
- TestStatement(['if a then', ' begin', ' end']);
- I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
- AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
- AssertNull('No else', i.ElseBranch);
- AssertNotNull('if branch', I.IfBranch);
- AssertEquals('begin end block', TPasImplBeginBlock, I.ifBranch.ClassType);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', '', 'begin',
- ' if a then', ' begin', ' end;', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterIf.TestIfAssignment;
- var
- I: TPasImplIfElse;
- begin
- DeclareVar('boolean');
- TestStatement(['if a then', ' a:=False;']);
- I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
- AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
- AssertNull('No else', i.ElseBranch);
- AssertNotNull('if branch', I.IfBranch);
- AssertEquals('assignment statement', TPasImplAssign, I.ifBranch.ClassType);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', '', 'begin',
- ' if a then', ' a := False;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterIf.TestIfElse;
- var
- I: TPasImplIfElse;
- begin
- DeclareVar('boolean');
- TestStatement(['if a then', ' begin', ' end', 'else', ';']);
- I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
- AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
- AssertNull('No else', i.ElseBranch);
- AssertNotNull('if branch', I.IfBranch);
- AssertEquals('begin end block', TPasImplBeginBlock, I.ifBranch.ClassType);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', '', 'begin',
- ' if a then', ' begin', ' end;', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterIf.TestIfElseBlock;
- var
- I: TPasImplIfElse;
- begin
- DeclareVar('boolean');
- TestStatement(['if a then', ' begin', ' end', 'else', ' begin', ' end']);
- I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
- AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
- AssertNotNull('if branch', I.IfBranch);
- AssertEquals('begin end block', TPasImplBeginBlock, I.ifBranch.ClassType);
- AssertNotNull('Else branch', i.ElseBranch);
- AssertEquals('begin end block', TPasImplBeginBlock, I.ElseBranch.ClassType);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', '', 'begin',
- ' if a then', ' begin', ' end else', ' begin',
- ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterIf.TestIfElseInBlock;
- var
- B: TPasImplBeginBlock;
- I: TPasImplIfElse;
- begin
- DeclareVar('boolean');
- TestStatement(['begin', ' if a then', ' DoA',
- ' else', 'end']);
- B := AssertStatement('begin block', TPasImplBeginBlock) as TPasImplBeginBlock;
- AssertEquals('One Element', 1, B.Elements.Count);
- AssertEquals('If statement', TPasImplIfElse, TObject(B.Elements[0]).ClassType);
- I := TPasImplIfElse(B.Elements[0]);
- AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
- AssertNotNull('if branch', I.IfBranch);
- AssertEquals('i_br: simple command', TPasImplSimple, I.ifBranch.ClassType);
- AssertExpression('Doit call', TPasImplSimple(I.ifBranch).Expr, pekIdent, 'DoA');
- AssertNull('Else branch', i.ElseBranch);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', '', 'begin',
- 'begin', ' if a then', ' DoA;', 'end;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterIf.TestIfforElseBlock;
- var
- I: TPasImplIfElse;
- begin
- TestStatement(['if a then', 'for X := 1 downto 0 do Writeln(X)', 'else',
- 'for X := 0 to 1 do Writeln(X)']);
- I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
- AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
- AssertEquals('For statement', TPasImplForLoop, I.ifBranch.ClassType);
- AssertEquals('For statement', TPasImplForLoop, I.ElseBranch.ClassType);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' if a then', ' begin',
- ' for X:=1 downto 0 do', ' Writeln(X);', ' end else',
- ' for X:=0 to 1 do', ' Writeln(X);', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterIf.TestIfRaiseElseBlock;
- // Error: to be searched for
- var
- I: TPasImplIfElse;
- begin
- TestStatement(['if a then', 'raise', 'else', 'for X := 0 to 1 do Writeln(X)']);
- I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
- AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
- AssertEquals('For statement', TPasImplRaise, I.ifBranch.ClassType);
- AssertEquals('For statement', TPasImplForLoop, I.ElseBranch.ClassType);
- AssertPasWriteOutput('output', BuildString(['program afile;', '',
- '', 'begin', ' if a then', ' begin', ' raise;', ' end else',
- ' for X:=0 to 1 do', ' Writeln(X);', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterIf.TestIfWithBlock;
- // Error: With not implemented
- var
- I: TPasImplIfElse;
- begin
- TestStatement(['if a then', 'with b do something', 'else',
- 'for X := 0 to 1 do Writeln(X)']);
- I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
- AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
- AssertEquals('For statement', TPasImplWithDo, I.ifBranch.ClassType);
- AssertEquals('For statement', TPasImplForLoop, I.ElseBranch.ClassType);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', '', 'begin',
- ' if a then', ' with b do', ' something',
- ' else', ' for X:=0 to 1 do', ' Writeln(X);',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterIf.TestNestedIf;
- var
- I: TPasImplIfElse;
- begin
- DeclareVar('boolean');
- DeclareVar('boolean', 'b');
- TestStatement(['if a then', ' if b then', ' begin', ' end',
- 'else', ' begin', ' end']);
- I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
- AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
- AssertNotNull('if branch', I.IfBranch);
- AssertNull('Else branch', i.ElseBranch);
- AssertEquals('if in if branch', TPasImplIfElse, I.ifBranch.ClassType);
- I := I.Ifbranch as TPasImplIfElse;
- AssertEquals('begin end block', TPasImplBeginBlock, I.ElseBranch.ClassType);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', ' b: Boolean;',
- '', 'begin', ' if a then', ' if b then',
- ' begin', ' end else', ' begin', ' end;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterIf.TestNestedIfElse;
- var
- I: TPasImplIfElse;
- begin
- DeclareVar('boolean');
- TestStatement(['if a then', ' if b then', ' begin', ' end',
- ' else', ' begin', ' end', 'else', ' begin', 'end']);
- I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
- AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
- AssertNotNull('if branch', I.IfBranch);
- AssertNotNull('Else branch', i.ElseBranch);
- AssertEquals('begin end block', TPasImplBeginBlock, I.ElseBranch.ClassType);
- AssertEquals('if in if branch', TPasImplIfElse, I.ifBranch.ClassType);
- I := I.Ifbranch as TPasImplIfElse;
- AssertEquals('begin end block', TPasImplBeginBlock, I.ElseBranch.ClassType);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', '', 'begin',
- ' if a then', ' begin', ' if b then', ' begin',
- ' end else', ' begin', ' end;', ' end else',
- ' begin', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterIf.TestNestedIfElseElse;
- // Bug ID 37760
- var
- I, I2: TPasImplIfElse;
- begin
- DeclareVar('boolean');
- TestStatement(['if a then', ' if b then',
- ' DoA ', ' else', ' else',
- ' DoB']);
- I := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
- AssertExpression('IF condition', I.ConditionExpr, pekIdent, 'a');
- AssertNotNull('if branch', I.IfBranch);
- AssertNotNull('Have else for outer if', I.ElseBranch);
- AssertEquals('Have if in if branch', TPasImplIfElse, I.ifBranch.ClassType);
- I2 := I.Ifbranch as TPasImplIfElse;
- AssertExpression('IF condition', I2.ConditionExpr, pekIdent, 'b');
- AssertNotNull('Have then for inner if', I2.ifBranch);
- AssertnotNull('Empty else for inner if', I2.ElseBranch);
- AssertEquals('Have a commend for inner if else', TPasImplCommand,
- I2.ElseBranch.ClassType);
- AssertEquals('... an empty command', '', TPasImplCommand(I2.ElseBranch).Command);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', '', 'begin',
- ' if a then', ' begin', ' if b then', ' begin',
- ' DoA;', ' end else', ' end else', ' DoB;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterIf.TestIfIfElseElseBlock;
- var
- OuterIf, InnerIf: TPasImplIfElse;
- begin
- DeclareVar('boolean');
- DeclareVar('boolean', 'B');
- TestStatement(['if a then', 'if b then', ' begin', ' end', 'else',
- 'else', ' begin', ' end']);
- OuterIf := AssertStatement('If statement', TPasImplIfElse) as TPasImplIfElse;
- AssertExpression('IF condition', OuterIf.ConditionExpr, pekIdent, 'a');
- AssertNotNull('if branch', OuterIf.IfBranch);
- AssertEquals('if else block', TPasImplIfElse, OuterIf.ifBranch.ClassType);
- InnerIf := OuterIf.IfBranch as TPasImplIfElse;
- AssertExpression('IF condition', InnerIf.ConditionExpr, pekIdent, 'b');
- AssertNotNull('if branch', InnerIf.IfBranch);
- AssertEquals('begin end block', TPasImplBeginBlock, InnerIf.ifBranch.ClassType);
- AssertNotNull('Else branch', InnerIf.ElseBranch);
- AssertEquals('empty statement', TPasImplCommand, InnerIf.ElseBranch.ClassType);
- AssertEquals('empty command', '', TPasImplCommand(InnerIf.ElseBranch).Command);
- AssertNotNull('Else branch', OuterIf.ElseBranch);
- AssertEquals('begin end block', TPasImplBeginBlock, OuterIf.ElseBranch.ClassType);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', ' B: Boolean;',
- '', 'begin', ' if a then', ' begin',
- ' if b then', ' begin', ' end else',
- ' end else', ' begin', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterLoops.TestWhile;
- var
- W: TPasImplWhileDo;
- begin
- DeclareVar('boolean');
- TestStatement(['While a do ;']);
- W := AssertStatement('While statement', TPasImplWhileDo) as TPasImplWhileDo;
- AssertExpression('While condition', W.ConditionExpr, pekIdent, 'a');
- AssertNull('Empty body', W.Body);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', '', 'begin',
- ' While a do;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterLoops.TestWhileBlock;
- var
- W: TPasImplWhileDo;
- begin
- DeclareVar('boolean');
- TestStatement(['While a do', ' begin', ' end']);
- W := AssertStatement('While statement', TPasImplWhileDo) as TPasImplWhileDo;
- AssertExpression('While condition', W.ConditionExpr, pekIdent, 'a');
- AssertNotNull('Have while body', W.Body);
- AssertEquals('begin end block', TPasImplBeginBlock, W.Body.ClassType);
- AssertEquals('Empty block', 0, TPasImplBeginBlock(W.Body).ELements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', '', 'begin',
- ' While a do', ' begin', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterLoops.TestWhileNested;
- var
- W: TPasImplWhileDo;
- begin
- DeclareVar('boolean');
- DeclareVar('boolean', 'b');
- TestStatement(['While a do', ' while b do', ' begin', ' end']);
- W := AssertStatement('While statement', TPasImplWhileDo) as TPasImplWhileDo;
- AssertExpression('While condition', W.ConditionExpr, pekIdent, 'a');
- AssertNotNull('Have while body', W.Body);
- AssertEquals('Nested while', TPasImplWhileDo, W.Body.ClassType);
- W := W.Body as TPasImplWhileDo;
- AssertExpression('While condition', W.ConditionExpr, pekIdent, 'b');
- AssertNotNull('Have nested while body', W.Body);
- AssertEquals('Nested begin end block', TPasImplBeginBlock, W.Body.ClassType);
- AssertEquals('Empty nested block', 0, TPasImplBeginBlock(W.Body).ELements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', ' b: Boolean;',
- '', 'begin', ' While a do', ' While b do',
- ' begin', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterLoops.TestRepeat;
- var
- R: TPasImplRepeatUntil;
- begin
- DeclareVar('boolean');
- TestStatement(['Repeat', 'Until a;']);
- R := AssertStatement('Repeat statement', TPasImplRepeatUntil) as TPasImplRepeatUntil;
- AssertExpression('repeat condition', R.ConditionExpr, pekIdent, 'a');
- AssertEquals('Empty body', 0, R.Elements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', '', 'begin',
- ' repeat', ' until a;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterLoops.TestRepeatBlock;
- var
- R: TPasImplRepeatUntil;
- begin
- DeclareVar('boolean');
- TestStatement(['Repeat', 'begin', 'end;', 'Until a;']);
- R := AssertStatement('repeat statement', TPasImplRepeatUntil) as TPasImplRepeatUntil;
- AssertExpression('repeat condition', R.ConditionExpr, pekIdent, 'a');
- AssertEquals('Have statement', 1, R.Elements.Count);
- AssertEquals('begin end block', TPasImplBeginBlock, TObject(R.Elements[0]).ClassType);
- AssertEquals('Empty block', 0, TPasImplBeginBlock(R.Elements[0]).ELements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', '', 'begin',
- ' repeat', ' begin', ' end;', ' until a;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterLoops.TestRepeatBlockNosemicolon;
- var
- R: TPasImplRepeatUntil;
- begin
- DeclareVar('boolean');
- TestStatement(['Repeat', 'begin', 'end', 'Until a;']);
- R := AssertStatement('repeat statement', TPasImplRepeatUntil) as TPasImplRepeatUntil;
- AssertExpression('repeat condition', R.ConditionExpr, pekIdent, 'a');
- AssertEquals('Have statement', 1, R.Elements.Count);
- AssertEquals('begin end block', TPasImplBeginBlock, TObject(R.Elements[0]).ClassType);
- AssertEquals('Empty block', 0, TPasImplBeginBlock(R.Elements[0]).ELements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', '', 'begin',
- ' repeat', ' begin', ' end;', ' until a;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterLoops.TestRepeatNested;
- var
- R: TPasImplRepeatUntil;
- begin
- DeclareVar('boolean');
- DeclareVar('boolean', 'b');
- TestStatement(['Repeat', 'repeat', 'begin', 'end', 'until b', 'Until a;']);
- R := AssertStatement('repeat statement', TPasImplRepeatUntil) as TPasImplRepeatUntil;
- AssertExpression('repeat condition', R.ConditionExpr, pekIdent, 'a');
- AssertEquals('Have statement', 1, R.Elements.Count);
- AssertEquals('Nested repeat', TPasImplRepeatUntil, TObject(R.Elements[0]).ClassType);
- R := TPasImplRepeatUntil(R.Elements[0]);
- AssertExpression('repeat condition', R.ConditionExpr, pekIdent, 'b');
- AssertEquals('Have statement', 1, R.Elements.Count);
- AssertEquals('begin end block', TPasImplBeginBlock, TObject(R.Elements[0]).ClassType);
- AssertEquals('Empty block', 0, TPasImplBeginBlock(R.Elements[0]).ELements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Boolean;', ' b: Boolean;',
- '', 'begin', ' repeat', ' repeat', ' begin',
- ' end;', ' until b;', ' until a;', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterLoops.TestFor;
- var
- F: TPasImplForLoop;
- begin
- DeclareVar('integer');
- TestStatement(['For a:=1 to 10 do', ';']);
- F := AssertStatement('For statement', TPasImplForLoop) as TPasImplForLoop;
- AssertExpression('Loop variable name', F.VariableName, pekIdent, 'a');
- AssertEquals('Loop type', ltNormal, F.Looptype);
- AssertEquals('Up loop', False, F.Down);
- AssertExpression('Start value', F.StartExpr, pekNumber, '1');
- AssertExpression('End value', F.EndExpr, pekNumber, '10');
- AssertNull('Empty body', F.Body);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', '', 'begin',
- ' for a:=1 to 10 do;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterLoops.TestForIn;
- var
- F: TPasImplForLoop;
- begin
- DeclareVar('integer');
- TestStatement(['For a in SomeSet Do', ';']);
- F := AssertStatement('For statement', TPasImplForLoop) as TPasImplForLoop;
- AssertExpression('Loop variable name', F.VariableName, pekIdent, 'a');
- AssertEquals('Loop type', ltIn, F.Looptype);
- AssertEquals('In loop', False, F.Down);
- AssertExpression('Start value', F.StartExpr, pekIdent, 'SomeSet');
- AssertNull('Loop type', F.EndExpr);
- AssertNull('Empty body', F.Body);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', '', 'begin',
- ' for a in SomeSet do;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterLoops.TestForExpr;
- var
- F: TPasImplForLoop;
- B: TBinaryExpr;
- begin
- DeclareVar('integer');
- TestStatement(['For a:=1+1 to 5+5 do', ';']);
- F := AssertStatement('For statement', TPasImplForLoop) as TPasImplForLoop;
- AssertExpression('Loop variable name', F.VariableName, pekIdent, 'a');
- AssertEquals('Up loop', False, F.Down);
- AssertExpression('Start expression', F.StartExpr, pekBinary, TBinaryExpr);
- B := F.StartExpr as TBinaryExpr;
- AssertExpression('Start value left', B.left, pekNumber, '1');
- AssertExpression('Start value right', B.right, pekNumber, '1');
- AssertExpression('Start expression', F.StartExpr, pekBinary, TBinaryExpr);
- B := F.EndExpr as TBinaryExpr;
- AssertExpression('End value left', B.left, pekNumber, '5');
- AssertExpression('End value right', B.right, pekNumber, '5');
- AssertNull('Empty body', F.Body);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', '', 'begin',
- ' for a:=1 + 1 to 5 + 5 do;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterLoops.TestForBlock;
- var
- F: TPasImplForLoop;
- begin
- DeclareVar('integer');
- TestStatement(['For a:=1 to 10 do', 'begin', 'end']);
- F := AssertStatement('For statement', TPasImplForLoop) as TPasImplForLoop;
- AssertExpression('Loop variable name', F.VariableName, pekIdent, 'a');
- AssertEquals('Up loop', False, F.Down);
- AssertExpression('Start value', F.StartExpr, pekNumber, '1');
- AssertExpression('End value', F.EndExpr, pekNumber, '10');
- AssertNotNull('Have for body', F.Body);
- AssertEquals('begin end block', TPasImplBeginBlock, F.Body.ClassType);
- AssertEquals('Empty block', 0, TPasImplBeginBlock(F.Body).ELements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', '', 'begin',
- ' for a:=1 to 10 do', ' begin', ' end;', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterLoops.TestDowntoBlock;
- var
- F: TPasImplForLoop;
- begin
- DeclareVar('integer');
- TestStatement(['For a:=10 downto 1 do', 'begin', 'end']);
- F := AssertStatement('For statement', TPasImplForLoop) as TPasImplForLoop;
- AssertExpression('Loop variable name', F.VariableName, pekIdent, 'a');
- AssertEquals('Down loop', True, F.Down);
- AssertExpression('Start value', F.StartExpr, pekNumber, '10');
- AssertExpression('End value', F.EndExpr, pekNumber, '1');
- AssertNotNull('Have for body', F.Body);
- AssertEquals('begin end block', TPasImplBeginBlock, F.Body.ClassType);
- AssertEquals('Empty block', 0, TPasImplBeginBlock(F.Body).ELements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', '', 'begin',
- ' for a:=10 downto 1 do', ' begin', ' end;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterLoops.TestForNested;
- var
- F: TPasImplForLoop;
- begin
- DeclareVar('integer');
- DeclareVar('integer', 'b');
- TestStatement(['For a:=1 to 10 do', 'For b:=11 to 20 do', 'begin', 'end']);
- F := AssertStatement('For statement', TPasImplForLoop) as TPasImplForLoop;
- AssertExpression('Loop variable name', F.VariableName, pekIdent, 'a');
- AssertEquals('Up loop', False, F.Down);
- AssertExpression('Start value', F.StartExpr, pekNumber, '1');
- AssertExpression('End value', F.EndExpr, pekNumber, '10');
- AssertNotNull('Have while body', F.Body);
- AssertEquals('begin end block', TPasImplForLoop, F.Body.ClassType);
- F := F.Body as TPasImplForLoop;
- AssertExpression('Loop variable name', F.VariableName, pekIdent, 'b');
- AssertEquals('Up loop', False, F.Down);
- AssertExpression('Start value', F.StartExpr, pekNumber, '11');
- AssertExpression('End value', F.EndExpr, pekNumber, '20');
- AssertNotNull('Have for body', F.Body);
- AssertEquals('begin end block', TPasImplBeginBlock, F.Body.ClassType);
- AssertEquals('Empty block', 0, TPasImplBeginBlock(F.Body).ELements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', ' b: Integer;',
- '', 'begin', ' for a:=1 to 10 do', ' for b:=11 to 20 do',
- ' begin', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterWith.TestWith;
- // not implemented yet
- var
- W: TpasImplWithDo;
- begin
- DeclareVar('record X,Y : Integer; end');
- TestStatement(['With a do', 'begin', 'end']);
- W := AssertStatement('For statement', TpasImplWithDo) as TpasImplWithDo;
- AssertEquals('1 expression', 1, W.Expressions.Count);
- AssertExpression('With identifier', TPasExpr(W.Expressions[0]), pekIdent, 'a');
- AssertNotNull('Have with body', W.Body);
- AssertEquals('begin end block', TPasImplBeginBlock, W.Body.ClassType);
- AssertEquals('Empty block', 0, TPasImplBeginBlock(W.Body).ELements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: record', ' X,Y: Integer;',
- ' end;', '', 'begin', ' with a do', ' begin',
- ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterWith.TestWithMultiple;
- // not implemented yet
- var
- W: TpasImplWithDo;
- begin
- DeclareVar('record X,Y : Integer; end');
- DeclareVar('record W,Z : Integer; end', 'b');
- TestStatement(['With a,b do', 'begin', 'end']);
- W := AssertStatement('For statement', TpasImplWithDo) as TpasImplWithDo;
- AssertEquals('2 expressions', 2, W.Expressions.Count);
- AssertExpression('With identifier 1', TPasExpr(W.Expressions[0]), pekIdent, 'a');
- AssertExpression('With identifier 2', TPasExpr(W.Expressions[1]), pekIdent, 'b');
- AssertNotNull('Have with body', W.Body);
- AssertEquals('begin end block', TPasImplBeginBlock, W.Body.ClassType);
- AssertEquals('Empty block', 0, TPasImplBeginBlock(W.Body).ELements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: record', ' X,Y: Integer;',
- ' end;', ' b: record', ' W,Z: Integer;',
- ' end;', '', 'begin', ' with a, b do',
- ' begin', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCase.TestCaseOneInteger;
- var
- C: TPasImplCaseOf;
- S: TPasImplCaseStatement;
- begin
- DeclareVar('integer');
- TestStatement(['case a of', '1 : ;', 'end;']);
- C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
- AssertNotNull('Have case expression', C.CaseExpr);
- AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
- AssertNull('No else branch', C.ElseBranch);
- AssertEquals('One case label', 1, C.Elements.Count);
- AssertEquals('Correct case for case label', TPasImplCaseStatement,
- TPasElement(C.Elements[0]).ClassType);
- S := TPasImplCaseStatement(C.Elements[0]);
- AssertEquals('1 expression for case', 1, S.Expressions.Count);
- AssertExpression('With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
- AssertEquals('Empty case label statement', 0, S.Elements.Count);
- AssertNull('Empty case label statement', S.Body);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', '', 'begin', ' case a of',
- ' 1: ;', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCase.TestCaseTwoIntegers;
- var
- C: TPasImplCaseOf;
- S: TPasImplCaseStatement;
- begin
- DeclareVar('integer');
- TestStatement(['case a of', '1,2 : ;', 'end;']);
- C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
- AssertNotNull('Have case expression', C.CaseExpr);
- AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
- AssertNull('No else branch', C.ElseBranch);
- AssertEquals('One case label', 1, C.Elements.Count);
- AssertEquals('Correct case for case label', TPasImplCaseStatement,
- TPasElement(C.Elements[0]).ClassType);
- S := TPasImplCaseStatement(C.Elements[0]);
- AssertEquals('2 expressions for case', 2, S.Expressions.Count);
- AssertExpression('With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
- AssertExpression('With identifier 2', TPasExpr(S.Expressions[1]), pekNumber, '2');
- AssertEquals('Empty case label statement', 0, S.Elements.Count);
- AssertNull('Empty case label statement', S.Body);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', '', 'begin', ' case a of',
- ' 1, 2: ;', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCase.TestCaseRange;
- var
- C: TPasImplCaseOf;
- S: TPasImplCaseStatement;
- begin
- DeclareVar('integer');
- TestStatement(['case a of', '1..3 : ;', 'end;']);
- C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
- AssertNotNull('Have case expression', C.CaseExpr);
- AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
- AssertNull('No else branch', C.ElseBranch);
- AssertEquals('One case label', 1, C.Elements.Count);
- AssertEquals('Correct case for case label', TPasImplCaseStatement,
- TPasElement(C.Elements[0]).ClassType);
- S := TPasImplCaseStatement(C.Elements[0]);
- AssertEquals('1 expression for case', 1, S.Expressions.Count);
- AssertExpression('With identifier 1', TPasExpr(S.Expressions[0]), pekRange, TBinaryExpr);
- AssertEquals('Empty case label statement', 0, S.Elements.Count);
- AssertNull('Empty case label statement', S.Body);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', '', 'begin', ' case a of',
- ' 1..3: ;', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCase.TestCaseRangeSeparate;
- var
- C: TPasImplCaseOf;
- S: TPasImplCaseStatement;
- begin
- DeclareVar('integer');
- TestStatement(['case a of', '1..3,5 : ;', 'end;']);
- C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
- AssertNotNull('Have case expression', C.CaseExpr);
- AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
- AssertNull('No else branch', C.ElseBranch);
- AssertEquals('One case label', 1, C.Elements.Count);
- AssertEquals('Correct case for case label', TPasImplCaseStatement,
- TPasElement(C.Elements[0]).ClassType);
- S := TPasImplCaseStatement(C.Elements[0]);
- AssertEquals('2 expressions for case', 2, S.Expressions.Count);
- AssertExpression('With identifier 1', TPasExpr(S.Expressions[0]), pekRange, TBinaryExpr);
- AssertExpression('With identifier 2', TPasExpr(S.Expressions[1]), pekNumber, '5');
- AssertEquals('Empty case label statement', 0, S.Elements.Count);
- AssertNull('Empty case label statement', S.Body);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', '', 'begin', ' case a of',
- ' 1..3, 5: ;', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCase.TestCase2Cases;
- var
- C: TPasImplCaseOf;
- S: TPasImplCaseStatement;
- begin
- DeclareVar('integer');
- TestStatement(['case a of', '1 : ;', '2 : ;', 'end;']);
- C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
- AssertNotNull('Have case expression', C.CaseExpr);
- AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
- AssertNull('No else branch', C.ElseBranch);
- AssertEquals('Two case labels', 2, C.Elements.Count);
- AssertEquals('Correct case for case label 1', TPasImplCaseStatement,
- TPasElement(C.Elements[0]).ClassType);
- S := TPasImplCaseStatement(C.Elements[0]);
- AssertEquals('2 expressions for case 1', 1, S.Expressions.Count);
- AssertExpression('Case 1 With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
- AssertEquals('Empty case label statement 1', 0, S.Elements.Count);
- AssertNull('Empty case label statement 1', S.Body);
- // Two
- AssertEquals('Correct case for case label 2', TPasImplCaseStatement,
- TPasElement(C.Elements[1]).ClassType);
- S := TPasImplCaseStatement(C.Elements[1]);
- AssertEquals('2 expressions for case 2', 1, S.Expressions.Count);
- AssertExpression('Case 2 With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '2');
- AssertEquals('Empty case label statement 2', 0, S.Elements.Count);
- AssertNull('Empty case label statement 2', S.Body);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', '', 'begin', ' case a of',
- ' 1: ;', ' 2: ;', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCase.TestCaseBlock;
- var
- C: TPasImplCaseOf;
- S: TPasImplCaseStatement;
- B: TPasImplbeginBlock;
- begin
- DeclareVar('integer');
- TestStatement(['case a of', '1 : begin end;', 'end;']);
- C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
- AssertNotNull('Have case expression', C.CaseExpr);
- AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
- AssertNull('No else branch', C.ElseBranch);
- AssertEquals('Two case labels', 1, C.Elements.Count);
- AssertEquals('Correct case for case label 1', TPasImplCaseStatement,
- TPasElement(C.Elements[0]).ClassType);
- S := TPasImplCaseStatement(C.Elements[0]);
- AssertEquals('2 expressions for case 1', 1, S.Expressions.Count);
- AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
- AssertEquals('1 case label statement', 1, S.Elements.Count);
- AssertEquals('Correct case for case label 1', TPasImplbeginBlock,
- TPasElement(S.Elements[0]).ClassType);
- B := TPasImplbeginBlock(S.Elements[0]);
- AssertEquals('0 statements in block', 0, B.Elements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' A: Integer;', '', 'begin', ' case a of',
- ' 1: begin', ' end;', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCase.TestCaseElseBlockEmpty;
- var
- C: TPasImplCaseOf;
- S: TPasImplCaseStatement;
- B: TPasImplbeginBlock;
- begin
- DeclareVar('integer');
- TestStatement(['case a of', '1 : begin end;', 'else', ' end;']);
- C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
- AssertNotNull('Have case expression', C.CaseExpr);
- AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
- AssertEquals('Two case labels', 2, C.Elements.Count);
- AssertEquals('Correct case for case label 1', TPasImplCaseStatement,
- TPasElement(C.Elements[0]).ClassType);
- S := TPasImplCaseStatement(C.Elements[0]);
- AssertEquals('2 expressions for case 1', 1, S.Expressions.Count);
- AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
- AssertEquals('1 case label statement', 1, S.Elements.Count);
- AssertEquals('Correct case for case label 1', TPasImplbeginBlock,
- TPasElement(S.Elements[0]).ClassType);
- B := TPasImplbeginBlock(S.Elements[0]);
- AssertEquals('0 statements in block', 0, B.Elements.Count);
- AssertNotNull('Have else branch', C.ElseBranch);
- AssertEquals('Correct else branch class', TPasImplCaseElse, C.ElseBranch.ClassType);
- AssertEquals('Zero statements ', 0, TPasImplCaseElse(C.ElseBranch).Elements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '',
- 'var',
- ' A: Integer;',
- '',
- 'begin',
- ' case a of',
- ' 1: begin',
- ' end',
- ' else',
- ' end;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCase.TestCaseOtherwiseBlockEmpty;
- var
- C: TPasImplCaseOf;
- begin
- DeclareVar('integer');
- TestStatement(['case a of', '1 : begin end;', 'otherwise', ' end;']);
- C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
- AssertNotNull('Have case expression', C.CaseExpr);
- AssertNotNull('Have else branch', C.ElseBranch);
- AssertEquals('Correct else branch class', TPasImplCaseElse, C.ElseBranch.ClassType);
- AssertEquals('Zero statements ', 0, TPasImplCaseElse(C.ElseBranch).Elements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '',
- 'var',
- ' A: Integer;',
- '',
- 'begin',
- ' case a of',
- ' 1: begin',
- ' end',
- ' else',
- ' end;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCase.TestCaseElseBlockAssignment;
- var
- C: TPasImplCaseOf;
- S: TPasImplCaseStatement;
- B: TPasImplbeginBlock;
- begin
- DeclareVar('integer');
- TestStatement(['case a of', '1 : begin end;', 'else', 'a:=1', ' end;']);
- C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
- AssertNotNull('Have case expression', C.CaseExpr);
- AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
- AssertEquals('Two case labels', 2, C.Elements.Count);
- AssertEquals('Correct case for case label 1', TPasImplCaseStatement,
- TPasElement(C.Elements[0]).ClassType);
- S := TPasImplCaseStatement(C.Elements[0]);
- AssertEquals('2 expressions for case 1', 1, S.Expressions.Count);
- AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
- AssertEquals('1 case label statement', 1, S.Elements.Count);
- AssertEquals('Correct case for case label 1', TPasImplbeginBlock,
- TPasElement(S.Elements[0]).ClassType);
- B := TPasImplbeginBlock(S.Elements[0]);
- AssertEquals('0 statements in block', 0, B.Elements.Count);
- AssertNotNull('Have else branch', C.ElseBranch);
- AssertEquals('Correct else branch class', TPasImplCaseElse, C.ElseBranch.ClassType);
- AssertEquals('1 statement in else branch ', 1, TPasImplCaseElse(
- C.ElseBranch).Elements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '',
- 'var',
- ' A: Integer;',
- '',
- 'begin',
- ' case a of',
- ' 1: begin',
- ' end',
- ' else',
- ' a := 1;',
- ' end;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCase.TestCaseElseBlock2Assignments;
- var
- C: TPasImplCaseOf;
- S: TPasImplCaseStatement;
- B: TPasImplbeginBlock;
- begin
- DeclareVar('integer');
- TestStatement(['case a of', '1 : begin end;', 'else', 'a:=1;', 'a:=32;', ' end;']);
- C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
- AssertNotNull('Have case expression', C.CaseExpr);
- AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
- AssertEquals('Two case labels', 2, C.Elements.Count);
- AssertEquals('Correct case for case label 1', TPasImplCaseStatement,
- TPasElement(C.Elements[0]).ClassType);
- S := TPasImplCaseStatement(C.Elements[0]);
- AssertEquals('2 expressions for case 1', 1, S.Expressions.Count);
- AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
- AssertEquals('1 case label statement', 1, S.Elements.Count);
- AssertEquals('Correct case for case label 1', TPasImplbeginBlock,
- TPasElement(S.Elements[0]).ClassType);
- B := TPasImplbeginBlock(S.Elements[0]);
- AssertEquals('0 statements in block', 0, B.Elements.Count);
- AssertNotNull('Have else branch', C.ElseBranch);
- AssertEquals('Correct else branch class', TPasImplCaseElse, C.ElseBranch.ClassType);
- AssertEquals('2 statements in else branch ', 2, TPasImplCaseElse(
- C.ElseBranch).Elements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '',
- 'var',
- ' A: Integer;',
- '',
- 'begin',
- ' case a of',
- ' 1: begin',
- ' end',
- ' else',
- ' a := 1;',
- ' a := 32;',
- ' end;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCase.TestCaseIfCaseElse;
- var
- C: TPasImplCaseOf;
- begin
- DeclareVar('integer');
- DeclareVar('boolean', 'b');
- TestStatement(['case a of', '1 : if b then', ' begin end;', 'else', ' end;']);
- C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
- AssertNotNull('Have case expression', C.CaseExpr);
- AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
- AssertEquals('Two case labels', 2, C.Elements.Count);
- AssertNotNull('Have else branch', C.ElseBranch);
- AssertEquals('Correct else branch class', TPasImplCaseElse, C.ElseBranch.ClassType);
- AssertEquals('0 statement in else branch ', 0, TPasImplCaseElse(
- C.ElseBranch).Elements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '',
- 'var',
- ' A: Integer;',
- ' b: Boolean;',
- '',
- 'begin',
- ' case a of',
- ' 1: begin',
- ' if b then',
- ' end',
- ' else',
- ' end;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCase.TestCaseIfElse;
- var
- C: TPasImplCaseOf;
- S: TPasImplCaseStatement;
- begin
- DeclareVar('integer');
- DeclareVar('boolean', 'b');
- TestStatement(['case a of', '1 : if b then', ' begin end', 'else', 'begin', 'end', ' end;']);
- C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
- AssertNotNull('Have case expression', C.CaseExpr);
- AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
- AssertEquals('One case label', 1, C.Elements.Count);
- AssertNull('Have no else branch', C.ElseBranch);
- S := TPasImplCaseStatement(C.Elements[0]);
- AssertEquals('2 expressions for case 1', 1, S.Expressions.Count);
- AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
- AssertEquals('1 case label statement', 1, S.Elements.Count);
- AssertEquals('If statement in case label 1', TPasImplIfElse, TPasElement(
- S.Elements[0]).ClassType);
- AssertNotNull('If statement has else block', TPasImplIfElse(S.Elements[0]).ElseBranch);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '',
- 'var',
- ' A: Integer;',
- ' b: Boolean;',
- '',
- 'begin',
- ' case a of',
- ' 1: begin',
- ' if b then',
- ' begin',
- ' end else',
- ' begin',
- ' end;',
- ' end;',
- ' end;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCase.TestCaseIfCaseElseElse;
- var
- C: TPasImplCaseOf;
- S: TPasImplCaseStatement;
- begin
- DeclareVar('integer');
- DeclareVar('boolean', 'b');
- TestStatement(['case a of', '1 : if b then', ' begin end', 'else',
- 'else', 'DoElse', ' end;']);
- C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
- AssertNotNull('Have case expression', C.CaseExpr);
- AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
- AssertEquals('Two case labels', 2, C.Elements.Count);
- AssertNotNull('Have an else branch', C.ElseBranch);
- S := TPasImplCaseStatement(C.Elements[0]);
- AssertEquals('2 expressions for case 1', 1, S.Expressions.Count);
- AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
- AssertEquals('1 case label statement', 1, S.Elements.Count);
- AssertEquals('If statement in case label 1', TPasImplIfElse, TPasElement(
- S.Elements[0]).ClassType);
- AssertNotNull('If statement has else block', TPasImplIfElse(S.Elements[0]).ElseBranch);
- AssertEquals('If statement has a commend as else block', TPasImplCommand,
- TPasImplIfElse(S.Elements[0]).ElseBranch.ClassType);
- AssertEquals('But ... an empty command', '', TPasImplCommand(
- TPasImplIfElse(S.Elements[0]).ElseBranch).Command);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '',
- 'var',
- ' A: Integer;',
- ' b: Boolean;',
- '',
- 'begin',
- ' case a of',
- ' 1: begin',
- ' if b then',
- ' begin',
- ' end else',
- ' end',
- ' else',
- ' DoElse;',
- ' end;',
- 'end.','']), PasProgram);
- end;
- procedure TTestStatementWriterCase.TestCaseElseNoSemicolon;
- var
- C: TPasImplCaseOf;
- S: TPasImplCaseStatement;
- begin
- DeclareVar('integer');
- TestStatement(['case a of', '1 : dosomething;', '2 : dosomethingmore',
- 'else', 'a:=1;', 'end;']);
- C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
- AssertNotNull('Have case expression', C.CaseExpr);
- AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
- AssertEquals('case label count', 3, C.Elements.Count);
- S := TPasImplCaseStatement(C.Elements[0]);
- AssertEquals('case 1', 1, S.Expressions.Count);
- AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
- S := TPasImplCaseStatement(C.Elements[1]);
- AssertEquals('case 2', 1, S.Expressions.Count);
- AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '2');
- AssertEquals('third is else', TPasImplCaseElse, TObject(C.Elements[2]).ClassType);
- AssertNotNull('Have else branch', C.ElseBranch);
- AssertEquals('Correct else branch class', TPasImplCaseElse, C.ElseBranch.ClassType);
- AssertEquals('1 statements in else branch ', 1, TPasImplCaseElse(
- C.ElseBranch).Elements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '',
- 'var',
- ' A: Integer;',
- '',
- 'begin',
- ' case a of',
- ' 1: begin',
- ' dosomething;',
- ' end;',
- ' 2: begin',
- ' dosomethingmore;',
- ' end',
- ' else',
- ' a := 1;',
- ' end;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCase.TestCaseIfElseNoSemicolon;
- var
- C: TPasImplCaseOf;
- S: TPasImplCaseStatement;
- begin
- DeclareVar('integer');
- TestStatement(['case a of', '1 : dosomething;', '2: if b then',
- ' dosomething', 'else dosomethingmore', 'else', 'a:=1;', 'end;']);
- C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
- AssertNotNull('Have case expression', C.CaseExpr);
- AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
- AssertEquals('case label count', 3, C.Elements.Count);
- S := TPasImplCaseStatement(C.Elements[0]);
- AssertEquals('case 1', 1, S.Expressions.Count);
- AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
- S := TPasImplCaseStatement(C.Elements[1]);
- AssertEquals('case 2', 1, S.Expressions.Count);
- AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '2');
- AssertEquals('third is else', TPasImplCaseElse, TObject(C.Elements[2]).ClassType);
- AssertNotNull('Have else branch', C.ElseBranch);
- AssertEquals('Correct else branch class', TPasImplCaseElse, C.ElseBranch.ClassType);
- AssertEquals('1 statements in else branch ', 1, TPasImplCaseElse(
- C.ElseBranch).Elements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '',
- 'var',
- ' A: Integer;',
- '',
- 'begin',
- ' case a of',
- ' 1: begin',
- ' dosomething;',
- ' end;',
- ' 2: begin',
- ' if b then',
- ' begin',
- ' dosomething;',
- ' end else',
- ' dosomethingmore;',
- ' end',
- ' else',
- ' a := 1;',
- ' end;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterCase.TestCaseIfOtherwiseNoSemicolon;
- var
- C: TPasImplCaseOf;
- S: TPasImplCaseStatement;
- begin
- DeclareVar('integer');
- TestStatement(['case a of', '1 : dosomething;', '2: if b then',
- ' dosomething', 'else dosomethingmore', 'otherwise', 'a:=1;', 'end;']);
- C := AssertStatement('Case statement', TpasImplCaseOf) as TpasImplCaseOf;
- AssertNotNull('Have case expression', C.CaseExpr);
- AssertExpression('Case expression', C.CaseExpr, pekIdent, 'a');
- AssertEquals('case label count', 3, C.Elements.Count);
- S := TPasImplCaseStatement(C.Elements[0]);
- AssertEquals('case 1', 1, S.Expressions.Count);
- AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '1');
- S := TPasImplCaseStatement(C.Elements[1]);
- AssertEquals('case 2', 1, S.Expressions.Count);
- AssertExpression('Case With identifier 1', TPasExpr(S.Expressions[0]), pekNumber, '2');
- AssertEquals('third is else', TPasImplCaseElse, TObject(C.Elements[2]).ClassType);
- AssertNotNull('Have else branch', C.ElseBranch);
- AssertEquals('Correct else branch class', TPasImplCaseElse, C.ElseBranch.ClassType);
- AssertEquals('1 statements in else branch ', 1, TPasImplCaseElse(
- C.ElseBranch).Elements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '',
- 'var',
- ' A: Integer;',
- '',
- 'begin',
- ' case a of',
- ' 1: begin',
- ' dosomething;',
- ' end;',
- ' 2: begin',
- ' if b then',
- ' begin',
- ' dosomething;',
- ' end else',
- ' dosomethingmore;',
- ' end',
- ' else',
- ' a := 1;',
- ' end;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterRaise.TestRaise;
- var
- R: TPasImplRaise;
- begin
- DeclareVar('Exception');
- TestStatement('Raise A;');
- R := AssertStatement('Raise statement', TPasImplRaise) as TPasImplRaise;
- AssertEquals(0, R.Elements.Count);
- AssertNotNull(R.ExceptObject);
- AssertNull(R.ExceptAddr);
- AssertExpression('Expression object', R.ExceptObject, pekIdent, 'A');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '',
- 'var',
- ' A: Exception;',
- '',
- 'begin',
- ' raise A;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterRaise.TestRaiseEmpty;
- var
- R: TPasImplRaise;
- begin
- TestStatement('Raise;');
- R := AssertStatement('Raise statement', TPasImplRaise) as TPasImplRaise;
- AssertEquals(0, R.Elements.Count);
- AssertNull(R.ExceptObject);
- AssertNull(R.ExceptAddr);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '',
- '',
- 'begin',
- ' raise;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterRaise.TestRaiseAt;
- var
- R: TPasImplRaise;
- begin
- DeclareVar('Exception');
- DeclareVar('Pointer', 'B');
- TestStatement('Raise A at B;');
- R := AssertStatement('Raise statement', TPasImplRaise) as TPasImplRaise;
- AssertEquals(0, R.Elements.Count);
- AssertNotNull(R.ExceptObject);
- AssertNotNull(R.ExceptAddr);
- AssertExpression('Expression object', R.ExceptAddr, pekIdent, 'B');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '',
- 'var',
- ' A: Exception;',
- ' B: Pointer;',
- '',
- 'begin',
- ' raise A at B;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterTry.TestTryFinally;
- var
- T: TPasImplTry;
- S: TPasImplSimple;
- F: TPasImplTryFinally;
- begin
- TestStatement(['Try', ' DoSomething;', 'finally', ' DoSomethingElse', 'end']);
- T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
- AssertEquals(1, T.Elements.Count);
- AssertNotNull(T.FinallyExcept);
- AssertNull(T.ElseBranch);
- AssertNotNull(T.Elements[0]);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- S := TPasImplSimple(T.Elements[0]);
- AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething');
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- AssertEquals('Finally statement', TPasImplTryFinally, T.FinallyExcept.ClassType);
- F := TPasImplTryFinally(T.FinallyExcept);
- AssertEquals(1, F.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(F.Elements[0]).ClassType);
- S := TPasImplSimple(F.Elements[0]);
- AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' try', ' DoSomething;',
- ' finally', ' DoSomethingElse;', ' end;', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterTry.TestTryFinallyEmpty;
- var
- T: TPasImplTry;
- F: TPasImplTryFinally;
- begin
- TestStatement(['Try', 'finally', 'end;']);
- T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
- AssertEquals(0, T.Elements.Count);
- AssertNotNull(T.FinallyExcept);
- AssertNull(T.ElseBranch);
- AssertEquals('Finally statement', TPasImplTryFinally, T.FinallyExcept.ClassType);
- F := TPasImplTryFinally(T.FinallyExcept);
- AssertEquals(0, F.Elements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' try', ' finally', ' end;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterTry.TestTryFinallyNested;
- var
- T: TPasImplTry;
- S: TPasImplSimple;
- F: TPasImplTryFinally;
- begin
- TestStatement(['Try', ' DoSomething1;', ' Try', ' DoSomething2;',
- ' finally', ' DoSomethingElse2', ' end;', 'Finally', ' DoSomethingElse1', 'end']);
- T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
- AssertEquals(2, T.Elements.Count);
- AssertNotNull(T.FinallyExcept);
- AssertNull(T.ElseBranch);
- AssertNotNull(T.Elements[0]);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- S := TPasImplSimple(T.Elements[0]);
- AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething1');
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- AssertEquals('Finally statement', TPasImplTryFinally, T.FinallyExcept.ClassType);
- F := TPasImplTryFinally(T.FinallyExcept);
- AssertEquals(1, F.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(F.Elements[0]).ClassType);
- S := TPasImplSimple(F.Elements[0]);
- AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse1');
- // inner statement
- AssertNotNull(T.Elements[1]);
- AssertEquals('Nested try statement', TPasImplTry, TPasElement(T.Elements[1]).ClassType);
- T := TPasImplTry(T.Elements[1]);
- AssertEquals(1, T.Elements.Count);
- AssertNotNull(T.FinallyExcept);
- AssertNull(T.ElseBranch);
- AssertNotNull(T.Elements[0]);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- S := TPasImplSimple(T.Elements[0]);
- AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething2');
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- AssertEquals('Finally statement', TPasImplTryFinally, T.FinallyExcept.ClassType);
- F := TPasImplTryFinally(T.FinallyExcept);
- AssertEquals(1, F.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(F.Elements[0]).ClassType);
- S := TPasImplSimple(F.Elements[0]);
- AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse2');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' try', ' DoSomething1;',
- ' try', ' DoSomething2;', ' finally',
- ' DoSomethingElse2;', ' end;', ' finally',
- ' DoSomethingElse1;', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterTry.TestTryExcept;
- var
- T: TPasImplTry;
- S: TPasImplSimple;
- E: TPasImplTryExcept;
- begin
- TestStatement(['Try', ' DoSomething;', 'except', ' DoSomethingElse', 'end']);
- T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
- AssertEquals(1, T.Elements.Count);
- AssertNotNull(T.FinallyExcept);
- AssertNull(T.ElseBranch);
- AssertNotNull(T.Elements[0]);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- S := TPasImplSimple(T.Elements[0]);
- AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething');
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
- E := TPasImplTryExcept(T.FinallyExcept);
- AssertEquals(1, E.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(E.Elements[0]).ClassType);
- S := TPasImplSimple(E.Elements[0]);
- AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' try', ' DoSomething;',
- ' except', ' DoSomethingElse;', ' end;', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterTry.TestTryExceptNested;
- var
- T: TPasImplTry;
- S: TPasImplSimple;
- E: TPasImplTryExcept;
- begin
- TestStatement(['Try', ' DoSomething1;', ' try', ' DoSomething2;',
- ' except', ' DoSomethingElse2', ' end', 'except', ' DoSomethingElse1', 'end']);
- T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
- AssertEquals(2, T.Elements.Count);
- AssertNotNull(T.FinallyExcept);
- AssertNull(T.ElseBranch);
- AssertNotNull(T.Elements[0]);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- S := TPasImplSimple(T.Elements[0]);
- AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething1');
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
- E := TPasImplTryExcept(T.FinallyExcept);
- AssertEquals(1, E.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(E.Elements[0]).ClassType);
- S := TPasImplSimple(E.Elements[0]);
- AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse1');
- AssertNotNull(T.Elements[1]);
- AssertEquals('Simple statement', TPasImplTry, TPasElement(T.Elements[1]).ClassType);
- T := TPasImplTry(T.Elements[1]);
- AssertEquals(1, T.Elements.Count);
- AssertNotNull(T.FinallyExcept);
- AssertNull(T.ElseBranch);
- AssertNotNull(T.Elements[0]);
- AssertEquals('Simple statement 2', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- S := TPasImplSimple(T.Elements[0]);
- AssertExpression('DoSomething2 call ', S.Expr, pekIdent, 'DoSomething2');
- AssertEquals('Simple statement2', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- AssertEquals('Except statement2', TPasImplTryExcept, T.FinallyExcept.ClassType);
- E := TPasImplTryExcept(T.FinallyExcept);
- AssertEquals(1, E.Elements.Count);
- AssertEquals('Simple statement2', TPasImplSimple, TPasElement(E.Elements[0]).ClassType);
- S := TPasImplSimple(E.Elements[0]);
- AssertExpression('DoSomethingElse2 call', S.Expr, pekIdent, 'DoSomethingElse2');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' try', ' DoSomething1;',
- ' try', ' DoSomething2;', ' except',
- ' DoSomethingElse2;', ' end;', ' except',
- ' DoSomethingElse1;', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterTry.TestTryExceptEmpty;
- var
- T: TPasImplTry;
- E: TPasImplTryExcept;
- begin
- TestStatement(['Try', 'except', 'end;']);
- T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
- AssertEquals(0, T.Elements.Count);
- AssertNotNull(T.FinallyExcept);
- AssertNull(T.ElseBranch);
- AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
- E := TPasImplTryExcept(T.FinallyExcept);
- AssertEquals(0, E.Elements.Count);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' try', ' except', ' end;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterTry.TestTryExceptOn;
- var
- T: TPasImplTry;
- S: TPasImplSimple;
- E: TPasImplTryExcept;
- O: TPasImplExceptOn;
- begin
- TestStatement(['Try', ' DoSomething;', 'except', 'On E : Exception do',
- 'DoSomethingElse;', 'end']);
- T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
- AssertEquals(1, T.Elements.Count);
- AssertNotNull(T.FinallyExcept);
- AssertNull(T.ElseBranch);
- AssertNotNull(T.Elements[0]);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- S := TPasImplSimple(T.Elements[0]);
- AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething');
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
- E := TPasImplTryExcept(T.FinallyExcept);
- AssertEquals(1, E.Elements.Count);
- AssertEquals('Except on handler', TPasImplExceptOn, TPasElement(
- E.Elements[0]).ClassType);
- O := TPasImplExceptOn(E.Elements[0]);
- AssertEquals(1, O.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(O.Elements[0]).ClassType);
- AssertEquals('Exception Variable name', 'E', O.VariableName);
- AssertEquals('Exception Type name', 'Exception', O.TypeName);
- S := TPasImplSimple(O.Elements[0]);
- AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse');
- // AssertEquals('Variable name',
- AssertPasWriteOutput('output', BuildString(['program afile;', '',
- '', 'begin', ' try', ' DoSomething;', ' except',
- ' On E : Exception do', ' DoSomethingElse;', ' end;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterTry.TestTryExceptOn2;
- var
- T: TPasImplTry;
- S: TPasImplSimple;
- E: TPasImplTryExcept;
- O: TPasImplExceptOn;
- begin
- TestStatement(['Try', ' DoSomething;', 'except',
- 'On E : Exception do', 'DoSomethingElse;',
- 'On Y : Exception2 do', 'DoSomethingElse2;', 'end']);
- T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
- AssertEquals(1, T.Elements.Count);
- AssertNotNull(T.FinallyExcept);
- AssertNull(T.ElseBranch);
- AssertNotNull(T.Elements[0]);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- S := TPasImplSimple(T.Elements[0]);
- AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething');
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
- E := TPasImplTryExcept(T.FinallyExcept);
- AssertEquals(2, E.Elements.Count);
- // Exception handler 1
- AssertEquals('Except on handler', TPasImplExceptOn, TPasElement(
- E.Elements[0]).ClassType);
- O := TPasImplExceptOn(E.Elements[0]);
- AssertEquals(1, O.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(O.Elements[0]).ClassType);
- AssertEquals('Exception Variable name', 'E', O.VariableName);
- AssertEquals('Exception Type name', 'Exception', O.TypeName);
- S := TPasImplSimple(O.Elements[0]);
- AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse');
- // Exception handler 2
- AssertEquals('Except on handler', TPasImplExceptOn, TPasElement(
- E.Elements[1]).ClassType);
- O := TPasImplExceptOn(E.Elements[1]);
- AssertEquals(1, O.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(O.Elements[0]).ClassType);
- AssertEquals('Exception Variable name', 'Y', O.VariableName);
- AssertEquals('Exception Type name', 'Exception2', O.TypeName);
- S := TPasImplSimple(O.Elements[0]);
- AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse2');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' try', ' DoSomething;',
- ' except', ' On E : Exception do', ' DoSomethingElse;',
- ' On Y : Exception2 do', ' DoSomethingElse2;', ' end;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterTry.TestTryExceptOnElse;
- var
- T: TPasImplTry;
- S: TPasImplSimple;
- E: TPasImplTryExcept;
- O: TPasImplExceptOn;
- EE: TPasImplTryExceptElse;
- I: TPasImplIfElse;
- begin
- DeclareVar('Boolean', 'b');
- // Check that Else belongs to Except, not to IF
- TestStatement(['Try', ' DoSomething;', 'except', 'On E : Exception do',
- 'if b then', 'DoSomethingElse;', 'else', 'DoSomethingMore;', 'end']);
- T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
- AssertEquals(1, T.Elements.Count);
- AssertNotNull(T.FinallyExcept);
- AssertNotNull(T.ElseBranch);
- AssertNotNull(T.Elements[0]);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- S := TPasImplSimple(T.Elements[0]);
- AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething');
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
- E := TPasImplTryExcept(T.FinallyExcept);
- AssertEquals(1, E.Elements.Count);
- AssertEquals('Except on handler', TPasImplExceptOn, TPasElement(
- E.Elements[0]).ClassType);
- O := TPasImplExceptOn(E.Elements[0]);
- AssertEquals('Exception Variable name', 'E', O.VariableName);
- AssertEquals('Exception Type name', 'Exception', O.TypeName);
- AssertEquals(1, O.Elements.Count);
- AssertEquals('Simple statement', TPasImplIfElse, TPasElement(O.Elements[0]).ClassType);
- I := TPasImplIfElse(O.Elements[0]);
- AssertEquals(1, I.Elements.Count);
- AssertNull('No else barcnh for if', I.ElseBranch);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(I.Elements[0]).ClassType);
- S := TPasImplSimple(I.Elements[0]);
- AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse');
- AssertEquals('Except Else statement', TPasImplTryExceptElse, T.ElseBranch.ClassType);
- EE := TPasImplTryExceptElse(T.ElseBranch);
- AssertEquals(1, EE.Elements.Count);
- AssertNotNull(EE.Elements[0]);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(EE.Elements[0]).ClassType);
- S := TPasImplSimple(EE.Elements[0]);
- AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomethingMore');
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'var', ' b: Boolean;', '', 'begin',
- ' try', ' DoSomething;', ' except', ' On E : Exception do',
- ' if b then', ' DoSomethingElse;', ' else',
- ' DoSomethingMore;', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterTry.TestTryExceptOnIfElse;
- var
- T: TPasImplTry;
- S: TPasImplSimple;
- E: TPasImplTryExcept;
- O: TPasImplExceptOn;
- EE: TPasImplTryExceptElse;
- begin
- TestStatement(['Try', ' DoSomething;', 'except', 'On E : Exception do',
- 'DoSomethingElse;', 'else', 'DoSomethingMore;', 'end']);
- T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
- AssertEquals(1, T.Elements.Count);
- AssertNotNull(T.FinallyExcept);
- AssertNotNull(T.ElseBranch);
- AssertNotNull(T.Elements[0]);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- S := TPasImplSimple(T.Elements[0]);
- AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething');
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
- E := TPasImplTryExcept(T.FinallyExcept);
- AssertEquals(1, E.Elements.Count);
- AssertEquals('Except on handler', TPasImplExceptOn, TPasElement(
- E.Elements[0]).ClassType);
- O := TPasImplExceptOn(E.Elements[0]);
- AssertEquals('Exception Variable name', 'E', O.VariableName);
- AssertEquals('Exception Type name', 'Exception', O.TypeName);
- AssertEquals(1, O.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(O.Elements[0]).ClassType);
- S := TPasImplSimple(O.Elements[0]);
- AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse');
- AssertEquals('Except Else statement', TPasImplTryExceptElse, T.ElseBranch.ClassType);
- EE := TPasImplTryExceptElse(T.ElseBranch);
- AssertEquals(1, EE.Elements.Count);
- AssertNotNull(EE.Elements[0]);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(EE.Elements[0]).ClassType);
- S := TPasImplSimple(EE.Elements[0]);
- AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomethingMore');
- AssertPasWriteOutput('output', BuildString(
- ['program afile;', '', '', 'begin', ' try', ' DoSomething;',
- ' except', ' On E : Exception do', ' DoSomethingElse;', ' else',
- ' DoSomethingMore;', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterTry.TestTryExceptOnElseNoSemicolo;
- var
- T: TPasImplTry;
- S: TPasImplSimple;
- E: TPasImplTryExcept;
- O: TPasImplExceptOn;
- EE: TPasImplTryExceptElse;
- begin
- TestStatement(['Try', ' DoSomething;', 'except', 'On E : Exception do',
- 'DoSomethingElse', 'else', 'DoSomethingMore', 'end']);
- T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
- AssertEquals(1, T.Elements.Count);
- AssertNotNull(T.FinallyExcept);
- AssertNotNull(T.ElseBranch);
- AssertNotNull(T.Elements[0]);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- S := TPasImplSimple(T.Elements[0]);
- AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething');
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
- E := TPasImplTryExcept(T.FinallyExcept);
- AssertEquals(1, E.Elements.Count);
- AssertEquals('Except on handler', TPasImplExceptOn, TPasElement(
- E.Elements[0]).ClassType);
- O := TPasImplExceptOn(E.Elements[0]);
- AssertEquals('Exception Variable name', 'E', O.VariableName);
- AssertEquals('Exception Type name', 'Exception', O.TypeName);
- AssertEquals(1, O.Elements.Count);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(O.Elements[0]).ClassType);
- S := TPasImplSimple(O.Elements[0]);
- AssertExpression('DoSomethingElse call', S.Expr, pekIdent, 'DoSomethingElse');
- AssertEquals('Except Else statement', TPasImplTryExceptElse, T.ElseBranch.ClassType);
- EE := TPasImplTryExceptElse(T.ElseBranch);
- AssertEquals(1, EE.Elements.Count);
- AssertNotNull(EE.Elements[0]);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(EE.Elements[0]).ClassType);
- S := TPasImplSimple(EE.Elements[0]);
- AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomethingMore');
- AssertPasWriteOutput('output', BuildString(
- ['program afile;', '', '', 'begin', ' try', ' DoSomething;',
- ' except', ' On E : Exception do', ' DoSomethingElse;', ' else',
- ' DoSomethingMore;', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterTry.TestTryExceptRaise;
- var
- T: TPasImplTry;
- S: TPasImplSimple;
- E: TPasImplTryExcept;
- begin
- TestStatement(['Try', ' DoSomething;', 'except', ' raise', 'end']);
- T := AssertStatement('Try statement', TPasImplTry) as TPasImplTry;
- AssertEquals(1, T.Elements.Count);
- AssertNotNull(T.FinallyExcept);
- AssertNull(T.ElseBranch);
- AssertNotNull(T.Elements[0]);
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- S := TPasImplSimple(T.Elements[0]);
- AssertExpression('DoSomething call', S.Expr, pekIdent, 'DoSomething');
- AssertEquals('Simple statement', TPasImplSimple, TPasElement(T.Elements[0]).ClassType);
- AssertEquals('Except statement', TPasImplTryExcept, T.FinallyExcept.ClassType);
- E := TPasImplTryExcept(T.FinallyExcept);
- AssertEquals(1, E.Elements.Count);
- AssertEquals('Raise statement', TPasImplRaise, TPasElement(E.Elements[0]).ClassType);
- AssertPasWriteOutput('output', BuildString(
- ['program afile;', '', '', 'begin', ' try', ' DoSomething;',
- ' except', ' raise;', ' end;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterAsm.TestAsm;
- var
- T: TPasImplAsmStatement;
- begin
- TestStatement(['asm', ' mov eax,1', 'end;']);
- T := AssertStatement('Asm statement', TPasImplAsmStatement) as TPasImplAsmStatement;
- AssertEquals('Asm tokens', 4, T.Tokens.Count);
- AssertEquals('token 1 ', 'mov', T.Tokens[0]);
- AssertEquals('token 2 ', 'eax', T.Tokens[1]);
- AssertEquals('token 3 ', ',', T.Tokens[2]);
- AssertEquals('token 4 ', '1', T.Tokens[3]);
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterAsm.TestAsmBlock;
- begin
- Source.Add('{$MODE DELPHI}');
- Source.Add('function BitsHighest(X: Cardinal): Integer;');
- Source.Add('asm');
- Source.Add('end;');
- Source.Add('begin');
- Source.Add('end.');
- ParseModule;
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'function BitsHighest(X: Cardinal): Integer;', 'begin',
- 'end;', '', '', 'begin', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterAsm.TestAsmBlockWithEndLabel;
- begin
- Source.Add('{$MODE DELPHI}');
- Source.Add('function BitsHighest(X: Cardinal): Integer;');
- Source.Add('asm');
- Source.Add(' MOV ECX, EAX');
- Source.Add(' MOV EAX, -1');
- Source.Add(' BSR EAX, ECX');
- Source.Add(' JNZ @@End');
- Source.Add(' MOV EAX, -1');
- Source.Add('@@End:');
- Source.Add('end;');
- Source.Add('begin');
- Source.Add('end.');
- ParseModule;
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'function BitsHighest(X: Cardinal): Integer;', 'begin',
- 'end;', '', '', 'begin', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterAsm.TestAsmBlockInIfThen;
- begin
- Source.Add('{$MODE DELPHI}');
- Source.Add('function Get8087StatusWord(ClearExceptions: Boolean): Word;');
- Source.Add(' begin');
- Source.Add(' if ClearExceptions then');
- Source.Add(' asm');
- Source.Add(' end');
- Source.Add(' else');
- Source.Add(' asm');
- Source.Add(' end;');
- Source.Add(' end;');
- Source.Add(' begin');
- Source.Add(' end.');
- ParseModule;
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterSpecials.TestAssignToAddress;
- begin
- AddStatements(['@Proc:=Nil']);
- ParseModule;
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' @ Proc := Nil;', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterSpecials.TestFinalizationNoSemicolon;
- begin
- Source.Add('unit afile;');
- Source.Add('{$mode objfpc}');
- Source.Add('interface');
- Source.Add('implementation');
- Source.Add('initialization');
- Source.Add(' writeln(''qqq'')');
- Source.Add('finalization');
- Source.Add(' write(''rrr'')');
- ParseModule;
- AssertPasWriteOutput('output', BuildString(['unit afile;',
- '',
- 'interface',
- '',
- '',
- '',
- 'implementation',
- '',
- '',
- 'initialization',
- ' writeln(''qqq'');',
- 'finalization',
- ' write(''rrr'');',
- 'end.','']), Module);
- end;
- procedure TTestStatementWriterSpecials.TestMacroComment;
- begin
- AddStatements(['{$MACRO ON}', '{$DEFINE func := //}', ' calltest;',
- ' func (''1'',''2'',''3'');', 'CallTest2;']);
- ParseModule;
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' calltest;', ' CallTest2;',
- 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterSpecials.TestPlatformIdentifier;
- begin
- AddStatements(['write(platform);']);
- ParseModule;
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' write(platform);', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterSpecials.TestPlatformIdentifier2;
- begin
- AddStatements(['write(libs+platform);']);
- ParseModule;
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' write(libs + platform);', 'end.', '']),
- PasProgram);
- end;
- procedure TTestStatementWriterSpecials.TestArgumentNameOn;
- begin
- Source.Add('function TryOn(const on: boolean): boolean;');
- Source.Add(' begin');
- Source.Add(' end;');
- Source.Add(' begin');
- Source.Add(' end.');
- ParseModule;
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', 'function TryOn(const on: Boolean): Boolean;', 'begin',
- 'end;', '', '', 'begin', 'end.', '']), PasProgram);
- end;
- procedure TTestStatementWriterSpecials.TestGotoInIfThen;
- begin
- AddStatements(['{$goto on}', 'if expr then', ' dosomething',
- ' else if expr2 then', ' goto try_qword', ' else',
- ' dosomething;', ' try_qword:', ' dosomething;']);
- ParseModule;
- AssertPasWriteOutput('output', BuildString(['program afile;',
- '', '', 'begin', ' if expr then', ' dosomething',
- ' else if expr2 then', ' goto try_qword', ' else',
- ' dosomething;', ' try_qword:', ' dosomething;',
- 'end.', '']), PasProgram);
- end;
- initialization
- RegisterTests('TestPasSrcWriter',
- [TTestStatementWriterEmpty, TTestStatementWriterBlock, TTestStatementWriterAssignment,
- TTestStatementWriterCall, TTestStatementWriterIf, TTestStatementWriterCase,
- TTestStatementWriterWith, TTestStatementWriterLoops, TTestStatementWriterRaise,
- TTestStatementWriterTry, TTestStatementWriterAsm, TTestStatementWriterSpecials]);
- end.
|