123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007 |
- {
- Examples:
- ./testpassrc --suite=TTestStatementParser.TestCallQualified2
- }
- unit tcstatements;
- {$mode objfpc}{$H+}
- interface
- uses
- Classes, SysUtils, fpcunit, pastree, pscanner, pparser,
- tcbaseparser, testregistry;
- Type
- { TTestStatementParser }
- TTestStatementParser = Class(TTestParser)
- private
- FStatement: TPasImplBlock;
- FVariables : TStrings;
- procedure DoTestCallOtherFormat;
- procedure TestCallFormat(FN: String; AddPrecision: Boolean; AddSecondParam: boolean = false);
- Protected
- Procedure SetUp; override;
- Procedure TearDown; override;
- procedure AddStatements(ASource : Array of 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;
- Property Statement: TPasImplBlock Read FStatement;
- Published
- Procedure TestEmpty;
- Procedure TestEmptyStatement;
- Procedure TestEmptyStatements;
- Procedure TestBlock;
- Procedure TestBlockComment;
- Procedure TestBlock2Comments;
- Procedure TestAssignment;
- Procedure TestAssignmentAdd;
- Procedure TestAssignmentMinus;
- Procedure TestAssignmentMul;
- Procedure TestAssignmentDivision;
- Procedure TestAssignmentMissingSemicolonError;
- 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;
- procedure TestCallOtherFormat;
- Procedure TestIf;
- Procedure TestIfBlock;
- Procedure TestIfAssignment;
- Procedure TestIfElse;
- Procedure TestIfElseBlock;
- Procedure TestIfSemiColonElseError;
- procedure TestIfforElseBlock;
- procedure TestIfRaiseElseBlock;
- procedure TestIfGotoElseBlock;
- procedure TestIfWithBlock;
- Procedure TestNestedIf;
- Procedure TestNestedIfElse;
- Procedure TestNestedIfElseElse;
- procedure TestIfIfElseElseBlock;
- 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;
- Procedure TestWith;
- Procedure TestWithMultiple;
- 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;
- Procedure TestRaise;
- Procedure TestRaiseEmpty;
- Procedure TestRaiseAt;
- Procedure TestGoto;
- Procedure TestTryFinally;
- Procedure TestTryFinallyEmpty;
- Procedure TestTryFinallyNested;
- procedure TestTryExcept;
- procedure TestTryExceptNested;
- procedure TestTryExceptEmpty;
- Procedure TestTryExceptOn;
- Procedure TestTryExceptOn2;
- Procedure TestTryExceptOnElse;
- Procedure TestTryExceptOnIfElse;
- Procedure TestTryExceptOnElseNoSemicolo;
- procedure TestTryExceptRaise;
- Procedure TestAsm;
- Procedure TestAsmBlock;
- Procedure TestAsmBlockWithEndLabel;
- Procedure TestAsmBlockInIfThen;
- Procedure TestGotoInIfThen;
- procedure TestAssignToAddress;
- procedure TestFinalizationNoSemicolon;
- procedure TestMacroComment;
- Procedure TestPlatformIdentifier;
- Procedure TestPlatformIdentifier2;
- Procedure TestArgumentNameOn;
- end;
- implementation
- { TTestStatementParser }
- procedure TTestStatementParser.SetUp;
- begin
- inherited SetUp;
- FVariables:=TStringList.Create;
- end;
- procedure TTestStatementParser.TearDown;
- begin
- FreeAndNil(FVariables);
- inherited TearDown;
- end;
- procedure TTestStatementParser.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;
- procedure TTestStatementParser.DeclareVar(const AVarType: String;
- const AVarName: String);
- begin
- FVariables.Add(AVarName+' : '+AVarType+';');
- end;
- function TTestStatementParser.TestStatement(ASource: string): TPasImplElement;
- begin
- Result:=TestStatement([ASource]);
- end;
- function TTestStatementParser.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 TTestStatementParser.ExpectParserError(const Msg: string);
- begin
- AssertException(Msg,EParserError,@ParseModule);
- end;
- procedure TTestStatementParser.ExpectParserError(const Msg: string;
- ASource: array of string);
- begin
- AddStatements(ASource);
- ExpectParserError(Msg);
- end;
- function TTestStatementParser.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 TTestStatementParser.TestEmpty;
- begin
- //TestStatement(';');
- TestStatement('');
- AssertEquals('No statements',0,PasProgram.InitializationSection.Elements.Count);
- end;
- procedure TTestStatementParser.TestEmptyStatement;
- begin
- TestStatement(';');
- AssertEquals('0 statement',0,PasProgram.InitializationSection.Elements.Count);
- end;
- procedure TTestStatementParser.TestEmptyStatements;
- begin
- TestStatement(';;');
- AssertEquals('0 statement',0,PasProgram.InitializationSection.Elements.Count);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.TestAssignmentMissingSemicolonError;
- begin
- DeclareVar('integer');
- ExpectParserError('Semicolon expected, but "a" found',['a:=1','a:=2']);
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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));
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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 TTestStatementParser.TestCallWriteFormat1;
- begin
- TestCallFormat('write',False);
- end;
- procedure TTestStatementParser.TestCallWriteFormat2;
- begin
- TestCallFormat('write',True);
- end;
- procedure TTestStatementParser.TestCallWriteFormat3;
- begin
- TestCallFormat('write',false,true);
- end;
- procedure TTestStatementParser.TestCallWriteFormat4;
- begin
- TestCallFormat('write',true,true);
- end;
- procedure TTestStatementParser.TestCallWritelnFormat1;
- begin
- TestCallFormat('writeln',False);
- end;
- procedure TTestStatementParser.TestCallWritelnFormat2;
- begin
- TestCallFormat('writeln',True);
- end;
- procedure TTestStatementParser.TestCallStrFormat1;
- begin
- TestCallFormat('str',False);
- end;
- procedure TTestStatementParser.TestCallStrFormat2;
- begin
- TestCallFormat('str',True);
- end;
- procedure TTestStatementParser.DoTestCallOtherFormat;
- begin
- TestCallFormat('nono',False);
- end;
- procedure TTestStatementParser.TestCallOtherFormat;
- begin
- AssertException('Only Write(ln) and str allow format',EParserError,@DoTestCallOtherFormat);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.TestIfRaiseElseBlock;
- 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('Raise statement',TPasImplRaise,I.ifBranch.ClassType);
- AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
- end;
- procedure TTestStatementParser.TestIfGotoElseBlock;
- Var
- I : TPasImplIfElse;
- begin
- TestStatement(['if a then','goto bird','else', 'for X := 0 to 1 do Writeln(X)']);
- I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
- AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
- AssertEquals('Goto statement',TPasImplGoto,I.ifBranch.ClassType);
- AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
- end;
- procedure TTestStatementParser.TestIfWithBlock;
- 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('With statement',TPasImplWithDo,I.ifBranch.ClassType);
- AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
- end;
- procedure TTestStatementParser.TestIfSemiColonElseError;
- begin
- DeclareVar('boolean');
- ExpectParserError('No semicolon before else',['if a then',' begin',' end;','else',' begin',' end']);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.TestWith;
- 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);
- end;
- procedure TTestStatementParser.TestWithMultiple;
- 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);
- end;
- procedure TTestStatementParser.TestCaseEmpty;
- begin
- DeclareVar('integer');
- AddStatements(['case a of','end;']);
- ExpectParserError('Empty case not allowed');
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.TestGoto;
- Var
- R : TPasImplGoto;
- begin
- TestStatement('Goto A;');
- R:=AssertStatement('Goto statement',TPasImplGoto) as TPasImplGoto;
- AssertEquals(0,R.Elements.Count);
- AssertEquals('A',R.LabelName);
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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',
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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');
- end;
- procedure TTestStatementParser.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);
- end;
- procedure TTestStatementParser.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]);
- end;
- procedure TTestStatementParser.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;
- end;
- procedure TTestStatementParser.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;
- end;
- procedure TTestStatementParser.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;
- end;
- procedure TTestStatementParser.TestAssignToAddress;
- begin
- AddStatements(['@Proc:=Nil']);
- ParseModule;
- end;
- procedure TTestStatementParser.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;
- end;
- procedure TTestStatementParser.TestMacroComment;
- begin
- AddStatements(['{$MACRO ON}',
- '{$DEFINE func := //}',
- ' calltest;',
- ' func (''1'',''2'',''3'');',
- 'CallTest2;'
- ]);
- ParseModule;
- end;
- procedure TTestStatementParser.TestPlatformIdentifier;
- begin
- AddStatements(['write(platform);']);
- ParseModule;
- end;
- procedure TTestStatementParser.TestPlatformIdentifier2;
- begin
- AddStatements(['write(libs+platform);']);
- ParseModule;
- end;
- procedure TTestStatementParser.TestArgumentNameOn;
- begin
- Source.Add('function TryOn(const on: boolean): boolean;');
- Source.Add(' begin');
- Source.Add(' end;');
- Source.Add(' begin');
- Source.Add(' end.');
- ParseModule;
- end;
- procedure TTestStatementParser.TestGotoInIfThen;
- begin
- AddStatements([
- '{$goto on}',
- 'if expr then',
- ' dosomething',
- ' else if expr2 then',
- ' goto try_qword',
- ' else',
- ' dosomething;',
- ' try_qword:',
- ' dosomething;']);
- ParseModule;
- end;
- initialization
- RegisterTests([TTestStatementParser]);
- end.
|