123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000 |
- {
- This file is part of the Free Component Library (FCL)
- Copyright (c) 2008 Michael Van Canneyt.
-
- File which provides examples and all testcases for the expression parser.
- It needs fcl-fpcunit to work.
-
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit testexprpars;
- {$mode objfpc}{$H+}
- interface
- uses
- Classes, SysUtils, fpcunit, testutils, testregistry,fpexprpars;
- type
- { TTestExpressionScanner }
- TTestExpressionScanner = class(TTestCase)
- Private
- FP : TFPExpressionScanner;
- FInvalidString : String;
- procedure DoInvalidNumber(AString: String);
- procedure TestInvalidNumber;
- protected
- procedure SetUp; override;
- procedure TearDown; override;
- Procedure AssertEquals(Msg : string; AExpected, AActual : TTokenType); overload;
- Procedure TestString(Const AString : String; AToken : TTokenType);
- published
- procedure TestCreate;
- procedure TestSetSource;
- Procedure TestWhiteSpace;
- Procedure TestTokens;
- Procedure TestNumber;
- Procedure TestInvalidCharacter;
- Procedure TestUnterminatedString;
- Procedure TestQuotesInString;
- end;
- { TMyFPExpressionParser }
- TMyFPExpressionParser = Class(TFPExpressionParser)
- Public
- Procedure BuildHashList;
- Property ExprNode;
- Property Scanner;
- Property Dirty;
- end;
- { TTestBaseParser }
- TTestBaseParser = class(TTestCase)
- private
- procedure DoCheck;
- Protected
- FDestroyCalled : Integer;
- FCheckNode : TFPExprNode;
- procedure AssertNodeType(Msg: String; AClass: TClass; ANode: TFPExprNode); overload;
- procedure AssertEquals(Msg: String; AResultType : TResultType; ANode: TFPExprNode); overload;
- procedure AssertEquals(Msg: String; AExpected,AActual : TResultType); overload;
- Function CreateBoolNode(ABoolean: Boolean) : TFPExprNode;
- Function CreateIntNode(AInteger: Integer) : TFPExprNode;
- Function CreateFloatNode(AFloat : TExprFloat) : TFPExprNode;
- Function CreateStringNode(Astring : String) : TFPExprNode;
- Function CreateDateTimeNode(ADateTime : TDateTime) : TFPExprNode;
- Procedure AssertNodeOK(FN : TFPExprNode);
- Procedure AssertNodeNotOK(Const Msg : String; FN : TFPExprNode);
- Procedure Setup; override;
- end;
- { TMyDestroyNode }
- TMyDestroyNode = Class(TFPConstExpression)
- FTest : TTestBaseParser;
- Public
- Constructor CreateTest(ATest : TTestBaseParser);
- Destructor Destroy; override;
- end;
- { TTestDestroyNode }
- TTestDestroyNode = Class(TTestBaseParser)
- Published
- Procedure TestDestroy;
- end;
- { TTestConstExprNode }
- TTestConstExprNode = Class(TTestBaseParser)
- private
- FN : TFPConstExpression;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- procedure TestCreateFloat;
- procedure TestCreateBoolean;
- procedure TestCreateDateTime;
- procedure TestCreateString;
- end;
- { TTestNegateExprNode }
- TTestNegateExprNode = Class(TTestBaseParser)
- Private
- FN : TFPNegateOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- procedure TestCreateFloat;
- procedure TestCreateOther1;
- procedure TestCreateOther2;
- Procedure TestDestroy;
- end;
- { TTestBinaryAndNode }
- TTestBinaryAndNode = Class(TTestBaseParser)
- Private
- FN : TFPBinaryAndOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- procedure TestCreateBoolean;
- procedure TestCreateBooleanInteger;
- procedure TestCreateString;
- procedure TestCreateFloat;
- procedure TestCreateDateTime;
- Procedure TestDestroy;
- end;
- { TTestNotNode }
- TTestNotNode = Class(TTestBaseParser)
- Private
- FN : TFPNotNode;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- procedure TestCreateBoolean;
- procedure TestCreateString;
- procedure TestCreateFloat;
- procedure TestCreateDateTime;
- Procedure TestDestroy;
- end;
- { TTestBinaryOrNode }
- TTestBinaryOrNode = Class(TTestBaseParser)
- Private
- FN : TFPBinaryOrOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- procedure TestCreateBoolean;
- procedure TestCreateBooleanInteger;
- procedure TestCreateString;
- procedure TestCreateFloat;
- procedure TestCreateDateTime;
- Procedure TestDestroy;
- end;
- { TTestBinaryXOrNode }
- TTestBinaryXOrNode = Class(TTestBaseParser)
- Private
- FN : TFPBinaryXOrOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- procedure TestCreateBoolean;
- procedure TestCreateBooleanInteger;
- procedure TestCreateString;
- procedure TestCreateFloat;
- procedure TestCreateDateTime;
- Procedure TestDestroy;
- end;
- { TTestIfOperation }
- TTestIfOperation = Class(TTestBaseParser)
- Private
- FN : TIfOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- procedure TestCreateBoolean;
- procedure TestCreateBoolean2;
- procedure TestCreateString;
- procedure TestCreateFloat;
- procedure TestCreateDateTime;
- procedure TestCreateBooleanInteger;
- procedure TestCreateBooleanInteger2;
- procedure TestCreateBooleanString;
- procedure TestCreateBooleanString2;
- procedure TestCreateBooleanDateTime;
- procedure TestCreateBooleanDateTime2;
- Procedure TestDestroy;
- end;
- { TTestCaseOperation }
- TTestCaseOperation = Class(TTestBaseParser)
- Private
- FN : TCaseOperation;
- Protected
- Function CreateArgs(Args : Array of Const) : TExprArgumentArray;
- Procedure TearDown; override;
- Published
- Procedure TestCreateOne;
- procedure TestCreateTwo;
- procedure TestCreateThree;
- procedure TestCreateOdd;
- procedure TestCreateNoExpression;
- procedure TestCreateWrongLabel;
- procedure TestCreateWrongValue;
- procedure TestIntegerTag;
- procedure TestIntegerTagDefault;
- procedure TestStringTag;
- procedure TestStringTagDefault;
- procedure TestFloatTag;
- procedure TestFloatTagDefault;
- procedure TestBooleanTag;
- procedure TestBooleanTagDefault;
- procedure TestDateTimeTag;
- procedure TestDateTimeTagDefault;
- procedure TestIntegerValue;
- procedure TestIntegerValueDefault;
- procedure TestStringValue;
- procedure TestStringValueDefault;
- procedure TestFloatValue;
- procedure TestFloatValueDefault;
- procedure TestBooleanValue;
- procedure TestBooleanValueDefault;
- procedure TestDateTimeValue;
- procedure TestDateTimeValueDefault;
- Procedure TestDestroy;
- end;
- { TTestBooleanNode }
- TTestBooleanNode = Class(TTestBaseParser)
- Protected
- Procedure TestNode(B : TFPBooleanResultOperation; AResult : Boolean);
- end;
- { TTestEqualNode }
- TTestEqualNode = Class(TTestBooleanNode)
- Private
- FN : TFPBooleanResultOperation;
- Protected
- Procedure TearDown; override;
- Class Function NodeClass : TFPBooleanResultOperationClass; virtual;
- Class Function ExpectedResult : Boolean; virtual;
- Class Function OperatorString : String; virtual;
- Published
- Procedure TestCreateIntegerEqual;
- procedure TestCreateIntegerUnEqual;
- Procedure TestCreateFloatEqual;
- procedure TestCreateFloatUnEqual;
- Procedure TestCreateStringEqual;
- procedure TestCreateStringUnEqual;
- Procedure TestCreateBooleanEqual;
- procedure TestCreateBooleanUnEqual;
- Procedure TestCreateDateTimeEqual;
- procedure TestCreateDateTimeUnEqual;
- Procedure TestDestroy;
- Procedure TestWrongTypes1;
- procedure TestWrongTypes2;
- procedure TestWrongTypes3;
- procedure TestWrongTypes4;
- procedure TestWrongTypes5;
- Procedure TestAsString;
- end;
- { TTestUnEqualNode }
- TTestUnEqualNode = Class(TTestEqualNode)
- Protected
- Class Function NodeClass : TFPBooleanResultOperationClass; override;
- Class Function ExpectedResult : Boolean; override;
- Class Function OperatorString : String; override;
- end;
- { TTestLessThanNode }
- TTestLessThanNode = Class(TTestBooleanNode)
- Private
- FN : TFPBooleanResultOperation;
- Protected
- Class Function NodeClass : TFPBooleanResultOperationClass; virtual;
- Class Function Larger : Boolean; virtual;
- Class Function AllowEqual : Boolean; virtual;
- Class Function OperatorString : String; virtual;
- Procedure TearDown; override;
- Published
- Procedure TestCreateIntegerEqual;
- procedure TestCreateIntegerSmaller;
- procedure TestCreateIntegerLarger;
- Procedure TestCreateFloatEqual;
- procedure TestCreateFloatSmaller;
- procedure TestCreateFloatLarger;
- Procedure TestCreateDateTimeEqual;
- procedure TestCreateDateTimeSmaller;
- procedure TestCreateDateTimeLarger;
- Procedure TestCreateStringEqual;
- procedure TestCreateStringSmaller;
- procedure TestCreateStringLarger;
- Procedure TestWrongTypes1;
- procedure TestWrongTypes2;
- procedure TestWrongTypes3;
- procedure TestWrongTypes4;
- procedure TestWrongTypes5;
- Procedure TestNoBoolean1;
- Procedure TestNoBoolean2;
- Procedure TestNoBoolean3;
- Procedure TestAsString;
- end;
- { TTestLessThanEqualNode }
- TTestLessThanEqualNode = Class(TTestLessThanNode)
- protected
- Class Function NodeClass : TFPBooleanResultOperationClass; override;
- Class Function AllowEqual : Boolean; override;
- Class Function OperatorString : String; override;
- end;
- { TTestLargerThanNode }
- TTestLargerThanNode = Class(TTestLessThanNode)
- protected
- Class Function NodeClass : TFPBooleanResultOperationClass; override;
- Class Function Larger : Boolean; override;
- Class Function OperatorString : String; override;
- end;
- { TTestLargerThanEqualNode }
- TTestLargerThanEqualNode = Class(TTestLargerThanNode)
- protected
- Class Function NodeClass : TFPBooleanResultOperationClass; override;
- Class Function AllowEqual : Boolean; override;
- Class Function OperatorString : String; override;
- end;
- { TTestAddNode }
- TTestAddNode = Class(TTestBaseParser)
- Private
- FN : TFPAddOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- Procedure TestCreateFloat;
- Procedure TestCreateDateTime;
- Procedure TestCreateString;
- Procedure TestCreateBoolean;
- Procedure TestDestroy;
- Procedure TestAsString;
- end;
- { TTestSubtractNode }
- TTestSubtractNode = Class(TTestBaseParser)
- Private
- FN : TFPSubtractOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- Procedure TestCreateFloat;
- Procedure TestCreateDateTime;
- Procedure TestCreateString;
- Procedure TestCreateBoolean;
- Procedure TestDestroy;
- Procedure TestAsString;
- end;
- { TTestMultiplyNode }
- TTestMultiplyNode = Class(TTestBaseParser)
- Private
- FN : TFPMultiplyOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- Procedure TestCreateFloat;
- Procedure TestCreateDateTime;
- Procedure TestCreateString;
- Procedure TestCreateBoolean;
- Procedure TestDestroy;
- Procedure TestAsString;
- end;
- { TTestDivideNode }
- TTestDivideNode = Class(TTestBaseParser)
- Private
- FN : TFPDivideOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- Procedure TestCreateFloat;
- Procedure TestCreateDateTime;
- Procedure TestCreateString;
- Procedure TestCreateBoolean;
- Procedure TestDestroy;
- Procedure TestAsString;
- end;
- { TTestIntToFloatNode }
- TTestIntToFloatNode = Class(TTestBaseParser)
- Private
- FN : TIntToFloatNode;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- Procedure TestCreateFloat;
- Procedure TestDestroy;
- Procedure TestAsString;
- end;
- { TTestIntToDateTimeNode }
- TTestIntToDateTimeNode = Class(TTestBaseParser)
- Private
- FN : TIntToDateTimeNode;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- Procedure TestCreateFloat;
- Procedure TestDestroy;
- Procedure TestAsString;
- end;
- { TTestFloatToDateTimeNode }
- TTestFloatToDateTimeNode = Class(TTestBaseParser)
- Private
- FN : TFloatToDateTimeNode;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- Procedure TestCreateFloat;
- Procedure TestDestroy;
- Procedure TestAsString;
- end;
- { TTestExpressionParser }
- TTestExpressionParser = class(TTestBaseParser)
- Private
- FP : TMyFPExpressionParser;
- FTestExpr : String;
- procedure DoAddInteger(var Result: TFPExpressionResult;
- const Args: TExprParameterArray);
- procedure DoDeleteString(var Result: TFPExpressionResult;
- const Args: TExprParameterArray);
- procedure DoEchoBoolean(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- procedure DoEchoDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- procedure DoEchoFloat(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- procedure DoEchoInteger(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- procedure DoEchoString(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- procedure DoGetDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- procedure DoParse;
- procedure TestParser(AExpr: string);
- protected
- procedure SetUp; override;
- procedure TearDown; override;
- Procedure AssertLeftRight(N : TFPExprNode; LeftClass,RightClass : TClass);
- Procedure AssertOperand(N : TFPExprNode; OperandClass : TClass);
- Procedure AssertResultType(RT : TResultType);
- Procedure AssertResult(F : TExprFloat);
- Procedure AssertResult(I : Int64);
- Procedure AssertResult(S : String);
- Procedure AssertResult(B : Boolean);
- Procedure AssertDateTimeResult(D : TDateTime);
- end;
- { TTestParserExpressions }
- TTestParserExpressions = Class(TTestExpressionParser)
- private
- Published
- Procedure TestCreate;
- Procedure TestSimpleNodeFloat;
- procedure TestSimpleNodeInteger;
- procedure TestSimpleNodeBooleanTrue;
- procedure TestSimpleNodeBooleanFalse;
- procedure TestSimpleNodeString;
- procedure TestSimpleNegativeInteger;
- procedure TestSimpleNegativeFloat;
- procedure TestSimpleAddInteger;
- procedure TestSimpleAddFloat;
- procedure TestSimpleAddIntegerFloat;
- procedure TestSimpleAddFloatInteger;
- procedure TestSimpleAddString;
- procedure TestSimpleSubtractInteger;
- procedure TestSimpleSubtractFloat;
- procedure TestSimpleSubtractIntegerFloat;
- procedure TestSimpleSubtractFloatInteger;
- procedure TestSimpleMultiplyFloat;
- procedure TestSimpleMultiplyInteger;
- procedure TestSimpleDivideFloat;
- procedure TestSimpleDivideInteger;
- procedure TestSimpleBooleanAnd;
- procedure TestSimpleIntegerAnd;
- procedure TestSimpleBooleanOr;
- procedure TestSimpleIntegerOr;
- procedure TestSimpleBooleanNot;
- procedure TestSimpleIntegerNot;
- procedure TestSimpleAddSeries;
- procedure TestSimpleMultiplySeries;
- procedure TestSimpleAddMultiplySeries;
- procedure TestSimpleAddAndSeries;
- procedure TestSimpleAddOrSeries;
- procedure TestSimpleOrNotSeries;
- procedure TestSimpleAndNotSeries;
- procedure TestDoubleAddMultiplySeries;
- procedure TestDoubleSubtractMultiplySeries;
- procedure TestSimpleIfInteger;
- procedure TestSimpleIfString;
- procedure TestSimpleIfFloat;
- procedure TestSimpleIfBoolean;
- procedure TestSimpleIfDateTime;
- procedure TestSimpleIfOperation;
- procedure TestSimpleBrackets;
- procedure TestSimpleBrackets2;
- procedure TestSimpleBracketsLeft;
- procedure TestSimpleBracketsRight;
- procedure TestSimpleBracketsDouble;
- end;
- TTestParserBooleanOperations = Class(TTestExpressionParser)
- Published
- Procedure TestEqualInteger;
- procedure TestUnEqualInteger;
- procedure TestEqualFloat;
- procedure TestEqualFloat2;
- procedure TestUnEqualFloat;
- procedure TestEqualString;
- procedure TestEqualString2;
- procedure TestUnEqualString;
- procedure TestUnEqualString2;
- Procedure TestEqualBoolean;
- procedure TestUnEqualBoolean;
- procedure TestLessThanInteger;
- procedure TestLessThanInteger2;
- procedure TestLessThanEqualInteger;
- procedure TestLessThanEqualInteger2;
- procedure TestLessThanFloat;
- procedure TestLessThanFloat2;
- procedure TestLessThanEqualFloat;
- procedure TestLessThanEqualFloat2;
- procedure TestLessThanString;
- procedure TestLessThanString2;
- procedure TestLessThanEqualString;
- procedure TestLessThanEqualString2;
- procedure TestGreaterThanInteger;
- procedure TestGreaterThanInteger2;
- procedure TestGreaterThanEqualInteger;
- procedure TestGreaterThanEqualInteger2;
- procedure TestGreaterThanFloat;
- procedure TestGreaterThanFloat2;
- procedure TestGreaterThanEqualFloat;
- procedure TestGreaterThanEqualFloat2;
- procedure TestGreaterThanString;
- procedure TestGreaterThanString2;
- procedure TestGreaterThanEqualString;
- procedure TestGreaterThanEqualString2;
- procedure EqualAndSeries;
- procedure EqualAndSeries2;
- procedure EqualOrSeries;
- procedure EqualOrSeries2;
- procedure UnEqualAndSeries;
- procedure UnEqualAndSeries2;
- procedure UnEqualOrSeries;
- procedure UnEqualOrSeries2;
- procedure LessThanAndSeries;
- procedure LessThanAndSeries2;
- procedure LessThanOrSeries;
- procedure LessThanOrSeries2;
- procedure GreaterThanAndSeries;
- procedure GreaterThanAndSeries2;
- procedure GreaterThanOrSeries;
- procedure GreaterThanOrSeries2;
- procedure LessThanEqualAndSeries;
- procedure LessThanEqualAndSeries2;
- procedure LessThanEqualOrSeries;
- procedure LessThanEqualOrSeries2;
- procedure GreaterThanEqualAndSeries;
- procedure GreaterThanEqualAndSeries2;
- procedure GreaterThanEqualOrSeries;
- procedure GreaterThanEqualOrSeries2;
- end;
- { TTestParserOperands }
- TTestParserOperands = Class(TTestExpressionParser)
- private
- Published
- Procedure MissingOperand1;
- procedure MissingOperand2;
- procedure MissingOperand3;
- procedure MissingOperand4;
- procedure MissingOperand5;
- procedure MissingOperand6;
- procedure MissingOperand7;
- procedure MissingOperand8;
- procedure MissingOperand9;
- procedure MissingOperand10;
- procedure MissingOperand11;
- procedure MissingOperand12;
- procedure MissingOperand13;
- procedure MissingOperand14;
- procedure MissingOperand15;
- procedure MissingOperand16;
- procedure MissingOperand17;
- procedure MissingOperand18;
- procedure MissingOperand19;
- procedure MissingOperand20;
- procedure MissingOperand21;
- procedure MissingBracket1;
- procedure MissingBracket2;
- procedure MissingBracket3;
- procedure MissingBracket4;
- procedure MissingBracket5;
- procedure MissingBracket6;
- procedure MissingBracket7;
- procedure MissingArgument1;
- procedure MissingArgument2;
- procedure MissingArgument3;
- procedure MissingArgument4;
- procedure MissingArgument5;
- procedure MissingArgument6;
- procedure MissingArgument7;
- end;
- { TTestParserTypeMatch }
- TTestParserTypeMatch = Class(TTestExpressionParser)
- Private
- Procedure AccessString;
- Procedure AccessInteger;
- Procedure AccessFloat;
- Procedure AccessDateTime;
- Procedure AccessBoolean;
- Published
- Procedure TestTypeMismatch1;
- procedure TestTypeMismatch2;
- procedure TestTypeMismatch3;
- procedure TestTypeMismatch4;
- procedure TestTypeMismatch5;
- procedure TestTypeMismatch6;
- procedure TestTypeMismatch7;
- procedure TestTypeMismatch8;
- procedure TestTypeMismatch9;
- procedure TestTypeMismatch10;
- procedure TestTypeMismatch11;
- procedure TestTypeMismatch12;
- procedure TestTypeMismatch13;
- procedure TestTypeMismatch14;
- procedure TestTypeMismatch15;
- procedure TestTypeMismatch16;
- procedure TestTypeMismatch17;
- procedure TestTypeMismatch18;
- procedure TestTypeMismatch19;
- procedure TestTypeMismatch20;
- procedure TestTypeMismatch21;
- procedure TestTypeMismatch22;
- procedure TestTypeMismatch23;
- procedure TestTypeMismatch24;
- end;
- { TTestParserVariables }
- TTestParserVariables = Class(TTestExpressionParser)
- private
- FAsWrongType : TResultType;
- procedure TestAccess(Skip: TResultType);
- Protected
- procedure AddVariabletwice;
- procedure UnknownVariable;
- Procedure ReadWrongType;
- procedure WriteWrongType;
- Procedure DoDummy(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- Published
- Procedure TestVariableAssign;
- Procedure TestVariableAssignAgain;
- Procedure TestVariable1;
- procedure TestVariable2;
- procedure TestVariable3;
- procedure TestVariable4;
- procedure TestVariable5;
- procedure TestVariable6;
- procedure TestVariable7;
- procedure TestVariable8;
- procedure TestVariable9;
- procedure TestVariable10;
- procedure TestVariable11;
- procedure TestVariable12;
- procedure TestVariable13;
- procedure TestVariable14;
- procedure TestVariable15;
- procedure TestVariable16;
- procedure TestVariable17;
- procedure TestVariable18;
- procedure TestVariable19;
- procedure TestVariable20;
- procedure TestVariable21;
- procedure TestVariable22;
- procedure TestVariable23;
- procedure TestVariable24;
- procedure TestVariable25;
- procedure TestVariable26;
- procedure TestVariable27;
- procedure TestVariable28;
- procedure TestVariable29;
- procedure TestVariable30;
- end;
- { TTestParserFunctions }
- TTestParserFunctions = Class(TTestExpressionParser)
- private
- FAccessAs : TResultType;
- Procedure TryRead;
- procedure TryWrite;
- Published
- Procedure TestFunction1;
- procedure TestFunction2;
- procedure TestFunction3;
- procedure TestFunction4;
- procedure TestFunction5;
- procedure TestFunction6;
- procedure TestFunction7;
- procedure TestFunction8;
- procedure TestFunction9;
- procedure TestFunction10;
- procedure TestFunction11;
- procedure TestFunction12;
- procedure TestFunction13;
- procedure TestFunction14;
- procedure TestFunction15;
- procedure TestFunction16;
- procedure TestFunction17;
- procedure TestFunction18;
- procedure TestFunction19;
- procedure TestFunction20;
- procedure TestFunction21;
- procedure TestFunction22;
- procedure TestFunction23;
- procedure TestFunction24;
- procedure TestFunction25;
- procedure TestFunction26;
- procedure TestFunction27;
- procedure TestFunction28;
- procedure TestFunction29;
- end;
- { TTestBuiltinsManager }
- TTestBuiltinsManager = Class(TTestExpressionParser)
- private
- FM : TExprBuiltInManager;
- Protected
- procedure Setup; override;
- procedure Teardown; override;
- Published
- procedure TestCreate;
- procedure TestVariable1;
- procedure TestVariable2;
- procedure TestVariable3;
- procedure TestVariable4;
- procedure TestVariable5;
- procedure TestVariable6;
- procedure TestFunction1;
- procedure TestFunction2;
- end;
- TTestBuiltins = Class(TTestExpressionParser)
- private
- FM : TExprBuiltInManager;
- FExpr : String;
- Protected
- procedure Setup; override;
- procedure Teardown; override;
- Procedure SetExpression(Const AExpression : String);
- Procedure AssertVariable(Const ADefinition : String; AResultType : TResultType);
- Procedure AssertFunction(Const ADefinition,AResultType,ArgumentTypes : String; ACategory : TBuiltinCategory);
- procedure AssertExpression(Const AExpression : String; AResult : Int64);
- procedure AssertExpression(Const AExpression : String; Const AResult : String);
- procedure AssertExpression(Const AExpression : String; Const AResult : TExprFloat);
- procedure AssertExpression(Const AExpression : String; Const AResult : Boolean);
- procedure AssertDateTimeExpression(Const AExpression : String; Const AResult : TDateTime);
- Published
- procedure TestRegister;
- Procedure TestVariablepi;
- Procedure TestFunctioncos;
- Procedure TestFunctionsin;
- Procedure TestFunctionarctan;
- Procedure TestFunctionabs;
- Procedure TestFunctionsqr;
- Procedure TestFunctionsqrt;
- Procedure TestFunctionexp;
- Procedure TestFunctionln;
- Procedure TestFunctionlog;
- Procedure TestFunctionfrac;
- Procedure TestFunctionint;
- Procedure TestFunctionround;
- Procedure TestFunctiontrunc;
- Procedure TestFunctionlength;
- Procedure TestFunctioncopy;
- Procedure TestFunctiondelete;
- Procedure TestFunctionpos;
- Procedure TestFunctionlowercase;
- Procedure TestFunctionuppercase;
- Procedure TestFunctionstringreplace;
- Procedure TestFunctioncomparetext;
- Procedure TestFunctiondate;
- Procedure TestFunctiontime;
- Procedure TestFunctionnow;
- Procedure TestFunctiondayofweek;
- Procedure TestFunctionextractyear;
- Procedure TestFunctionextractmonth;
- Procedure TestFunctionextractday;
- Procedure TestFunctionextracthour;
- Procedure TestFunctionextractmin;
- Procedure TestFunctionextractsec;
- Procedure TestFunctionextractmsec;
- Procedure TestFunctionencodedate;
- Procedure TestFunctionencodetime;
- Procedure TestFunctionencodedatetime;
- Procedure TestFunctionshortdayname;
- Procedure TestFunctionshortmonthname;
- Procedure TestFunctionlongdayname;
- Procedure TestFunctionlongmonthname;
- Procedure TestFunctionformatdatetime;
- Procedure TestFunctionshl;
- Procedure TestFunctionshr;
- Procedure TestFunctionIFS;
- Procedure TestFunctionIFF;
- Procedure TestFunctionIFD;
- Procedure TestFunctionIFI;
- Procedure TestFunctioninttostr;
- Procedure TestFunctionstrtoint;
- Procedure TestFunctionstrtointdef;
- Procedure TestFunctionfloattostr;
- Procedure TestFunctionstrtofloat;
- Procedure TestFunctionstrtofloatdef;
- Procedure TestFunctionbooltostr;
- Procedure TestFunctionstrtobool;
- Procedure TestFunctionstrtobooldef;
- Procedure TestFunctiondatetostr;
- Procedure TestFunctiontimetostr;
- Procedure TestFunctionstrtodate;
- Procedure TestFunctionstrtodatedef;
- Procedure TestFunctionstrtotime;
- Procedure TestFunctionstrtotimedef;
- Procedure TestFunctionstrtodatetime;
- Procedure TestFunctionstrtodatetimedef;
- end;
- implementation
- uses typinfo;
- procedure TTestExpressionScanner.TestCreate;
- begin
- AssertEquals('Empty source','',FP.Source);
- AssertEquals('Pos is zero',0,FP.Pos);
- AssertEquals('CurrentChar is zero',#0,FP.CurrentChar);
- AssertEquals('Current token type is EOF',ttEOF,FP.TokenType);
- AssertEquals('Current token is empty','',FP.Token);
- end;
- procedure TTestExpressionScanner.TestSetSource;
- begin
- FP.Source:='Abc';
- FP.Source:='';
- AssertEquals('Empty source','',FP.Source);
- AssertEquals('Pos is zero',0,FP.Pos);
- AssertEquals('CurrentChar is zero',#0,FP.CurrentChar);
- AssertEquals('Current token type is EOF',ttEOF,FP.TokenType);
- AssertEquals('Current token is empty','',FP.Token);
- end;
- procedure TTestExpressionScanner.TestWhiteSpace;
- begin
- TestString(' ',ttEOF);
- end;
- procedure TTestExpressionScanner.TestTokens;
- Const
- TestStrings : Array[TTokenType] of String
- = ('+','-','<','>','=','/',
- '*','(',')','<=','>=',
- '<>','1','''abc''','abc',',','and',
- 'or','xor','true','false','not','if','case','');
- var
- t : TTokenType;
- begin
- For T:=Low(TTokenType) to High(TTokenType) do
- TestString(TestStrings[t],t);
- end;
- procedure TTestExpressionScanner.TestInvalidNumber;
- begin
- TestString(FInvalidString,ttNumber);
- end;
- procedure TTestExpressionScanner.DoInvalidNumber(AString : String);
- begin
- FInvalidString:=AString;
- AssertException('Invalid number "'+AString+'"',EExprScanner,@TestInvalidNumber);
- end;
- procedure TTestExpressionScanner.TestNumber;
- begin
- TestString('123',ttNumber);
- TestString('123.4',ttNumber);
- TestString('123.E4',ttNumber);
- TestString('1.E4',ttNumber);
- TestString('1e-2',ttNumber);
- DoInvalidNumber('1..1');
- DoInvalidNumber('1.E--1');
- DoInvalidNumber('.E-1');
- end;
- procedure TTestExpressionScanner.TestInvalidCharacter;
- begin
- DoInvalidNumber('~');
- DoInvalidNumber('^');
- DoInvalidNumber('#');
- DoInvalidNumber('$');
- DoInvalidNumber('^');
- end;
- procedure TTestExpressionScanner.TestUnterminatedString;
- begin
- DoInvalidNumber('''abc');
- end;
- procedure TTestExpressionScanner.TestQuotesInString;
- begin
- TestString('''That''''s it''',ttString);
- TestString('''''''s it''',ttString);
- TestString('''s it''''''',ttString);
- end;
- procedure TTestExpressionScanner.SetUp;
- begin
- FP:=TFPExpressionScanner.Create;
- end;
- procedure TTestExpressionScanner.TearDown;
- begin
- FreeAndNil(FP);
- end;
- procedure TTestExpressionScanner.AssertEquals(Msg: string; AExpected,
- AActual: TTokenType);
- Var
- S1,S2 : String;
- begin
- S1:=TokenName(AExpected);
- S2:=GetEnumName(TypeInfo(TTokenType),Ord(AActual));
- AssertEquals(Msg,S1,S2);
- end;
- procedure TTestExpressionScanner.TestString(const AString: String;
- AToken: TTokenType);
- begin
- FP.Source:=AString;
- AssertEquals('String "'+AString+'" results in token '+TokenName(AToken),AToken,FP.GetToken);
- If Not (FP.TokenType in [ttString,ttEOF]) then
- AssertEquals('String "'+AString+'" results in token string '+TokenName(AToken),AString,FP.Token)
- else if FP.TokenType=ttString then
- AssertEquals('String "'+AString+'" results in token string '+TokenName(AToken),
- StringReplace(AString,'''''','''',[rfreplaceAll]),
- ''''+FP.Token+'''');
- end;
- { TTestBaseParser }
- procedure TTestBaseParser.DoCheck;
- begin
- FCheckNode.Check;
- end;
- procedure TTestBaseParser.AssertNodeType(Msg: String; AClass: TClass;
- ANode: TFPExprNode);
- begin
- AssertNotNull(Msg+': Not null',ANode);
- AssertEquals(Msg+': Class OK',AClass,ANode.ClassType);
- end;
- procedure TTestBaseParser.AssertEquals(Msg: String; AResultType: TResultType;
- ANode: TFPExprNode);
- begin
- AssertNotNull(Msg+': Node not null',ANode);
- AssertEquals(Msg,AResultType,Anode.NodeType);
- end;
- procedure TTestBaseParser.AssertEquals(Msg: String; AExpected,
- AActual: TResultType);
- begin
- AssertEquals(Msg,ResultTypeName(AExpected),ResultTypeName(AActual));
- end;
- function TTestBaseParser.CreateIntNode(AInteger: Integer): TFPExprNode;
- begin
- Result:=TFPConstExpression.CreateInteger(AInteger);
- end;
- function TTestBaseParser.CreateFloatNode(AFloat: TExprFloat): TFPExprNode;
- begin
- Result:=TFPConstExpression.CreateFloat(AFloat);
- end;
- function TTestBaseParser.CreateStringNode(Astring: String): TFPExprNode;
- begin
- Result:=TFPConstExpression.CreateString(AString);
- end;
- function TTestBaseParser.CreateDateTimeNode(ADateTime: TDateTime): TFPExprNode;
- begin
- Result:=TFPConstExpression.CreateDateTime(ADateTime);
- end;
- procedure TTestBaseParser.AssertNodeOK(FN: TFPExprNode);
- Var
- B : Boolean;
- Msg : String;
- begin
- AssertNotNull('Node to test OK',FN);
- B:=False;
- try
- FN.Check;
- B:=True;
- except
- On E : Exception do
- Msg:=E.Message;
- end;
- If Not B then
- Fail(Format('Node %s not OK: %s',[FN.ClassName,Msg]));
- end;
- procedure TTestBaseParser.AssertNodeNotOK(const MSg : String; FN: TFPExprNode);
- begin
- FCheckNode:=FN;
- AssertException(Msg,EExprParser,@DoCheck);
- end;
- function TTestBaseParser.CreateBoolNode(ABoolean: Boolean): TFPExprNode;
- begin
- Result:=TFPConstExpression.CreateBoolean(ABoolean);
- end;
- procedure TTestBaseParser.Setup;
- begin
- inherited Setup;
- FDestroyCalled:=0;
- end;
- { TTestConstExprNode }
- procedure TTestConstExprNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestConstExprNode.TestCreateInteger;
- begin
- FN:=TFPConstExpression.CreateInteger(1);
- AssertEquals('Correct type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',1,FN.ConstValue.ResInteger);
- AssertEquals('Correct result',1,FN.NodeValue.ResInteger);
- AssertEquals('AsString ok','1',FN.AsString);
- end;
- procedure TTestConstExprNode.TestCreateFloat;
- Var
- S : String;
- begin
- FN:=TFPConstExpression.CreateFloat(2.34);
- AssertEquals('Correct type',rtFloat,FN.NodeType);
- AssertEquals('Correct result',2.34,FN.ConstValue.ResFloat);
- AssertEquals('Correct result',2.34,FN.NodeValue.ResFloat);
- Str(TExprFLoat(2.34),S);
- AssertEquals('AsString ok',S,FN.AsString);
- end;
- procedure TTestConstExprNode.TestCreateBoolean;
- begin
- FN:=TFPConstExpression.CreateBoolean(True);
- AssertEquals('Correct type',rtBoolean,FN.NodeType);
- AssertEquals('Correct result',True,FN.ConstValue.ResBoolean);
- AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
- AssertEquals('AsString ok','True',FN.AsString);
- FreeAndNil(FN);
- FN:=TFPConstExpression.CreateBoolean(False);
- AssertEquals('AsString ok','False',FN.AsString);
- end;
- procedure TTestConstExprNode.TestCreateDateTime;
- Var
- D : TDateTime;
- S : String;
- begin
- D:=Now;
- FN:=TFPConstExpression.CreateDateTime(D);
- AssertEquals('Correct type',rtDateTime,FN.NodeType);
- AssertEquals('Correct result',D,FN.ConstValue.ResDateTime);
- AssertEquals('Correct result',D,FN.NodeValue.ResDateTime);
- S:=''''+FormatDateTime('cccc',D)+'''';
- AssertEquals('AsString ok',S,FN.AsString);
- end;
- procedure TTestConstExprNode.TestCreateString;
- Var
- S : String;
- begin
- S:='Ohlala';
- FN:=TFPConstExpression.CreateString(S);
- AssertEquals('Correct type',rtString,FN.NodeType);
- AssertEquals('Correct result',S,FN.ConstValue.ResString);
- AssertEquals('Correct result',S,FN.NodeValue.ResString);
- AssertEquals('AsString ok',''''+S+'''',FN.AsString);
- end;
- { TTestNegateExprNode }
- procedure TTestNegateExprNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestNegateExprNode.TestCreateInteger;
- begin
- FN:=TFPNegateOperation.Create(CreateIntNode(23));
- AssertEquals('Negate has correct type',rtInteger,FN.NodeType);
- AssertEquals('Negate has correct result',-23,FN.NodeValue.Resinteger);
- AssertEquals('Negate has correct string','-23',FN.AsString);
- AssertNodeOK(FN);
- end;
- procedure TTestNegateExprNode.TestCreateFloat;
- Var
- S : String;
- begin
- FN:=TFPNegateOperation.Create(CreateFloatNode(1.23));
- AssertEquals('Negate has correct type',rtFloat,FN.NodeType);
- AssertEquals('Negate has correct result',-1.23,FN.NodeValue.ResFloat);
- Str(TExprFloat(-1.23),S);
- AssertEquals('Negate has correct string',S,FN.AsString);
- AssertNodeOK(FN);
- end;
- procedure TTestNegateExprNode.TestCreateOther1;
- begin
- FN:=TFPNegateOperation.Create(TFPConstExpression.CreateString('1.23'));
- AssertNodeNotOK('Negate does not accept string',FN);
- end;
- procedure TTestNegateExprNode.TestCreateOther2;
- begin
- FN:=TFPNegateOperation.Create(TFPConstExpression.CreateBoolean(True));
- AssertNodeNotOK('Negate does not accept boolean',FN)
- end;
- procedure TTestNegateExprNode.TestDestroy;
- begin
- FN:=TFPNegateOperation.Create(TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Operand Destroy called',1,self.FDestroyCalled)
- end;
- { TTestDestroyNode }
- procedure TTestDestroyNode.TestDestroy;
- Var
- FN : TMyDestroyNode;
- begin
- AssertEquals('Destroy not called yet',0,self.FDestroyCalled);
- FN:=TMyDestroyNode.CreateTest(Self);
- FN.Free;
- AssertEquals('Destroy called',1,self.FDestroyCalled)
- end;
- { TMyDestroyNode }
- constructor TMyDestroyNode.CreateTest(ATest: TTestBaseParser);
- begin
- FTest:=ATest;
- Inherited CreateInteger(1);
- end;
- destructor TMyDestroyNode.Destroy;
- begin
- Inc(FTest.FDestroyCalled);
- inherited Destroy;
- end;
- { TTestBinaryAndNode }
- procedure TTestBinaryAndNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestBinaryAndNode.TestCreateInteger;
- begin
- FN:=TFPBinaryAndOperation.Create(CreateIntNode(3),CreateIntNode(2));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',2,FN.NodeValue.ResInteger);
- end;
- procedure TTestBinaryAndNode.TestCreateBoolean;
- begin
- FN:=TFPBinaryAndOperation.Create(CreateBoolNode(True),CreateBoolNode(True));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtBoolean,FN.NodeType);
- AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
- end;
- procedure TTestBinaryAndNode.TestCreateBooleanInteger;
- begin
- FN:=TFPBinaryAndOperation.Create(CreateBoolNode(True),CreateIntNode(0));
- AssertNodeNotOK('Different node types',FN);
- end;
- procedure TTestBinaryAndNode.TestCreateString;
- begin
- FN:=TFPBinaryAndOperation.Create(CreateStringNode('True'),CreateStringNode('True'));
- AssertNodeNotOK('String node type',FN);
- end;
- procedure TTestBinaryAndNode.TestCreateFloat;
- begin
- FN:=TFPBinaryAndOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
- AssertNodeNotOK('float node type',FN);
- end;
- procedure TTestBinaryAndNode.TestCreateDateTime;
- begin
- FN:=TFPBinaryAndOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now));
- AssertNodeNotOK('DateTime node type',FN);
- end;
- procedure TTestBinaryAndNode.TestDestroy;
- begin
- FN:=TFPBinaryAndOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- { TTestBinaryOrNode }
- procedure TTestBinaryOrNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestBinaryOrNode.TestCreateInteger;
- begin
- FN:=TFPBinaryOrOperation.Create(CreateIntNode(1),CreateIntNode(2));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
- end;
- procedure TTestBinaryOrNode.TestCreateBoolean;
- begin
- FN:=TFPBinaryOrOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtBoolean,FN.NodeType);
- AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
- end;
- procedure TTestBinaryOrNode.TestCreateBooleanInteger;
- begin
- FN:=TFPBinaryOrOperation.Create(CreateBoolNode(True),CreateIntNode(0));
- AssertNodeNotOK('Different node types',FN);
- end;
- procedure TTestBinaryOrNode.TestCreateString;
- begin
- FN:=TFPBinaryOrOperation.Create(CreateStringNode('True'),CreateStringNode('True'));
- AssertNodeNotOK('String node type',FN);
- end;
- procedure TTestBinaryOrNode.TestCreateFloat;
- begin
- FN:=TFPBinaryOrOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
- AssertNodeNotOK('float node type',FN);
- end;
- procedure TTestBinaryOrNode.TestCreateDateTime;
- begin
- FN:=TFPBinaryOrOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now));
- AssertNodeNotOK('DateTime node type',FN);
- end;
- procedure TTestBinaryOrNode.TestDestroy;
- begin
- FN:=TFPBinaryOrOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- { TTestBinaryXorNode }
- procedure TTestBinaryXorNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestBinaryXorNode.TestCreateInteger;
- begin
- FN:=TFPBinaryXorOperation.Create(CreateIntNode(1),CreateIntNode(2));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
- end;
- procedure TTestBinaryXorNode.TestCreateBoolean;
- begin
- FN:=TFPBinaryXorOperation.Create(CreateBoolNode(True),CreateBoolNode(True));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtBoolean,FN.NodeType);
- AssertEquals('Correct result',False,FN.NodeValue.ResBoolean);
- end;
- procedure TTestBinaryXorNode.TestCreateBooleanInteger;
- begin
- FN:=TFPBinaryXorOperation.Create(CreateBoolNode(True),CreateIntNode(0));
- AssertNodeNotOK('Different node types',FN);
- end;
- procedure TTestBinaryXorNode.TestCreateString;
- begin
- FN:=TFPBinaryXorOperation.Create(CreateStringNode('True'),CreateStringNode('True'));
- AssertNodeNotOK('String node type',FN);
- end;
- procedure TTestBinaryXorNode.TestCreateFloat;
- begin
- FN:=TFPBinaryXorOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
- AssertNodeNotOK('float node type',FN);
- end;
- procedure TTestBinaryXorNode.TestCreateDateTime;
- begin
- FN:=TFPBinaryXorOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now));
- AssertNodeNotOK('DateTime node type',FN);
- end;
- procedure TTestBinaryXorNode.TestDestroy;
- begin
- FN:=TFPBinaryXorOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- { TTestBooleanNode }
- procedure TTestBooleanNode.TestNode(B: TFPBooleanResultOperation;
- AResult: Boolean);
- begin
- AssertEquals(Format('Test %s(%s,%s) result',[B.ClassName,B.Left.AsString,B.Right.AsString]),Aresult,B.NodeValue.resBoolean);
- end;
- { TTestEqualNode }
- procedure TTestEqualNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- class function TTestEqualNode.NodeClass: TFPBooleanResultOperationClass;
- begin
- Result:=TFPEqualOperation;
- end;
- class function TTestEqualNode.ExpectedResult: Boolean;
- begin
- Result:=True
- end;
- class function TTestEqualNode.OperatorString: String;
- begin
- Result:='=';
- end;
- procedure TTestEqualNode.TestCreateIntegerEqual;
- begin
- FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(1));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateIntegerUnEqual;
- begin
- FN:=NodeClass.Create(CreateIntNode(2),CreateIntNode(1));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateFloatEqual;
- begin
- FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateFloatUnEqual;
- begin
- FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.34));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateStringEqual;
- begin
- FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('now'));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateStringUnEqual;
- begin
- FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('then'));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateBooleanEqual;
- begin
- FN:=NodeClass.Create(CreateBoolNode(True),CreateBoolNode(True));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateBooleanUnEqual;
- begin
- FN:=NodeClass.Create(CreateBoolNode(False),CreateBoolNode(True));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateDateTimeEqual;
- Var
- D : TDateTime;
- begin
- D:=Now;
- FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateDateTimeUnEqual;
- Var
- D : TDateTime;
- begin
- D:=Now;
- FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not ExpectedResult);
- end;
- procedure TTestEqualNode.TestDestroy;
- begin
- FN:=NodeClass.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- procedure TTestEqualNode.TestWrongTypes1;
- begin
- FN:=NodeClass.Create(CreateIntNode(3),CreateStringNode('1.23'));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestEqualNode.TestWrongTypes2;
- begin
- FN:=NodeClass.Create(CreateDateTimeNode(3),CreateStringNode('1.23'));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestEqualNode.TestWrongTypes3;
- begin
- FN:=NodeClass.Create(CreateFloatNode(1.3),CreateStringNode('1.23'));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestEqualNode.TestWrongTypes4;
- begin
- FN:=NodeClass.Create(CreateBoolNode(False),CreateStringNode('1.23'));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestEqualNode.TestWrongTypes5;
- begin
- FN:=NodeClass.Create(CreateFloatNode(1),CreateIntNode(1));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestEqualNode.TestAsString;
- begin
- FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2));
- AssertEquals('Asstring works ok','1 '+OPeratorString+' 2',FN.AsString);
- end;
- { TTestUnEqualNode }
- class function TTestUnEqualNode.NodeClass: TFPBooleanResultOperationClass;
- begin
- Result:=TFPUnEqualOperation;
- end;
- class function TTestUnEqualNode.ExpectedResult: Boolean;
- begin
- Result:=False;
- end;
- class function TTestUnEqualNode.OperatorString: String;
- begin
- Result:='<>';
- end;
- { TTestLessThanNode }
- class function TTestLessThanNode.NodeClass: TFPBooleanResultOperationClass;
- begin
- Result:=TFPLessThanOperation;
- end;
- class function TTestLessThanNode.Larger: Boolean;
- begin
- Result:=False;
- end;
- class function TTestLessThanNode.AllowEqual: Boolean;
- begin
- Result:=False;
- end;
- class function TTestLessThanNode.OperatorString: String;
- begin
- Result:='<';
- end;
- procedure TTestLessThanNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestLessThanNode.TestCreateIntegerEqual;
- begin
- FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(1));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,AllowEqual);
- end;
- procedure TTestLessThanNode.TestCreateIntegerSmaller;
- begin
- FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not Larger);
- end;
- procedure TTestLessThanNode.TestCreateIntegerLarger;
- begin
- FN:=NodeClass.Create(CreateIntNode(2),CreateIntNode(1));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Larger);
- end;
- procedure TTestLessThanNode.TestCreateFloatEqual;
- begin
- FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,AllowEqual);
- end;
- procedure TTestLessThanNode.TestCreateFloatSmaller;
- begin
- FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(4.56));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not Larger);
- end;
- procedure TTestLessThanNode.TestCreateFloatLarger;
- begin
- FN:=NodeClass.Create(CreateFloatNode(4.56),CreateFloatNode(1.23));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Larger);
- end;
- procedure TTestLessThanNode.TestCreateDateTimeEqual;
- Var
- D : TDateTime;
- begin
- D:=Now;
- FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,AllowEqual);
- end;
- procedure TTestLessThanNode.TestCreateDateTimeSmaller;
- Var
- D : TDateTime;
- begin
- D:=Now;
- FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D+1));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not larger);
- end;
- procedure TTestLessThanNode.TestCreateDateTimeLarger;
- Var
- D : TDateTime;
- begin
- D:=Now;
- FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,larger);
- end;
- procedure TTestLessThanNode.TestCreateStringEqual;
- begin
- FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('now'));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,AllowEqual);
- end;
- procedure TTestLessThanNode.TestCreateStringSmaller;
- begin
- FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('then'));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not Larger);
- end;
- procedure TTestLessThanNode.TestCreateStringLarger;
- begin
- FN:=NodeClass.Create(CreateStringNode('then'),CreateStringNode('now'));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Larger);
- end;
- procedure TTestLessThanNode.TestWrongTypes1;
- begin
- FN:=NodeClass.Create(CreateIntNode(3),CreateStringNode('1.23'));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestLessThanNode.TestWrongTypes2;
- begin
- FN:=NodeClass.Create(CreateDateTimeNode(3),CreateStringNode('1.23'));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestLessThanNode.TestWrongTypes3;
- begin
- FN:=NodeClass.Create(CreateFloatNode(1.3),CreateStringNode('1.23'));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestLessThanNode.TestWrongTypes4;
- begin
- FN:=NodeClass.Create(CreateBoolNode(False),CreateStringNode('1.23'));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestLessThanNode.TestWrongTypes5;
- begin
- FN:=NodeClass.Create(CreateFloatNode(1.23),CreateIntNode(1));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestLessThanNode.TestNoBoolean1;
- begin
- FN:=NodeClass.Create(CreateBoolNode(False),CreateIntNode(1));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestLessThanNode.TestNoBoolean2;
- begin
- FN:=NodeClass.Create(CreateIntNode(1),CreateBoolNode(False));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestLessThanNode.TestNoBoolean3;
- begin
- FN:=NodeClass.Create(CreateBoolNode(False),CreateBoolNode(False));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestLessThanNode.TestAsString;
- begin
- FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2));
- AssertEquals('Asstring works ok','1 '+OPeratorString+' 2',FN.AsString);
- end;
- { TTestLessThanEqualNode }
- class function TTestLessThanEqualNode.NodeClass: TFPBooleanResultOperationClass;
- begin
- Result:=TFPLessThanEqualOperation;
- end;
- class function TTestLessThanEqualNode.AllowEqual: Boolean;
- begin
- Result:=True;
- end;
- class function TTestLessThanEqualNode.OperatorString: String;
- begin
- Result:='<=';
- end;
- { TTestLargerThanNode }
- class function TTestLargerThanNode.NodeClass: TFPBooleanResultOperationClass;
- begin
- Result:=TFPGreaterThanOperation;
- end;
- class function TTestLargerThanNode.Larger: Boolean;
- begin
- Result:=True;
- end;
- class function TTestLargerThanNode.OperatorString: String;
- begin
- Result:='>';
- end;
- { TTestLargerThanEqualNode }
- class function TTestLargerThanEqualNode.NodeClass: TFPBooleanResultOperationClass;
- begin
- Result:=TFPGreaterThanEqualOperation;
- end;
- class function TTestLargerThanEqualNode.AllowEqual: Boolean;
- begin
- Result:=True;
- end;
- class function TTestLargerThanEqualNode.OperatorString: String;
- begin
- Result:='>=';
- end;
- { TTestAddNode }
- procedure TTestAddNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestAddNode.TestCreateInteger;
- begin
- FN:=TFPAddOperation.Create(CreateIntNode(1),CreateIntNode(2));
- AssertEquals('Add has correct type',rtInteger,FN.NodeType);
- AssertEquals('Add has correct result',3,FN.NodeValue.ResInteger);
- end;
- procedure TTestAddNode.TestCreateFloat;
- begin
- FN:=TFPAddOperation.Create(CreateFloatNode(1.23),CreateFloatNode(4.56));
- AssertEquals('Add has correct type',rtFloat,FN.NodeType);
- AssertEquals('Add has correct result',5.79,FN.NodeValue.ResFloat);
- end;
- procedure TTestAddNode.TestCreateDateTime;
- Var
- D,T : TDateTime;
- begin
- D:=Date;
- T:=Time;
- FN:=TFPAddOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(T));
- AssertEquals('Add has correct type',rtDateTime,FN.NodeType);
- AssertEquals('Add has correct result',D+T,FN.NodeValue.ResDateTime);
- end;
- procedure TTestAddNode.TestCreateString;
- begin
- FN:=TFPAddOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
- AssertEquals('Add has correct type',rtString,FN.NodeType);
- AssertEquals('Add has correct result','aloha',FN.NodeValue.ResString);
- end;
- procedure TTestAddNode.TestCreateBoolean;
- begin
- FN:=TFPAddOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
- AssertNodeNotOK('No boolean addition',FN);
- end;
- procedure TTestAddNode.TestDestroy;
- begin
- FN:=TFPAddOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- procedure TTestAddNode.TestAsString;
- begin
- FN:=TFPAddOperation.Create(CreateIntNode(1),CreateIntNode(2));
- AssertEquals('Asstring works ok','1 + 2',FN.AsString);
- end;
- { TTestSubtractNode }
- procedure TTestSubtractNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestSubtractNode.TestCreateInteger;
- begin
- FN:=TFPSubtractOperation.Create(CreateIntNode(4),CreateIntNode(1));
- AssertEquals('Subtract has correct type',rtInteger,FN.NodeType);
- AssertEquals('Subtract has correct result',3,FN.NodeValue.ResInteger);
- end;
- procedure TTestSubtractNode.TestCreateFloat;
- begin
- FN:=TFPSubtractOperation.Create(CreateFloatNode(4.56),CreateFloatNode(1.23));
- AssertEquals('Subtract has correct type',rtFloat,FN.NodeType);
- AssertEquals('Subtract has correct result',3.33,FN.NodeValue.ResFloat);
- end;
- procedure TTestSubtractNode.TestCreateDateTime;
- Var
- D,T : TDateTime;
- begin
- D:=Date;
- T:=Time;
- FN:=TFPSubtractOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
- AssertEquals('Subtract has correct type',rtDateTime,FN.NodeType);
- AssertEquals('Subtract has correct result',D,FN.NodeValue.ResDateTime);
- end;
- procedure TTestSubtractNode.TestCreateString;
- begin
- FN:=TFPSubtractOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
- AssertNodeNotOK('No string Subtract',FN);
- end;
- procedure TTestSubtractNode.TestCreateBoolean;
- begin
- FN:=TFPSubtractOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
- AssertNodeNotOK('No boolean Subtract',FN);
- end;
- procedure TTestSubtractNode.TestDestroy;
- begin
- FN:=TFPSubtractOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- procedure TTestSubtractNode.TestAsString;
- begin
- FN:=TFPSubtractOperation.Create(CreateIntNode(1),CreateIntNode(2));
- AssertEquals('Asstring works ok','1 - 2',FN.AsString);
- end;
- { TTestMultiplyNode }
- procedure TTestMultiplyNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestMultiplyNode.TestCreateInteger;
- begin
- FN:=TFPMultiplyOperation.Create(CreateIntNode(4),CreateIntNode(2));
- AssertEquals('multiply has correct type',rtInteger,FN.NodeType);
- AssertEquals('multiply has correct result',8,FN.NodeValue.ResInteger);
- end;
- procedure TTestMultiplyNode.TestCreateFloat;
- begin
- FN:=TFPMultiplyOperation.Create(CreateFloatNode(2.0),CreateFloatNode(1.23));
- AssertEquals('multiply has correct type',rtFloat,FN.NodeType);
- AssertEquals('multiply has correct result',2.46,FN.NodeValue.ResFloat);
- end;
- procedure TTestMultiplyNode.TestCreateDateTime;
- Var
- D,T : TDateTime;
- begin
- D:=Date;
- T:=Time;
- FN:=TFPMultiplyOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
- AssertNodeNotOK('No datetime multiply',FN);
- end;
- procedure TTestMultiplyNode.TestCreateString;
- begin
- FN:=TFPMultiplyOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
- AssertNodeNotOK('No string multiply',FN);
- end;
- procedure TTestMultiplyNode.TestCreateBoolean;
- begin
- FN:=TFPMultiplyOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
- AssertNodeNotOK('No boolean multiply',FN);
- end;
- procedure TTestMultiplyNode.TestDestroy;
- begin
- FN:=TFPMultiplyOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- procedure TTestMultiplyNode.TestAsString;
- begin
- FN:=TFPMultiplyOperation.Create(CreateIntNode(1),CreateIntNode(2));
- AssertEquals('Asstring works ok','1 * 2',FN.AsString);
- end;
- { TTestDivideNode }
- procedure TTestDivideNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestDivideNode.TestCreateInteger;
- begin
- FN:=TFPDivideOperation.Create(CreateIntNode(4),CreateIntNode(2));
- AssertEquals('Divide has correct type',rtfloat,FN.NodeType);
- AssertEquals('Divide has correct result',2.0,FN.NodeValue.ResFloat);
- end;
- procedure TTestDivideNode.TestCreateFloat;
- begin
- FN:=TFPDivideOperation.Create(CreateFloatNode(9.0),CreateFloatNode(3.0));
- AssertEquals('Divide has correct type',rtFloat,FN.NodeType);
- AssertEquals('Divide has correct result',3.0,FN.NodeValue.ResFloat);
- end;
- procedure TTestDivideNode.TestCreateDateTime;
- Var
- D,T : TDateTime;
- begin
- D:=Date;
- T:=Time;
- FN:=TFPDivideOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
- AssertNodeNotOK('No datetime division',FN);
- end;
- procedure TTestDivideNode.TestCreateString;
- begin
- FN:=TFPDivideOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
- AssertNodeNotOK('No string division',FN);
- end;
- procedure TTestDivideNode.TestCreateBoolean;
- begin
- FN:=TFPDivideOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
- AssertNodeNotOK('No boolean division',FN);
- end;
- procedure TTestDivideNode.TestDestroy;
- begin
- FN:=TFPDivideOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- procedure TTestDivideNode.TestAsString;
- begin
- FN:=TFPDivideOperation.Create(CreateIntNode(1),CreateIntNode(2));
- AssertEquals('Asstring works ok','1 / 2',FN.AsString);
- end;
- { TTestIntToFloatNode }
- procedure TTestIntToFloatNode.TearDown;
- begin
- FreeAndNil(Fn);
- inherited TearDown;
- end;
- procedure TTestIntToFloatNode.TestCreateInteger;
- begin
- FN:=TIntToFloatNode.Create(CreateIntNode(4));
- AssertEquals('Convert has correct type',rtfloat,FN.NodeType);
- AssertEquals('Convert has correct result',4.0,FN.NodeValue.ResFloat);
- end;
- procedure TTestIntToFloatNode.TestCreateFloat;
- begin
- FN:=TIntToFloatNode.Create(CreateFloatNode(4.0));
- AssertNodeNotOK('No float allowed',FN);
- end;
- procedure TTestIntToFloatNode.TestDestroy;
- begin
- FN:=TIntToFloatNode.Create(TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled)
- end;
- procedure TTestIntToFloatNode.TestAsString;
- begin
- FN:=TIntToFloatNode.Create(CreateIntNode(4));
- AssertEquals('Convert has correct asstring','4',FN.AsString);
- end;
- { TTestIntToDateTimeNode }
- procedure TTestIntToDateTimeNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestIntToDateTimeNode.TestCreateInteger;
- begin
- FN:=TIntToDateTimeNode.Create(CreateIntNode(Round(Date)));
- AssertEquals('Convert has correct type',rtDateTime,FN.NodeType);
- AssertEquals('Convert has correct result',Date,FN.NodeValue.ResDateTime);
- end;
- procedure TTestIntToDateTimeNode.TestCreateFloat;
- begin
- FN:=TIntToDateTimeNode.Create(CreateFloatNode(4.0));
- AssertNodeNotOK('No float allowed',FN);
- end;
- procedure TTestIntToDateTimeNode.TestDestroy;
- begin
- FN:=TIntToDateTimeNode.Create(TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled)
- end;
- procedure TTestIntToDateTimeNode.TestAsString;
- begin
- FN:=TIntToDateTimeNode.Create(CreateIntNode(4));
- AssertEquals('Convert has correct asstring','4',FN.AsString);
- end;
- { TTestFloatToDateTimeNode }
- procedure TTestFloatToDateTimeNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestFloatToDateTimeNode.TestCreateInteger;
- begin
- FN:=TFloatToDateTimeNode.Create(CreateIntNode(4));
- AssertNodeNotOK('No int allowed',FN);
- end;
- procedure TTestFloatToDateTimeNode.TestCreateFloat;
- Var
- T : TExprFloat;
- begin
- T:=Time;
- FN:=TFloatToDateTimeNode.Create(CreateFloatNode(T));
- AssertEquals('Convert has correct type',rtDateTime,FN.NodeType);
- AssertEquals('Convert has correct result',T,FN.NodeValue.ResDateTime);
- end;
- procedure TTestFloatToDateTimeNode.TestDestroy;
- begin
- FN:=TFloatToDateTimeNode.Create(TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled)
- end;
- procedure TTestFloatToDateTimeNode.TestAsString;
- Var
- S : String;
- begin
- FN:=TFloatToDateTimeNode.Create(CreateFloatNode(1.2));
- Str(TExprFloat(1.2),S);
- AssertEquals('Convert has correct asstring',S,FN.AsString);
- end;
- { TMyFPExpressionParser }
- procedure TMyFPExpressionParser.BuildHashList;
- begin
- CreateHashList;
- end;
- { TTestExpressionParser }
- procedure TTestExpressionParser.SetUp;
- begin
- inherited SetUp;
- FP:=TMyFPExpressionParser.Create(Nil);
- end;
- procedure TTestExpressionParser.TearDown;
- begin
- FreeAndNil(FP);
- inherited TearDown;
- end;
- procedure TTestExpressionParser.DoParse;
- begin
- FP.Expression:=FTestExpr;
- end;
- procedure TTestExpressionParser.TestParser(AExpr : string);
- begin
- FTestExpr:=AExpr;
- AssertException(Format('Wrong expression: "%s"',[AExpr]),EExprParser,@DoParse);
- end;
- procedure TTestExpressionParser.AssertLeftRight(N: TFPExprNode; LeftClass,
- RightClass: TClass);
- begin
- AssertNotNull('Binary node not null',N);
- If Not N.InheritsFrom(TFPBinaryOperation) then
- Fail(N.ClassName+' does not descend from TFPBinaryOperation');
- AssertNotNull('Left node assigned',TFPBinaryOperation(N).Left);
- AssertNotNull('Right node assigned',TFPBinaryOperation(N).Right);
- AssertEquals('Left node correct class ',LeftClass, TFPBinaryOperation(N).Left.ClassType);
- AssertEquals('Right node correct class ',RightClass, TFPBinaryOperation(N).Right.ClassType);
- end;
- procedure TTestExpressionParser.AssertOperand(N: TFPExprNode;
- OperandClass: TClass);
- begin
- AssertNotNull('Unary node not null',N);
- If Not N.InheritsFrom(TFPUnaryOperator) then
- Fail(N.ClassName+' does not descend from TFPUnaryOperator');
- AssertNotNull('Operand assigned',TFPUnaryOperator(N).Operand);
- AssertEquals('Operand node correct class ',OperandClass, TFPUnaryOperator(N).Operand.ClassType);
- end;
- procedure TTestExpressionParser.AssertResultType(RT: TResultType);
- begin
- AssertEquals('Result type is '+ResultTypeName(rt),rt,FP.ExprNode);
- AssertEquals('Result type is '+ResultTypeName(rt),rt,FP.ResultType);
- end;
- procedure TTestExpressionParser.AssertResult(F: TExprFloat);
- begin
- AssertEquals('Correct float result',F,FP.ExprNode.NodeValue.ResFloat);
- AssertEquals('Correct float result',F,FP.Evaluate.ResFloat);
- end;
- procedure TTestExpressionParser.AssertResult(I: Int64);
- begin
- AssertEquals('Correct integer result',I,FP.ExprNode.NodeValue.ResInteger);
- AssertEquals('Correct integer result',I,FP.Evaluate.ResInteger);
- end;
- procedure TTestExpressionParser.AssertResult(S: String);
- begin
- AssertEquals('Correct string result',S,FP.ExprNode.NodeValue.ResString);
- AssertEquals('Correct string result',S,FP.Evaluate.ResString);
- end;
- procedure TTestExpressionParser.AssertResult(B: Boolean);
- begin
- AssertEquals('Correct boolean result',B,FP.ExprNode.NodeValue.ResBoolean);
- AssertEquals('Correct boolean result',B,FP.Evaluate.ResBoolean);
- end;
- procedure TTestExpressionParser.AssertDateTimeResult(D: TDateTime);
- begin
- AssertEquals('Correct datetime result',D,FP.ExprNode.NodeValue.ResDateTime);
- AssertEquals('Correct boolean result',D,FP.Evaluate.ResDateTime);
- end;
- //TTestParserExpressions
- procedure TTestParserExpressions.TestCreate;
- begin
- AssertEquals('Expression is empty','',FP.Expression);
- AssertNotNull('Identifiers assigned',FP.Identifiers);
- AssertEquals('No identifiers',0,FP.Identifiers.Count);
- end;
- procedure TTestParserExpressions.TestSimpleNodeFloat;
- begin
- FP.Expression:='123.4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
- AssertResultType(rtFloat);
- AssertResult(123.4);
- end;
- procedure TTestParserExpressions.TestSimpleNodeInteger;
- begin
- FP.Expression:='1234';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
- AssertResultType(rtInteger);
- AssertResult(1234);
- end;
- procedure TTestParserExpressions.TestSimpleNodeBooleanTrue;
- begin
- FP.Expression:='true';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserExpressions.TestSimpleNodeBooleanFalse;
- begin
- FP.Expression:='False';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserExpressions.TestSimpleNodeString;
- begin
- FP.Expression:='''A string''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
- AssertResultType(rtString);
- AssertResult('A string');
- end;
- procedure TTestParserExpressions.TestSimpleNegativeInteger;
- begin
- FP.Expression:='-1234';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPNegateOperation, FP.ExprNode);
- AssertNodeType('Constant expression',TFPConstExpression, TFPNegateOperation(FP.ExprNode).Operand);
- AssertResultType(rtInteger);
- AssertResult(-1234);
- end;
- procedure TTestParserExpressions.TestSimpleNegativeFloat;
- begin
- FP.Expression:='-1.234';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPNegateOperation, FP.ExprNode);
- AssertNodeType('Constant expression',TFPConstExpression, TFPNegateOperation(FP.ExprNode).Operand);
- AssertResultType(rtFloat);
- AssertResult(-1.234);
- end;
- procedure TTestParserExpressions.TestSimpleAddInteger;
- begin
- FP.Expression:='4+1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(5);
- end;
- procedure TTestParserExpressions.TestSimpleAddFloat;
- begin
- FP.Expression:='1.2+3.4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtFloat);
- AssertResult(4.6);
- end;
- procedure TTestParserExpressions.TestSimpleAddIntegerFloat;
- begin
- FP.Expression:='1+3.4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TIntToFLoatNode,TFPConstExpression);
- AssertResultType(rtFloat);
- AssertResult(4.4);
- end;
- procedure TTestParserExpressions.TestSimpleAddFloatInteger;
- begin
- FP.Expression:='3.4 + 1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TIntToFLoatNode);
- AssertResultType(rtFloat);
- AssertResult(4.4);
- end;
- procedure TTestParserExpressions.TestSimpleAddString;
- begin
- FP.Expression:='''alo''+''ha''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtString);
- AssertResult('aloha');
- end;
- procedure TTestParserExpressions.TestSimpleSubtractInteger;
- begin
- FP.Expression:='4-1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(3);
- end;
- procedure TTestParserExpressions.TestSimpleSubtractFloat;
- begin
- FP.Expression:='3.4-1.2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtFloat);
- AssertResult(2.2);
- end;
- procedure TTestParserExpressions.TestSimpleSubtractIntegerFloat;
- begin
- FP.Expression:='3-1.2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TIntToFloatNode,TFPConstExpression);
- AssertResultType(rtFloat);
- AssertResult(1.8);
- end;
- procedure TTestParserExpressions.TestSimpleSubtractFloatInteger;
- begin
- FP.Expression:='3.3-2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TIntToFloatNode);
- AssertResultType(rtFloat);
- AssertResult(1.3);
- end;
- procedure TTestParserExpressions.TestSimpleMultiplyInteger;
- begin
- FP.Expression:='4*2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(8);
- end;
- procedure TTestParserExpressions.TestSimpleMultiplyFloat;
- begin
- FP.Expression:='3.4*1.5';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtFloat);
- AssertResult(5.1);
- end;
- procedure TTestParserExpressions.TestSimpleDivideInteger;
- begin
- FP.Expression:='4/2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPDivideOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtFloat);
- AssertResult(2.0);
- end;
- procedure TTestParserExpressions.TestSimpleDivideFloat;
- begin
- FP.Expression:='5.1/1.5';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPDivideOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtFloat);
- AssertResult(3.4);
- end;
- procedure TTestParserExpressions.TestSimpleBooleanAnd;
- begin
- FP.Expression:='true and true';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserExpressions.TestSimpleIntegerAnd;
- begin
- FP.Expression:='3 and 1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(1);
- end;
- procedure TTestParserExpressions.TestSimpleBooleanOr;
- begin
- FP.Expression:='false or true';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserExpressions.TestSimpleIntegerOr;
- begin
- FP.Expression:='2 or 1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(3);
- end;
- procedure TTestParserExpressions.TestSimpleBooleanNot;
- begin
- FP.Expression:='not false';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Not node',TFPNotNode, FP.ExprNode);
- AssertOperand(FP.ExprNode,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(true);
- end;
- procedure TTestParserExpressions.TestSimpleIntegerNot;
- begin
- FP.Expression:='Not 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Not node',TFPNotNode, FP.ExprNode);
- AssertOperand(FP.ExprNode,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(Not Int64(3));
- end;
- procedure TTestParserExpressions.TestSimpleAddSeries;
- begin
- FP.Expression:='1 + 2 + 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(6);
- end;
- procedure TTestParserExpressions.TestSimpleMultiplySeries;
- begin
- FP.Expression:='2 * 3 * 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(24);
- end;
- procedure TTestParserExpressions.TestSimpleAddMultiplySeries;
- begin
- FP.Expression:='2 * 3 + 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(10);
- end;
- procedure TTestParserExpressions.TestSimpleAddAndSeries;
- begin
- // 2 and (3+4)
- FP.Expression:='2 and 3 + 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation);
- AssertResultType(rtInteger);
- AssertResult(2);
- end;
- procedure TTestParserExpressions.TestSimpleAddOrSeries;
- begin
- // 2 or (3+4)
- FP.Expression:='2 or 3 + 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation);
- AssertResultType(rtInteger);
- AssertResult(7);
- end;
- procedure TTestParserExpressions.TestSimpleOrNotSeries;
- begin
- FP.Expression:='Not 1 or 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPNotNode,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult((Not Int64(1)) or Int64(3));
- end;
- procedure TTestParserExpressions.TestSimpleAndNotSeries;
- begin
- FP.Expression:='Not False and False';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPNotNode,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserExpressions.TestDoubleAddMultiplySeries;
- begin
- FP.Expression:='2 * 3 + 4 * 5';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPMultiplyOperation);
- AssertResultType(rtInteger);
- AssertResult(26);
- end;
- procedure TTestParserExpressions.TestDoubleSubtractMultiplySeries;
- begin
- FP.Expression:='4 * 5 - 2 * 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPMultiplyOperation);
- AssertResultType(rtInteger);
- AssertResult(14);
- end;
- procedure TTestParserExpressions.TestSimpleIfInteger;
- begin
- FP.Expression:='If(True,1,2)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('If operation',TIfOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(1);
- end;
- procedure TTestParserExpressions.TestSimpleIfString;
- begin
- FP.Expression:='If(True,''a'',''b'')';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('If operation',TIfOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtString);
- AssertResult('a');
- end;
- procedure TTestParserExpressions.TestSimpleIfFloat;
- begin
- FP.Expression:='If(True,1.2,3.4)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('If operation',TIfOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtFloat);
- AssertResult(1.2);
- end;
- procedure TTestParserExpressions.TestSimpleIfBoolean;
- begin
- FP.Expression:='If(True,False,True)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('If operation',TIfOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserExpressions.TestSimpleIfDateTime;
- begin
- FP.Identifiers.AddDateTimeVariable('a',Date);
- FP.Identifiers.AddDateTimeVariable('b',Date-1);
- FP.Expression:='If(True,a,b)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('If operation',TIfOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPExprVariable,TFPExprVariable);
- AssertResultType(rtDateTime);
- AssertResult(Date);
- end;
- procedure TTestParserExpressions.TestSimpleIfOperation;
- begin
- FP.Expression:='If(True,''a'',''b'')+''c''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertResultType(rtString);
- AssertResult('ac');
- end;
- procedure TTestParserExpressions.TestSimpleBrackets;
- begin
- FP.Expression:='(4 + 2)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(6);
- end;
- procedure TTestParserExpressions.TestSimpleBrackets2;
- begin
- FP.Expression:='(4 * 2)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(8);
- end;
- procedure TTestParserExpressions.TestSimpleBracketsLeft;
- begin
- FP.Expression:='(4 + 2) * 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(18);
- end;
- procedure TTestParserExpressions.TestSimpleBracketsRight;
- begin
- FP.Expression:='3 * (4 + 2)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation);
- AssertResultType(rtInteger);
- AssertResult(18);
- end;
- procedure TTestParserExpressions.TestSimpleBracketsDouble;
- begin
- FP.Expression:='(3 + 4) * (4 + 2)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPAddOperation);
- AssertResultType(rtInteger);
- AssertResult(42);
- end;
- //TTestParserBooleanOperations
- procedure TTestParserBooleanOperations.TestEqualInteger;
- begin
- FP.Expression:='1 = 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestUnEqualInteger;
- begin
- FP.Expression:='1 <> 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestEqualFloat;
- begin
- FP.Expression:='1.2 = 2.3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestEqualFloat2;
- begin
- FP.Expression:='1.2 = 1.2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestUnEqualFloat;
- begin
- FP.Expression:='1.2 <> 2.3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestEqualString;
- begin
- FP.Expression:='''1.2'' = ''2.3''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestEqualString2;
- begin
- FP.Expression:='''1.2'' = ''1.2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestUnEqualString;
- begin
- FP.Expression:='''1.2'' <> ''2.3''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestUnEqualString2;
- begin
- FP.Expression:='''aa'' <> ''AA''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestEqualBoolean;
- begin
- FP.Expression:='False = True';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestUnEqualBoolean;
- begin
- FP.Expression:='False <> True';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestLessThanInteger;
- begin
- FP.Expression:='1 < 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestLessThanInteger2;
- begin
- FP.Expression:='2 < 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestLessThanEqualInteger;
- begin
- FP.Expression:='3 <= 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestLessThanEqualInteger2;
- begin
- FP.Expression:='2 <= 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestLessThanFloat;
- begin
- FP.Expression:='1.2 < 2.3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestLessThanFloat2;
- begin
- FP.Expression:='2.2 < 2.2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestLessThanEqualFloat;
- begin
- FP.Expression:='3.1 <= 2.1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestLessThanEqualFloat2;
- begin
- FP.Expression:='2.1 <= 2.1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestLessThanString;
- begin
- FP.Expression:='''1'' < ''2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestLessThanString2;
- begin
- FP.Expression:='''2'' < ''2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestLessThanEqualString;
- begin
- FP.Expression:='''3'' <= ''2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestLessThanEqualString2;
- begin
- FP.Expression:='''2'' <= ''2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanInteger;
- begin
- FP.Expression:='1 > 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanInteger2;
- begin
- FP.Expression:='2 > 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanEqualInteger;
- begin
- FP.Expression:='3 >= 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanEqualInteger2;
- begin
- FP.Expression:='2 >= 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanFloat;
- begin
- FP.Expression:='1.2 > 2.3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanFloat2;
- begin
- FP.Expression:='2.2 > 2.2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanEqualFloat;
- begin
- FP.Expression:='3.1 >= 2.1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanEqualFloat2;
- begin
- FP.Expression:='2.1 >= 2.1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanString;
- begin
- FP.Expression:='''1'' > ''2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanString2;
- begin
- FP.Expression:='''2'' > ''2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanEqualString;
- begin
- FP.Expression:='''3'' >= ''2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanEqualString2;
- begin
- FP.Expression:='''2'' >= ''2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.EqualAndSeries;
- begin
- // (1=2) and (3=4)
- FP.Expression:='1 = 2 and 3 = 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.EqualAndSeries2;
- begin
- // (1=2) and (3=4)
- FP.Expression:='1 = 1 and 3 = 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.EqualOrSeries;
- begin
- // (1=2) or (3=4)
- FP.Expression:='1 = 2 or 3 = 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.EqualOrSeries2;
- begin
- // (1=1) or (3=4)
- FP.Expression:='1 = 1 or 3 = 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.UnEqualAndSeries;
- begin
- // (1<>2) and (3<>4)
- FP.Expression:='1 <> 2 and 3 <> 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.UnEqualAndSeries2;
- begin
- // (1<>2) and (3<>4)
- FP.Expression:='1 <> 1 and 3 <> 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.UnEqualOrSeries;
- begin
- // (1<>2) or (3<>4)
- FP.Expression:='1 <> 2 or 3 <> 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.UnEqualOrSeries2;
- begin
- // (1<>1) or (3<>4)
- FP.Expression:='1 <> 1 or 3 <> 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.LessThanAndSeries;
- begin
- // (1<2) and (3<4)
- FP.Expression:='1 < 2 and 3 < 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.LessThanAndSeries2;
- begin
- // (1<2) and (3<4)
- FP.Expression:='1 < 1 and 3 < 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.LessThanOrSeries;
- begin
- // (1<2) or (3<4)
- FP.Expression:='1 < 2 or 3 < 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.LessThanOrSeries2;
- begin
- // (1<1) or (3<4)
- FP.Expression:='1 < 1 or 3 < 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.GreaterThanAndSeries;
- begin
- // (1>2) and (3>4)
- FP.Expression:='1 > 2 and 3 > 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.GreaterThanAndSeries2;
- begin
- // (1>2) and (3>4)
- FP.Expression:='1 > 1 and 3 > 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.GreaterThanOrSeries;
- begin
- // (1>2) or (3>4)
- FP.Expression:='1 > 2 or 3 > 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.GreaterThanOrSeries2;
- begin
- // (1>1) or (3>4)
- FP.Expression:='1 > 1 or 3 > 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.LessThanEqualAndSeries;
- begin
- // (1<=2) and (3<=4)
- FP.Expression:='1 <= 2 and 3 <= 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.LessThanEqualAndSeries2;
- begin
- // (1<=2) and (3<=4)
- FP.Expression:='1 <= 1 and 3 <= 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.LessThanEqualOrSeries;
- begin
- // (1<=2) or (3<=4)
- FP.Expression:='1 <= 2 or 3 <= 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.LessThanEqualOrSeries2;
- begin
- // (1<=1) or (3<=4)
- FP.Expression:='1 <= 1 or 3 <= 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.GreaterThanEqualAndSeries;
- begin
- // (1>=2) and (3>=4)
- FP.Expression:='1 >= 2 and 3 >= 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.GreaterThanEqualAndSeries2;
- begin
- // (1>=2) and (3>=4)
- FP.Expression:='1 >= 1 and 3 >= 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.GreaterThanEqualOrSeries;
- begin
- // (1>=2) or (3>=4)
- FP.Expression:='1 >= 2 or 3 >= 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.GreaterThanEqualOrSeries2;
- begin
- // (1>=1) or (3>=4)
- FP.Expression:='1 >= 1 or 3 >= 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- //TTestParserOperands
- procedure TTestParserOperands.MissingOperand1;
- begin
- TestParser('1+');
- end;
- procedure TTestParserOperands.MissingOperand2;
- begin
- TestParser('*1');
- end;
- procedure TTestParserOperands.MissingOperand3;
- begin
- TestParser('1*');
- end;
- procedure TTestParserOperands.MissingOperand4;
- begin
- TestParser('1+');
- end;
- procedure TTestParserOperands.MissingOperand5;
- begin
- TestParser('1 and');
- end;
- procedure TTestParserOperands.MissingOperand6;
- begin
- TestParser('1 or');
- end;
- procedure TTestParserOperands.MissingOperand7;
- begin
- TestParser('and 1');
- end;
- procedure TTestParserOperands.MissingOperand8;
- begin
- TestParser('or 1');
- end;
- procedure TTestParserOperands.MissingOperand9;
- begin
- TestParser('1-');
- end;
- procedure TTestParserOperands.MissingOperand10;
- begin
- TestParser('1 = ');
- end;
- procedure TTestParserOperands.MissingOperand11;
- begin
- TestParser('= 1');
- end;
- procedure TTestParserOperands.MissingOperand12;
- begin
- TestParser('1 <> ');
- end;
- procedure TTestParserOperands.MissingOperand13;
- begin
- TestParser('<> 1');
- end;
- procedure TTestParserOperands.MissingOperand14;
- begin
- TestParser('1 >= ');
- end;
- procedure TTestParserOperands.MissingOperand15;
- begin
- TestParser('>= 1');
- end;
- procedure TTestParserOperands.MissingOperand16;
- begin
- TestParser('1 <= ');
- end;
- procedure TTestParserOperands.MissingOperand17;
- begin
- TestParser('<= 1');
- end;
- procedure TTestParserOperands.MissingOperand18;
- begin
- TestParser('1 < ');
- end;
- procedure TTestParserOperands.MissingOperand19;
- begin
- TestParser('< 1');
- end;
- procedure TTestParserOperands.MissingOperand20;
- begin
- TestParser('1 > ');
- end;
- procedure TTestParserOperands.MissingOperand21;
- begin
- TestParser('> 1');
- end;
- procedure TTestParserOperands.MissingBracket1;
- begin
- TestParser('(1+3');
- end;
- procedure TTestParserOperands.MissingBracket2;
- begin
- TestParser('1+3)');
- end;
- procedure TTestParserOperands.MissingBracket3;
- begin
- TestParser('(1+3))');
- end;
- procedure TTestParserOperands.MissingBracket4;
- begin
- TestParser('((1+3)');
- end;
- procedure TTestParserOperands.MissingBracket5;
- begin
- TestParser('((1+3) 4');
- end;
- procedure TTestParserOperands.MissingBracket6;
- begin
- TestParser('IF(true,1,2');
- end;
- procedure TTestParserOperands.MissingBracket7;
- begin
- TestParser('case(1,1,2,4');
- end;
- procedure TTestParserOperands.MissingArgument1;
- begin
- TestParser('IF(true,1)');
- end;
- procedure TTestParserOperands.MissingArgument2;
- begin
- TestParser('IF(True)');
- end;
- procedure TTestParserOperands.MissingArgument3;
- begin
- TestParser('case(1)');
- end;
- procedure TTestParserOperands.MissingArgument4;
- begin
- TestParser('case(1,2)');
- end;
- procedure TTestParserOperands.MissingArgument5;
- begin
- TestParser('case(1,2,3)');
- end;
- procedure TTestParserOperands.MissingArgument6;
- begin
- TestParser('IF(true,1,2,3)');
- end;
- procedure TTestParserOperands.MissingArgument7;
- begin
- TestParser('case(0,1,2,3,4,5,6)');
- end;
- procedure TTestParserTypeMatch.AccessString;
- begin
- FP.AsString;
- end;
- procedure TTestParserTypeMatch.AccessInteger;
- begin
- FP.AsInteger;
- end;
- procedure TTestParserTypeMatch.AccessFloat;
- begin
- FP.AsFloat;
- end;
- procedure TTestParserTypeMatch.AccessDateTime;
- begin
- FP.AsDateTime;
- end;
- procedure TTestParserTypeMatch.AccessBoolean;
- begin
- FP.AsBoolean;
- end;
- //TTestParserTypeMatch
- procedure TTestParserTypeMatch.TestTypeMismatch1;
- begin
- TestParser('1+''string''');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch2;
- begin
- TestParser('1+True');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch3;
- begin
- TestParser('True+''string''');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch4;
- begin
- TestParser('1.23+''string''');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch5;
- begin
- TestParser('1.23+true');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch6;
- begin
- TestParser('1.23 and true');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch7;
- begin
- TestParser('1.23 or true');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch8;
- begin
- TestParser('''string'' or true');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch9;
- begin
- TestParser('''string'' and true');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch10;
- begin
- TestParser('1.23 or 1');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch11;
- begin
- TestParser('1.23 and 1');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch12;
- begin
- TestParser('''astring'' = 1');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch13;
- begin
- TestParser('true = 1');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch14;
- begin
- TestParser('true * 1');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch15;
- begin
- TestParser('''astring'' * 1');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch16;
- begin
- TestParser('If(1,1,1)');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch17;
- begin
- TestParser('If(True,1,''3'')');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch18;
- begin
- TestParser('case(1,1,''3'',1)');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch19;
- begin
- TestParser('case(1,1,1,''3'')');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch20;
- begin
- FP.Expression:='1';
- AssertException('Accessing integer as string',EExprParser,@AccessString);
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch21;
- begin
- FP.Expression:='''a''';
- AssertException('Accessing string as integer',EExprParser,@AccessInteger);
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch22;
- begin
- FP.Expression:='''a''';
- AssertException('Accessing string as float',EExprParser,@AccessFloat);
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch23;
- begin
- FP.Expression:='''a''';
- AssertException('Accessing string as boolean',EExprParser,@AccessBoolean);
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch24;
- begin
- FP.Expression:='''a''';
- AssertException('Accessing string as datetime',EExprParser,@AccessDateTime);
- end;
- //TTestParserVariables
- Procedure GetDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resDateTime:=Date;
- end;
- procedure TTestParserVariables.TestVariable1;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddVariable('a',rtBoolean,'True');
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
- AssertEquals('Variable has correct value','True',I.Value);
- end;
- procedure TTestParserVariables.TestVariable2;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddBooleanVariable('a',False);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
- AssertEquals('Variable has correct value','False',I.Value);
- end;
- procedure TTestParserVariables.TestVariable3;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',123);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Variable has correct resulttype',rtInteger,I.ResultType);
- AssertEquals('Variable has correct value','123',I.Value);
- end;
- procedure TTestParserVariables.TestVariable4;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFloatVariable('a',1.23);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Variable has correct resulttype',rtFloat,I.ResultType);
- AssertEquals('Variable has correct value',FloatToStr(1.23),I.Value);
- end;
- procedure TTestParserVariables.TestVariable5;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddStringVariable('a','1.23');
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Variable has correct resulttype',rtString,I.ResultType);
- AssertEquals('Variable has correct value','1.23',I.Value);
- end;
- procedure TTestParserVariables.TestVariable6;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Now;
- I:=FP.Identifiers.AddDateTimeVariable('a',D);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Variable has correct resulttype',rtDateTime,I.ResultType);
- AssertEquals('Variable has correct value',FormatDateTime('cccc',D),I.Value);
- end;
- procedure TTestParserVariables.AddVariabletwice;
- begin
- FP.Identifiers.AddDateTimeVariable('a',Now);
- end;
- procedure TTestParserVariables.UnknownVariable;
- begin
- FP.Identifiers.IdentifierByName('unknown');
- end;
- procedure TTestParserVariables.ReadWrongType;
- Var
- Res : TFPExpressioNResult;
- begin
- AssertEquals('Only one identifier',1,FP.Identifiers.Count);
- Case FAsWrongType of
- rtBoolean : res.ResBoolean:=FP.Identifiers[0].AsBoolean;
- rtString : res.ResString:=FP.Identifiers[0].AsString;
- rtInteger : Res.ResInteger:=FP.Identifiers[0].AsInteger;
- rtFloat : Res.ResFloat:=FP.Identifiers[0].AsFloat;
- rtDateTime : Res.ResDateTime:=FP.Identifiers[0].AsDateTime;
- end;
- end;
- procedure TTestParserVariables.WriteWrongType;
- Var
- Res : TFPExpressioNResult;
- begin
- AssertEquals('Only one identifier',1,FP.Identifiers.Count);
- Case FAsWrongType of
- rtBoolean : FP.Identifiers[0].AsBoolean:=res.ResBoolean;
- rtString : FP.Identifiers[0].AsString:=res.ResString;
- rtInteger : FP.Identifiers[0].AsInteger:=Res.ResInteger;
- rtFloat : FP.Identifiers[0].AsFloat:=Res.ResFloat;
- rtDateTime : FP.Identifiers[0].AsDateTime:=Res.ResDateTime;
- end;
- end;
- procedure TTestParserVariables.DoDummy(var Result: TFPExpressionResult;
- const Args: TExprParameterArray);
- begin
- // Do nothing;
- end;
- procedure TTestParserVariables.TestVariableAssign;
- Var
- I,J : TFPExprIdentifierDef;
- begin
- I:=TFPExprIdentifierDef.Create(Nil);
- try
- J:=TFPExprIdentifierDef.Create(Nil);
- try
- I.Name:='Aname';
- I.ParameterTypes:='ISDBF';
- I.ResultType:=rtFloat;
- I.Value:='1.23';
- I.OnGetFunctionValue:=@DoDummy;
- I.OnGetFunctionValueCallBack:=@GetDate;
- J.Assign(I);
- AssertEquals('Names match',I.Name,J.Name);
- AssertEquals('Parametertypes match',I.ParameterTypes,J.ParameterTypes);
- AssertEquals('Values match',I.Value,J.Value);
- AssertEquals('Result types match',Ord(I.ResultType),Ord(J.ResultType));
- AssertSame('Callbacks match',Pointer(I.OnGetFunctionValueCallBack),Pointer(J.OnGetFunctionValueCallback));
- If (I.OnGetFunctionValue)<>(J.OnGetFunctionValue) then
- Fail('OnGetFUnctionValue as Method does not match');
- finally
- J.Free;
- end;
- finally
- I.Free;
- end;
- end;
- procedure TTestParserVariables.TestVariableAssignAgain;
- Var
- I,J : TFPBuiltinExprIdentifierDef;
- begin
- I:=TFPBuiltinExprIdentifierDef.Create(Nil);
- try
- J:=TFPBuiltinExprIdentifierDef.Create(Nil);
- try
- I.Name:='Aname';
- I.ParameterTypes:='ISDBF';
- I.ResultType:=rtFloat;
- I.Value:='1.23';
- I.OnGetFunctionValue:=@DoDummy;
- I.OnGetFunctionValueCallBack:=@GetDate;
- I.Category:=bcUser;
- J.Assign(I);
- AssertEquals('Names match',I.Name,J.Name);
- AssertEquals('Parametertypes match',I.ParameterTypes,J.ParameterTypes);
- AssertEquals('Values match',I.Value,J.Value);
- AssertEquals('Result types match',Ord(I.ResultType),Ord(J.ResultType));
- AssertEquals('Categories match',Ord(I.Category),Ord(J.Category));
- AssertSame('Callbacks match',Pointer(I.OnGetFunctionValueCallBack),Pointer(J.OnGetFunctionValueCallback));
- If (I.OnGetFunctionValue)<>(J.OnGetFunctionValue) then
- Fail('OnGetFUnctionValue as Method does not match');
- finally
- J.Free;
- end;
- finally
- I.Free;
- end;
- end;
- procedure TTestParserVariables.TestVariable7;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Now;
- I:=FP.Identifiers.AddDateTimeVariable('a',D);
- AssertException('Cannot add same name twice',EExprParser,@AddVariabletwice);
- end;
- procedure TTestParserVariables.TestVariable8;
- Var
- I : TFPExprIdentifierDef;
- begin
- FP.Identifiers.AddIntegerVariable('a',123);
- FP.Identifiers.AddIntegerVariable('b',123);
- AssertEquals('List is dirty',True,FP.Dirty);
- FP.BuildHashList;
- FP.Identifiers.Delete(0);
- AssertEquals('List is dirty',True,FP.Dirty);
- end;
- procedure TTestParserVariables.TestVariable9;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',123);
- FP.Expression:='a';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
- AssertResultType(rtInteger);
- AssertResult(123);
- end;
- procedure TTestParserVariables.TestVariable10;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddStringVariable('a','a123');
- FP.Expression:='a';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
- AssertResultType(rtString);
- AssertResult('a123');
- end;
- procedure TTestParserVariables.TestVariable11;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFloatVariable('a',1.23);
- FP.Expression:='a';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
- AssertResultType(rtFloat);
- AssertResult(1.23);
- end;
- procedure TTestParserVariables.TestVariable12;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddBooleanVariable('a',True);
- FP.Expression:='a';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserVariables.TestVariable13;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddDateTimeVariable('a',D);
- FP.Expression:='a';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
- AssertResultType(rtDateTime);
- AssertDateTimeResult(D);
- end;
- procedure TTestParserVariables.TestVariable14;
- Var
- I,S : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',1);
- FP.BuildHashList;
- S:=FP.IdentifierByName('a');
- AssertSame('Identifier found',I,S);
- end;
- procedure TTestParserVariables.TestVariable15;
- Var
- I,S : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',1);
- FP.BuildHashList;
- S:=FP.IdentifierByName('A');
- AssertSame('Identifier found',I,S);
- end;
- procedure TTestParserVariables.TestVariable16;
- Var
- I,S : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',1);
- FP.BuildHashList;
- S:=FP.IdentifierByName('B');
- AssertNull('Identifier not found',S);
- end;
- procedure TTestParserVariables.TestVariable17;
- Var
- I,S : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',1);
- FP.BuildHashList;
- AssertException('Identifier not found',EExprParser,@unknownvariable);
- end;
- procedure TTestParserVariables.TestVariable18;
- Var
- I,S : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',1);
- S:=FP.Identifiers.FindIdentifier('B');
- AssertNull('Identifier not found',S);
- end;
- procedure TTestParserVariables.TestVariable19;
- Var
- I,S : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',1);
- S:=FP.Identifiers.FindIdentifier('a');
- AssertSame('Identifier found',I,S);
- end;
- procedure TTestParserVariables.TestVariable20;
- Var
- I,S : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',1);
- S:=FP.Identifiers.FindIdentifier('A');
- AssertSame('Identifier found',I,S);
- end;
- procedure TTestParserVariables.TestAccess(Skip : TResultType);
- Var
- rt : TResultType;
- begin
- For rt:=Low(TResultType) to High(TResultType) do
- if rt<>skip then
- begin
- FasWrongType:=rt;
- AssertException('Acces as '+ResultTypeName(rt),EExprParser,@ReadWrongtype);
- end;
- For rt:=Low(TResultType) to High(TResultType) do
- if rt<>skip then
- begin
- FasWrongType:=rt;
- AssertException('Acces as '+ResultTypeName(rt),EExprParser,@WriteWrongtype);
- end;
- end;
- procedure TTestParserVariables.TestVariable21;
- begin
- FP.IDentifiers.AddIntegerVariable('a',1);
- TestAccess(rtInteger);
- end;
- procedure TTestParserVariables.TestVariable22;
- begin
- FP.IDentifiers.AddFloatVariable('a',1.0);
- TestAccess(rtFloat);
- end;
- procedure TTestParserVariables.TestVariable23;
- begin
- FP.IDentifiers.AddStringVariable('a','1.0');
- TestAccess(rtString);
- end;
- procedure TTestParserVariables.TestVariable24;
- begin
- FP.IDentifiers.AddBooleanVariable('a',True);
- TestAccess(rtBoolean);
- end;
- procedure TTestParserVariables.TestVariable25;
- begin
- FP.IDentifiers.AddDateTimeVariable('a',Date);
- TestAccess(rtDateTime);
- end;
- procedure TTestParserVariables.TestVariable26;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.IDentifiers.AddStringVariable('a','1.0');
- I.AsString:='12';
- AssertEquals('Correct value','12',I.AsString);
- end;
- procedure TTestParserVariables.TestVariable27;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.IDentifiers.AddIntegerVariable('a',10);
- I.Asinteger:=12;
- AssertEquals('Correct value',12,I.AsInteger);
- end;
- procedure TTestParserVariables.TestVariable28;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.IDentifiers.AddFloatVariable('a',1.0);
- I.AsFloat:=1.2;
- AssertEquals('Correct value',1.2,I.AsFloat);
- end;
- procedure TTestParserVariables.TestVariable29;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.IDentifiers.AddDateTimeVariable('a',Now);
- I.AsDateTime:=Date-1;
- AssertEquals('Correct value',Date-1,I.AsDateTime);
- end;
- procedure TTestParserVariables.TestVariable30;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddBooleanVariable('a',True);
- I.AsBoolean:=False;
- AssertEquals('Correct value',False,I.AsBoolean);
- end;
- Procedure EchoDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resDateTime:=Args[0].resDateTime;
- end;
- Procedure EchoInteger(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resInteger:=Args[0].resInteger;
- end;
- Procedure EchoBoolean(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resBoolean:=Args[0].resBoolean;
- end;
- Procedure EchoFloat(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resFloat:=Args[0].resFloat;
- end;
- Procedure EchoString(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resString:=Args[0].resString;
- end;
- Procedure TTestExpressionParser.DoEchoDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resDateTime:=Args[0].resDateTime;
- end;
- Procedure TTestExpressionParser.DoEchoInteger(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resInteger:=Args[0].resInteger;
- end;
- Procedure TTestExpressionParser.DoEchoBoolean(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resBoolean:=Args[0].resBoolean;
- end;
- Procedure TTestExpressionParser.DoEchoFloat(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resFloat:=Args[0].resFloat;
- end;
- Procedure TTestExpressionParser.DoEchoString(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resString:=Args[0].resString;
- end;
- procedure TTestExpressionParser.DoGetDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- begin
- Result.ResDatetime:=Date;
- end;
- procedure TTestExpressionParser.DoAddInteger(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- begin
- Result.Resinteger:=Args[0].ResInteger+Args[1].ResInteger;
- end;
- procedure TTestExpressionParser.DoDeleteString(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- begin
- Result.ResString:=Args[0].ResString;
- Delete(Result.ResString,Args[1].ResInteger,Args[2].ResInteger);
- end;
- procedure TTestParserFunctions.TryRead;
- Var
- Res : TFPExpressioNResult;
- begin
- AssertEquals('Only one identifier',1,FP.Identifiers.Count);
- Case FAccessAs of
- rtBoolean : res.ResBoolean:=FP.Identifiers[0].AsBoolean;
- rtString : res.ResString:=FP.Identifiers[0].AsString;
- rtInteger : Res.ResInteger:=FP.Identifiers[0].AsInteger;
- rtFloat : Res.ResFloat:=FP.Identifiers[0].AsFloat;
- rtDateTime : Res.ResDateTime:=FP.Identifiers[0].AsDateTime;
- end;
- end;
- procedure TTestParserFunctions.TryWrite;
- Var
- Res : TFPExpressioNResult;
- begin
- AssertEquals('Only one identifier',1,FP.Identifiers.Count);
- Case FAccessAs of
- rtBoolean : FP.Identifiers[0].AsBoolean:=res.ResBoolean;
- rtString : FP.Identifiers[0].AsString:=res.ResString;
- rtInteger : FP.Identifiers[0].AsInteger:=Res.ResInteger;
- rtFloat : FP.Identifiers[0].AsFloat:=Res.ResFloat;
- rtDateTime : FP.Identifiers[0].AsDateTime:=Res.ResDateTime;
- end;
- end;
- // TTestParserFunctions
- procedure TTestParserFunctions.TestFunction1;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('Date','D','',@GetDate);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
- AssertSame('Function has correct address',Pointer(@GetDate),Pointer(I.OnGetFunctionValueCallBack));
- FaccessAs:=rtDateTime;
- AssertException('No read access',EExprParser,@TryRead);
- AssertException('No write access',EExprParser,@TryWrite);
- end;
- procedure TTestParserFunctions.TestFunction2;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoDate','D','D',@EchoDate);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
- AssertSame('Function has correct address',Pointer(@EchoDate),Pointer(I.OnGetFunctionValueCallBack));
- end;
- procedure TTestParserFunctions.TestFunction3;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@EchoInteger);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
- AssertSame('Function has correct address',Pointer(@EchoInteger),Pointer(I.OnGetFunctionValueCallBack));
- FaccessAs:=rtInteger;
- AssertException('No read access',EExprParser,@TryRead);
- AssertException('No write access',EExprParser,@TryWrite);
- end;
- procedure TTestParserFunctions.TestFunction4;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@EchoBoolean);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtBoolean,I.ResultType);
- AssertSame('Function has correct address',Pointer(@EchoBoolean),Pointer(I.OnGetFunctionValueCallBack));
- FaccessAs:=rtBoolean;
- AssertException('No read access',EExprParser,@TryRead);
- AssertException('No write access',EExprParser,@TryWrite);
- end;
- procedure TTestParserFunctions.TestFunction5;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@EchoFloat);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtFloat,I.ResultType);
- AssertSame('Function has correct address',Pointer(@EchoFloat),Pointer(I.OnGetFunctionValueCallBack));
- FaccessAs:=rtfloat;
- AssertException('No read access',EExprParser,@TryRead);
- AssertException('No write access',EExprParser,@TryWrite);
- end;
- procedure TTestParserFunctions.TestFunction6;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoString','S','S',@EchoString);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtString,I.ResultType);
- AssertSame('Function has correct address',Pointer(@EchoString),Pointer(I.OnGetFunctionValueCallBack));
- FaccessAs:=rtString;
- AssertException('No read access',EExprParser,@TryRead);
- AssertException('No write access',EExprParser,@TryWrite);
- end;
- procedure TTestParserFunctions.TestFunction7;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoDate','D','D',@DoEchoDate);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
- // AssertSame('Function has correct address',TMethod(@Self.DoEchoDate),TMethod(I.OnGetFunctionValue));
- end;
- procedure TTestParserFunctions.TestFunction8;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@DOEchoInteger);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
- // AssertSame('Function has correct address',Pointer(@EchoInteger),Pointer(I.OnGetFunctionValueCallBack));
- end;
- procedure TTestParserFunctions.TestFunction9;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@DoEchoBoolean);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtBoolean,I.ResultType);
- // AssertSame('Function has correct address',Pointer(@EchoBoolean),Pointer(I.OnGetFunctionValueCallBack));
- end;
- procedure TTestParserFunctions.TestFunction10;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@DoEchoFloat);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtFloat,I.ResultType);
- // AssertSame('Function has correct address',Pointer(@EchoFloat),Pointer(I.OnGetFunctionValueCallBack));
- end;
- procedure TTestParserFunctions.TestFunction11;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoString','S','S',@DoEchoString);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtString,I.ResultType);
- // AssertSame('Function has correct address',Pointer(@EchoString),Pointer(I.OnGetFunctionValueCallBack));
- end;
- procedure TTestParserFunctions.TestFunction12;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddFunction('Date','D','',@GetDate);
- FP.Expression:='Date';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
- AssertResultType(rtDateTime);
- AssertDateTimeResult(D);
- end;
- procedure TTestParserFunctions.TestFunction13;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddDateTimeVariable('a',D);
- I:=FP.Identifiers.AddFunction('EchoDate','D','D',@EchoDate);
- FP.Expression:='EchoDate(a)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
- AssertResultType(rtDateTime);
- AssertDateTimeResult(D);
- end;
- procedure TTestParserFunctions.TestFunction14;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@EchoInteger);
- FP.Expression:='EchoInteger(13)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
- AssertResultType(rtInteger);
- AssertResult(13);
- end;
- procedure TTestParserFunctions.TestFunction15;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@EchoBoolean);
- FP.Expression:='EchoBoolean(True)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserFunctions.TestFunction16;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@EchoFloat);
- FP.Expression:='EchoFloat(1.234)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
- AssertResultType(rtFloat);
- AssertResult(1.234);
- end;
- procedure TTestParserFunctions.TestFunction17;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddFunction('EchoString','S','S',@EchoString);
- FP.Expression:='EchoString(''Aloha'')';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
- AssertResultType(rtString);
- AssertResult('Aloha');
- end;
- procedure TTestParserFunctions.TestFunction18;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddDateTimeVariable('a',D);
- I:=FP.Identifiers.AddFunction('EchoDate','D','D',@DoEchoDate);
- FP.Expression:='EchoDate(a)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtDateTime);
- AssertDateTimeResult(D);
- end;
- procedure TTestParserFunctions.TestFunction19;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@DoEchoInteger);
- FP.Expression:='EchoInteger(13)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtInteger);
- AssertResult(13);
- end;
- procedure TTestParserFunctions.TestFunction20;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@DoEchoBoolean);
- FP.Expression:='EchoBoolean(True)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserFunctions.TestFunction21;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@DoEchoFloat);
- FP.Expression:='EchoFloat(1.234)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtFloat);
- AssertResult(1.234);
- end;
- procedure TTestParserFunctions.TestFunction22;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddFunction('EchoString','S','S',@DoEchoString);
- FP.Expression:='EchoString(''Aloha'')';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtString);
- AssertResult('Aloha');
- end;
- procedure TTestParserFunctions.TestFunction23;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddFunction('Date','D','',@DoGetDate);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
- FP.Expression:='Date';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtDateTime);
- AssertDateTimeResult(D);
- end;
- procedure TTestParserFunctions.TestFunction24;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
- FP.Expression:='AddInteger(1,2)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtInteger);
- AssertResult(3);
- end;
- procedure TTestParserFunctions.TestFunction25;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('Delete','S','SII',@DoDeleteString);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtString,I.ResultType);
- FP.Expression:='Delete(''ABCDEFGHIJ'',3,2)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtString);
- AssertResult('ABEFGHIJ');
- end;
- procedure TTestParserFunctions.TestFunction26;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
- FP.Expression:='AddInteger(1,2+3)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtInteger);
- AssertResult(6);
- end;
- procedure TTestParserFunctions.TestFunction27;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
- FP.Expression:='AddInteger(1+2,3*4)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtInteger);
- AssertResult(15);
- end;
- procedure TTestParserFunctions.TestFunction28;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
- FP.Expression:='AddInteger(3 and 2,3*4)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtInteger);
- AssertResult(14);
- end;
- procedure TTestParserFunctions.TestFunction29;
- Var
- I : TFPExprIdentifierDef;
- begin
- // Test type mismatch
- I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
- TestParser('AddInteger(3 and 2,''s'')');
- end;
- { TTestBuiltinsManager }
- procedure TTestBuiltinsManager.Setup;
- begin
- inherited Setup;
- FM:=TExprBuiltInManager.Create(Nil);
- end;
- procedure TTestBuiltinsManager.Teardown;
- begin
- FreeAndNil(FM);
- inherited Teardown;
- end;
- procedure TTestBuiltinsManager.TestCreate;
- begin
- AssertEquals('Have no builtin expressions',0,FM.IdentifierCount);
- end;
- procedure TTestBuiltinsManager.TestVariable1;
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.AddVariable(bcuser,'a',rtBoolean,'True');
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FM.IdentifierCount);
- AssertSame('Result equals variable added',I,FM.Identifiers[0]);
- AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
- AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
- AssertEquals('Variable has correct value','True',I.Value);
- end;
- procedure TTestBuiltinsManager.TestVariable2;
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.AddBooleanVariable(bcUser,'a',False);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FM.IdentifierCount);
- AssertSame('Result equals variable added',I,FM.Identifiers[0]);
- AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
- AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
- AssertEquals('Variable has correct value','False',I.Value);
- end;
- procedure TTestBuiltinsManager.TestVariable3;
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.AddIntegerVariable(bcUser,'a',123);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FM.IdentifierCount);
- AssertSame('Result equals variable added',I,FM.Identifiers[0]);
- AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
- AssertEquals('Variable has correct resulttype',rtInteger,I.ResultType);
- AssertEquals('Variable has correct value','123',I.Value);
- end;
- procedure TTestBuiltinsManager.TestVariable4;
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.AddFloatVariable(bcUser,'a',1.23);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FM.IdentifierCount);
- AssertSame('Result equals variable added',I,FM.Identifiers[0]);
- AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
- AssertEquals('Variable has correct resulttype',rtFloat,I.ResultType);
- AssertEquals('Variable has correct value',FloatToStr(1.23),I.Value);
- end;
- procedure TTestBuiltinsManager.TestVariable5;
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.AddStringVariable(bcUser,'a','1.23');
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FM.IdentifierCount);
- AssertSame('Result equals variable added',I,FM.Identifiers[0]);
- AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
- AssertEquals('Variable has correct resulttype',rtString,I.ResultType);
- AssertEquals('Variable has correct value','1.23',I.Value);
- end;
- procedure TTestBuiltinsManager.TestVariable6;
- Var
- I : TFPBuiltinExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Now;
- I:=FM.AddDateTimeVariable(bcUser,'a',D);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FM.IdentifierCount);
- AssertSame('Result equals variable added',I,FM.Identifiers[0]);
- AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
- AssertEquals('Variable has correct resulttype',rtDateTime,I.ResultType);
- AssertEquals('Variable has correct value',FormatDateTime('cccc',D),I.Value);
- end;
- procedure TTestBuiltinsManager.TestFunction1;
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.AddFunction(bcUser,'Date','D','',@GetDate);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FM.IdentifierCount);
- AssertSame('Result equals variable added',I,FM.Identifiers[0]);
- AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
- AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
- AssertSame('Function has correct address',Pointer(@GetDate),Pointer(I.OnGetFunctionValueCallBack));
- end;
- procedure TTestBuiltinsManager.TestFunction2;
- Var
- I,I2 : TFPBuiltinExprIdentifierDef;
- ind : Integer;
- begin
- FM.AddFunction(bcUser,'EchoDate','D','D',@EchoDate);
- I:=FM.AddFunction(bcUser,'Echo','D','D',@EchoDate);
- FM.AddFunction(bcUser,'DoEcho','D','D',@EchoDate);
- ind:=FM.IndexOfIdentifier('Echo');
- AssertEquals('Found identifier',1,ind);
- I2:=FM.FindIdentifier('Echo');
- AssertNotNull('FindIdentifier returns result',I2);
- AssertSame('Findidentifier returns correct result',I,I2);
- ind:=FM.IndexOfIdentifier('NoNoNo');
- AssertEquals('Found no such identifier',-1,ind);
- I2:=FM.FindIdentifier('NoNoNo');
- AssertNull('FindIdentifier returns no result',I2);
- end;
- { TTestBuiltins }
- procedure TTestBuiltins.Setup;
- begin
- inherited Setup;
- FM:=TExprBuiltInManager.Create(Nil);
- end;
- procedure TTestBuiltins.Teardown;
- begin
- FreeAndNil(FM);
- inherited Teardown;
- end;
- procedure TTestBuiltins.SetExpression(Const AExpression : String);
- Var
- Msg : String;
- begin
- Msg:='';
- try
- FP.Expression:=AExpression;
- except
- On E : Exception do
- Msg:=E.message;
- end;
- If (Msg<>'') then
- Fail('Parsing of expression "'+AExpression+'" failed :'+Msg);
- end;
- procedure TTestBuiltins.AssertVariable(const ADefinition: String;
- AResultType: TResultType);
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.FindIdentifier(ADefinition);
- AssertNotNull('Definition '+ADefinition+' is present.',I);
- AssertEquals('Correct result type',AResultType,I.ResultType);
- end;
- procedure TTestBuiltins.AssertFunction(const ADefinition, AResultType,
- ArgumentTypes: String; ACategory : TBuiltinCategory);
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.FindIdentifier(ADefinition);
- AssertEquals('Correct result type for test',1,Length(AResultType));
- AssertNotNull('Definition '+ADefinition+' is present.',I);
- AssertEquals(ADefinition+' has correct parameter types',ArgumentTypes,I.ParameterTypes);
- AssertEquals(ADefinition+' has correct result type',CharToResultType(AResultType[1]),I.ResultType);
- AssertEquals(ADefinition+' has correct category',Ord(ACategory),Ord(I.Category));
- end;
- procedure TTestBuiltins.AssertExpression(const AExpression: String;
- AResult: Int64);
- begin
- FP.BuiltIns:=AllBuiltIns;
- SetExpression(AExpression);
- AssertResult(AResult);
- end;
- procedure TTestBuiltins.AssertExpression(const AExpression: String;
- const AResult: String);
- begin
- FP.BuiltIns:=AllBuiltIns;
- SetExpression(AExpression);
- AssertResult(AResult);
- end;
- procedure TTestBuiltins.AssertExpression(const AExpression: String;
- const AResult: TExprFloat);
- begin
- FP.BuiltIns:=AllBuiltIns;
- SetExpression(AExpression);
- AssertResult(AResult);
- end;
- procedure TTestBuiltins.AssertExpression(const AExpression: String;
- const AResult: Boolean);
- begin
- FP.BuiltIns:=AllBuiltIns;
- SetExpression(AExpression);
- AssertResult(AResult);
- end;
- procedure TTestBuiltins.AssertDateTimeExpression(const AExpression: String;
- const AResult: TDateTime);
- begin
- FP.BuiltIns:=AllBuiltIns;
- SetExpression(AExpression);
- AssertDatetimeResult(AResult);
- end;
- procedure TTestBuiltins.TestRegister;
- begin
- RegisterStdBuiltins(FM);
- AssertEquals('Correct number of identifiers',64,FM.IdentifierCount);
- Assertvariable('pi',rtFloat);
- AssertFunction('cos','F','F',bcMath);
- AssertFunction('sin','F','F',bcMath);
- AssertFunction('arctan','F','F',bcMath);
- AssertFunction('abs','F','F',bcMath);
- AssertFunction('sqr','F','F',bcMath);
- AssertFunction('sqrt','F','F',bcMath);
- AssertFunction('exp','F','F',bcMath);
- AssertFunction('ln','F','F',bcMath);
- AssertFunction('log','F','F',bcMath);
- AssertFunction('frac','F','F',bcMath);
- AssertFunction('int','F','F',bcMath);
- AssertFunction('round','I','F',bcMath);
- AssertFunction('trunc','I','F',bcMath);
- AssertFunction('length','I','S',bcStrings);
- AssertFunction('copy','S','SII',bcStrings);
- AssertFunction('delete','S','SII',bcStrings);
- AssertFunction('pos','I','SS',bcStrings);
- AssertFunction('lowercase','S','S',bcStrings);
- AssertFunction('uppercase','S','S',bcStrings);
- AssertFunction('stringreplace','S','SSSBB',bcStrings);
- AssertFunction('comparetext','I','SS',bcStrings);
- AssertFunction('date','D','',bcDateTime);
- AssertFunction('time','D','',bcDateTime);
- AssertFunction('now','D','',bcDateTime);
- AssertFunction('dayofweek','I','D',bcDateTime);
- AssertFunction('extractyear','I','D',bcDateTime);
- AssertFunction('extractmonth','I','D',bcDateTime);
- AssertFunction('extractday','I','D',bcDateTime);
- AssertFunction('extracthour','I','D',bcDateTime);
- AssertFunction('extractmin','I','D',bcDateTime);
- AssertFunction('extractsec','I','D',bcDateTime);
- AssertFunction('extractmsec','I','D',bcDateTime);
- AssertFunction('encodedate','D','III',bcDateTime);
- AssertFunction('encodetime','D','IIII',bcDateTime);
- AssertFunction('encodedatetime','D','IIIIIII',bcDateTime);
- AssertFunction('shortdayname','S','I',bcDateTime);
- AssertFunction('shortmonthname','S','I',bcDateTime);
- AssertFunction('longdayname','S','I',bcDateTime);
- AssertFunction('longmonthname','S','I',bcDateTime);
- AssertFunction('formatdatetime','S','SD',bcDateTime);
- AssertFunction('shl','I','II',bcBoolean);
- AssertFunction('shr','I','II',bcBoolean);
- AssertFunction('IFS','S','BSS',bcBoolean);
- AssertFunction('IFF','F','BFF',bcBoolean);
- AssertFunction('IFD','D','BDD',bcBoolean);
- AssertFunction('IFI','I','BII',bcBoolean);
- AssertFunction('inttostr','S','I',bcConversion);
- AssertFunction('strtoint','I','S',bcConversion);
- AssertFunction('strtointdef','I','SI',bcConversion);
- AssertFunction('floattostr','S','F',bcConversion);
- AssertFunction('strtofloat','F','S',bcConversion);
- AssertFunction('strtofloatdef','F','SF',bcConversion);
- AssertFunction('booltostr','S','B',bcConversion);
- AssertFunction('strtobool','B','S',bcConversion);
- AssertFunction('strtobooldef','B','SB',bcConversion);
- AssertFunction('datetostr','S','D',bcConversion);
- AssertFunction('timetostr','S','D',bcConversion);
- AssertFunction('strtodate','D','S',bcConversion);
- AssertFunction('strtodatedef','D','SD',bcConversion);
- AssertFunction('strtotime','D','S',bcConversion);
- AssertFunction('strtotimedef','D','SD',bcConversion);
- AssertFunction('strtodatetime','D','S',bcConversion);
- AssertFunction('strtodatetimedef','D','SD',bcConversion);
- end;
- procedure TTestBuiltins.TestVariablepi;
- begin
- AssertExpression('pi',Pi);
- end;
- procedure TTestBuiltins.TestFunctioncos;
- begin
- AssertExpression('cos(0.5)',Cos(0.5));
- AssertExpression('cos(0.75)',Cos(0.75));
- end;
- procedure TTestBuiltins.TestFunctionsin;
- begin
- AssertExpression('sin(0.5)',sin(0.5));
- AssertExpression('sin(0.75)',sin(0.75));
- end;
- procedure TTestBuiltins.TestFunctionarctan;
- begin
- AssertExpression('arctan(0.5)',arctan(0.5));
- AssertExpression('arctan(0.75)',arctan(0.75));
- end;
- procedure TTestBuiltins.TestFunctionabs;
- begin
- AssertExpression('abs(0.5)',0.5);
- AssertExpression('abs(-0.75)',0.75);
- end;
- procedure TTestBuiltins.TestFunctionsqr;
- begin
- AssertExpression('sqr(0.5)',sqr(0.5));
- AssertExpression('sqr(-0.75)',sqr(0.75));
- end;
- procedure TTestBuiltins.TestFunctionsqrt;
- begin
- AssertExpression('sqrt(0.5)',sqrt(0.5));
- AssertExpression('sqrt(0.75)',sqrt(0.75));
- end;
- procedure TTestBuiltins.TestFunctionexp;
- begin
- AssertExpression('exp(1.0)',exp(1));
- AssertExpression('exp(0.0)',1.0);
- end;
- procedure TTestBuiltins.TestFunctionln;
- begin
- AssertExpression('ln(0.5)',ln(0.5));
- AssertExpression('ln(1.5)',ln(1.5));
- end;
- procedure TTestBuiltins.TestFunctionlog;
- begin
- AssertExpression('log(0.5)',ln(0.5)/ln(10.0));
- AssertExpression('log(1.5)',ln(1.5)/ln(10.0));
- AssertExpression('log(10.0)',1.0);
- end;
- procedure TTestBuiltins.TestFunctionfrac;
- begin
- AssertExpression('frac(0.5)',frac(0.5));
- AssertExpression('frac(1.5)',frac(1.5));
- end;
- procedure TTestBuiltins.TestFunctionint;
- begin
- AssertExpression('int(0.5)',int(0.5));
- AssertExpression('int(1.5)',int(1.5));
- end;
- procedure TTestBuiltins.TestFunctionround;
- begin
- AssertExpression('round(0.5)',round(0.5));
- AssertExpression('round(1.55)',round(1.55));
- end;
- procedure TTestBuiltins.TestFunctiontrunc;
- begin
- AssertExpression('trunc(0.5)',trunc(0.5));
- AssertExpression('trunc(1.55)',trunc(1.55));
- end;
- procedure TTestBuiltins.TestFunctionlength;
- begin
- AssertExpression('length(''123'')',3);
- end;
- procedure TTestBuiltins.TestFunctioncopy;
- begin
- AssertExpression('copy(''123456'',2,4)','2345');
- end;
- procedure TTestBuiltins.TestFunctiondelete;
- begin
- AssertExpression('delete(''123456'',2,4)','16');
- end;
- procedure TTestBuiltins.TestFunctionpos;
- begin
- AssertExpression('pos(''234'',''123456'')',2);
- end;
- procedure TTestBuiltins.TestFunctionlowercase;
- begin
- AssertExpression('lowercase(''AbCdEf'')','abcdef');
- end;
- procedure TTestBuiltins.TestFunctionuppercase;
- begin
- AssertExpression('uppercase(''AbCdEf'')','ABCDEF');
- end;
- procedure TTestBuiltins.TestFunctionstringreplace;
- begin
- // last options are replaceall, ignorecase
- AssertExpression('stringreplace(''AbCdEf'',''C'',''Z'',false,false)','AbZdEf');
- AssertExpression('stringreplace(''AbCdEf'',''c'',''Z'',false,false)','AbCdEf');
- AssertExpression('stringreplace(''AbCdEf'',''c'',''Z'',false,true)','AbZdEf');
- AssertExpression('stringreplace(''AbCdEfC'',''C'',''Z'',false,false)','AbZdEfC');
- AssertExpression('stringreplace(''AbCdEfC'',''C'',''Z'',True,false)','AbZdEfZ');
- end;
- procedure TTestBuiltins.TestFunctioncomparetext;
- begin
- AssertExpression('comparetext(''AbCdEf'',''AbCdEf'')',0);
- AssertExpression('comparetext(''AbCdEf'',''ABCDEF'')',0);
- AssertExpression('comparetext(''AbCdEf'',''FEDCBA'')',comparetext('AbCdEf','FEDCBA'));
- end;
- procedure TTestBuiltins.TestFunctiondate;
- begin
- AssertExpression('date',date);
- end;
- procedure TTestBuiltins.TestFunctiontime;
- begin
- AssertExpression('time',time);
- end;
- procedure TTestBuiltins.TestFunctionnow;
- begin
- AssertExpression('now',now);
- end;
- procedure TTestBuiltins.TestFunctiondayofweek;
- begin
- FP.Identifiers.AddDateTimeVariable('D',Date);
- AssertExpression('dayofweek(d)',DayOfWeek(date));
- end;
- procedure TTestBuiltins.TestFunctionextractyear;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(Date,Y,M,D);
- FP.Identifiers.AddDateTimeVariable('D',Date);
- AssertExpression('extractyear(d)',Y);
- end;
- procedure TTestBuiltins.TestFunctionextractmonth;
- Var
- Y,M,D : Word;
- begin
- FP.Identifiers.AddDateTimeVariable('D',Date);
- DecodeDate(Date,Y,M,D);
- AssertExpression('extractmonth(d)',M);
- end;
- procedure TTestBuiltins.TestFunctionextractday;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(Date,Y,M,D);
- FP.Identifiers.AddDateTimeVariable('D',Date);
- AssertExpression('extractday(d)',D);
- end;
- procedure TTestBuiltins.TestFunctionextracthour;
- Var
- T : TDateTime;
- H,m,s,ms : Word;
- begin
- T:=Time;
- DecodeTime(T,h,m,s,ms);
- FP.Identifiers.AddDateTimeVariable('T',T);
- AssertExpression('extracthour(t)',h);
- end;
- procedure TTestBuiltins.TestFunctionextractmin;
- Var
- T : TDateTime;
- H,m,s,ms : Word;
- begin
- T:=Time;
- DecodeTime(T,h,m,s,ms);
- FP.Identifiers.AddDateTimeVariable('T',T);
- AssertExpression('extractmin(t)',m);
- end;
- procedure TTestBuiltins.TestFunctionextractsec;
- Var
- T : TDateTime;
- H,m,s,ms : Word;
- begin
- T:=Time;
- DecodeTime(T,h,m,s,ms);
- FP.Identifiers.AddDateTimeVariable('T',T);
- AssertExpression('extractsec(t)',s);
- end;
- procedure TTestBuiltins.TestFunctionextractmsec;
- Var
- T : TDateTime;
- H,m,s,ms : Word;
- begin
- T:=Time;
- DecodeTime(T,h,m,s,ms);
- FP.Identifiers.AddDateTimeVariable('T',T);
- AssertExpression('extractmsec(t)',ms);
- end;
- procedure TTestBuiltins.TestFunctionencodedate;
- begin
- AssertExpression('encodedate(2008,10,11)',EncodeDate(2008,10,11));
- end;
- procedure TTestBuiltins.TestFunctionencodetime;
- begin
- AssertExpression('encodetime(14,10,11,0)',EncodeTime(14,10,11,0));
- end;
- procedure TTestBuiltins.TestFunctionencodedatetime;
- begin
- AssertExpression('encodedatetime(2008,12,13,14,10,11,0)',EncodeDate(2008,12,13)+EncodeTime(14,10,11,0));
- end;
- procedure TTestBuiltins.TestFunctionshortdayname;
- begin
- AssertExpression('shortdayname(1)',ShortDayNames[1]);
- AssertExpression('shortdayname(7)',ShortDayNames[7]);
- end;
- procedure TTestBuiltins.TestFunctionshortmonthname;
- begin
- AssertExpression('shortmonthname(1)',ShortMonthNames[1]);
- AssertExpression('shortmonthname(12)',ShortMonthNames[12]);
- end;
- procedure TTestBuiltins.TestFunctionlongdayname;
- begin
- AssertExpression('longdayname(1)',longDayNames[1]);
- AssertExpression('longdayname(7)',longDayNames[7]);
- end;
- procedure TTestBuiltins.TestFunctionlongmonthname;
- begin
- AssertExpression('longmonthname(1)',longMonthNames[1]);
- AssertExpression('longmonthname(12)',longMonthNames[12]);
- end;
- procedure TTestBuiltins.TestFunctionformatdatetime;
- begin
- AssertExpression('FormatDateTime(''cccc'',Date)',FormatDateTime('cccc',Date));
- end;
- procedure TTestBuiltins.TestFunctionshl;
- Var
- I : Int64;
- begin
- AssertExpression('shl(12,3)',12 shl 3);
- I:=12 shl 30;
- AssertExpression('shl(12,30)',I);
- end;
- procedure TTestBuiltins.TestFunctionshr;
- begin
- AssertExpression('shr(12,2)',12 shr 2);
- end;
- procedure TTestBuiltins.TestFunctionIFS;
- begin
- AssertExpression('ifs(true,''string1'',''string2'')','string1');
- AssertExpression('ifs(false,''string1'',''string2'')','string2');
- end;
- procedure TTestBuiltins.TestFunctionIFF;
- begin
- AssertExpression('iff(true,1.0,2.0)',1.0);
- AssertExpression('iff(false,1.0,2.0)',2.0);
- end;
- procedure TTestBuiltins.TestFunctionIFD;
- begin
- FP.Identifiers.AddDateTimeVariable('A',Date);
- FP.Identifiers.AddDateTimeVariable('B',Date-1);
- AssertExpression('ifd(true,A,B)',Date);
- AssertExpression('ifd(false,A,B)',Date-1);
- end;
- procedure TTestBuiltins.TestFunctionIFI;
- begin
- AssertExpression('ifi(true,1,2)',1);
- AssertExpression('ifi(false,1,2)',2);
- end;
- procedure TTestBuiltins.TestFunctioninttostr;
- begin
- AssertExpression('inttostr(2)','2');
- end;
- procedure TTestBuiltins.TestFunctionstrtoint;
- begin
- AssertExpression('strtoint(''2'')',2);
- end;
- procedure TTestBuiltins.TestFunctionstrtointdef;
- begin
- AssertExpression('strtointdef(''abc'',2)',2);
- end;
- procedure TTestBuiltins.TestFunctionfloattostr;
- begin
- AssertExpression('floattostr(1.23)',Floattostr(1.23));
- end;
- procedure TTestBuiltins.TestFunctionstrtofloat;
- Var
- S : String;
- begin
- S:='1.23';
- S[2]:=DecimalSeparator;
- AssertExpression('strtofloat('''+S+''')',1.23);
- end;
- procedure TTestBuiltins.TestFunctionstrtofloatdef;
- begin
- AssertExpression('strtofloatdef(''abc'',1.23)',1.23);
- end;
- procedure TTestBuiltins.TestFunctionbooltostr;
- begin
- AssertExpression('strtofloatdef(''abc'',1.23)',1.23);
- end;
- procedure TTestBuiltins.TestFunctionstrtobool;
- begin
- AssertExpression('strtobool(''0'')',false);
- end;
- procedure TTestBuiltins.TestFunctionstrtobooldef;
- begin
- AssertExpression('strtobooldef(''XYZ'',True)',True);
- end;
- procedure TTestBuiltins.TestFunctiondatetostr;
- begin
- FP.Identifiers.AddDateTimeVariable('A',Date);
- AssertExpression('DateToStr(A)',DateToStr(Date));
- end;
- procedure TTestBuiltins.TestFunctiontimetostr;
- Var
- T : TDateTime;
- begin
- T:=Time;
- FP.Identifiers.AddDateTimeVariable('A',T);
- AssertExpression('TimeToStr(A)',TimeToStr(T));
- end;
- procedure TTestBuiltins.TestFunctionstrtodate;
- begin
- FP.Identifiers.AddStringVariable('S',DateToStr(Date));
- AssertExpression('StrToDate(S)',Date);
- end;
- procedure TTestBuiltins.TestFunctionstrtodatedef;
- begin
- FP.Identifiers.AddDateTimeVariable('A',Date);
- AssertExpression('StrToDateDef(''S'',A)',Date);
- end;
- procedure TTestBuiltins.TestFunctionstrtotime;
- Var
- T : TDateTime;
- begin
- T:=Time;
- FP.Identifiers.AddStringVariable('S',TimeToStr(T));
- AssertExpression('StrToTime(S)',T);
- end;
- procedure TTestBuiltins.TestFunctionstrtotimedef;
- Var
- T : TDateTime;
- begin
- T:=Time;
- FP.Identifiers.AddDateTimeVariable('S',T);
- AssertExpression('StrToTimeDef(''q'',S)',T);
- end;
- procedure TTestBuiltins.TestFunctionstrtodatetime;
- Var
- T : TDateTime;
- S : String;
- begin
- T:=Now;
- S:=DateTimetostr(T);
- AssertExpression('StrToDateTime('''+S+''')',T);
- end;
- procedure TTestBuiltins.TestFunctionstrtodatetimedef;
- Var
- T : TDateTime;
- S : String;
- begin
- T:=Now;
- S:=DateTimetostr(T);
- FP.Identifiers.AddDateTimeVariable('S',T);
- AssertExpression('StrToDateTimeDef('''+S+''',S)',T);
- end;
- { TTestNotNode }
- procedure TTestNotNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestNotNode.TestCreateInteger;
- begin
- FN:=TFPNotNode.Create(CreateIntNode(3));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',Not(Int64(3)),FN.NodeValue.ResInteger);
- end;
- procedure TTestNotNode.TestCreateBoolean;
- begin
- FN:=TFPNotNode.Create(CreateBoolNode(True));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtBoolean,FN.NodeType);
- AssertEquals('Correct result',False,FN.NodeValue.ResBoolean);
- end;
- procedure TTestNotNode.TestCreateString;
- begin
- FN:=TFPNotNode.Create(CreateStringNode('True'));
- AssertNodeNotOK('String node type',FN);
- end;
- procedure TTestNotNode.TestCreateFloat;
- begin
- FN:=TFPNotNode.Create(CreateFloatNode(1.23));
- AssertNodeNotOK('String node type',FN);
- end;
- procedure TTestNotNode.TestCreateDateTime;
- begin
- FN:=TFPNotNode.Create(CreateDateTimeNode(Now));
- AssertNodeNotOK('String node type',FN);
- end;
- procedure TTestNotNode.TestDestroy;
- begin
- FN:=TFPNotNode.Create(TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for operand',1,self.FDestroyCalled)
- end;
- { TTestIfOperation }
- procedure TTestIfOperation.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestIfOperation.TestCreateInteger;
- begin
- FN:=TIfOperation.Create(CreateIntNode(1),CreateIntNode(2),CreateIntNode(3));
- AssertNodeNotOK('First argument wrong',FN);
- end;
- procedure TTestIfOperation.TestCreateBoolean;
- begin
- FN:=TIfOperation.Create(CreateBoolNode(True),CreateIntNode(2),CreateIntNode(3));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',2,FN.NodeValue.ResInteger);
- end;
- procedure TTestIfOperation.TestCreateBoolean2;
- begin
- FN:=TIfOperation.Create(CreateBoolNode(False),CreateIntNode(2),CreateIntNode(3));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
- end;
- procedure TTestIfOperation.TestCreateBooleanInteger;
- begin
- FN:=TIfOperation.Create(CreateBoolNode(False),CreateIntNode(2),CreateBoolNode(False));
- AssertNodeNotOK('Arguments differ in type',FN);
- end;
- procedure TTestIfOperation.TestCreateBooleanInteger2;
- begin
- FN:=TIfOperation.Create(CreateBoolNode(True),CreateIntNode(2),CreateIntNode(3));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',2,FN.NodeValue.ResInteger);
- end;
- procedure TTestIfOperation.TestCreateBooleanString;
- begin
- FN:=TIfOperation.Create(CreateBoolNode(True),CreateStringNode('2'),CreateStringNode('3'));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','2',FN.NodeValue.ResString);
- end;
- procedure TTestIfOperation.TestCreateBooleanString2;
- begin
- FN:=TIfOperation.Create(CreateBoolNode(False),CreateStringNode('2'),CreateStringNode('3'));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','3',FN.NodeValue.ResString);
- end;
- procedure TTestIfOperation.TestCreateBooleanDateTime;
- begin
- FN:=TIfOperation.Create(CreateBoolNode(True),CreateDateTimeNode(Date),CreateDateTimeNode(Date-1));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtDateTime,FN.NodeType);
- AssertEquals('Correct result',Date,FN.NodeValue.ResDateTime);
- end;
- procedure TTestIfOperation.TestCreateBooleanDateTime2;
- begin
- FN:=TIfOperation.Create(CreateBoolNode(False),CreateDateTimeNode(Date),CreateDateTimeNode(Date-1));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtDateTime,FN.NodeType);
- AssertEquals('Correct result',Date-1,FN.NodeValue.ResDateTime);
- end;
- procedure TTestIfOperation.TestCreateString;
- begin
- FN:=TIfOperation.Create(CreateStringNode('1'),CreateIntNode(2),CreateIntNode(3));
- AssertNodeNotOK('First argument wrong',FN);
- end;
- procedure TTestIfOperation.TestCreateFloat;
- begin
- FN:=TIfOperation.Create(CreateFloatNode(2.0),CreateIntNode(2),CreateIntNode(3));
- AssertNodeNotOK('First argument wrong',FN);
- end;
- procedure TTestIfOperation.TestCreateDateTime;
- begin
- FN:=TIfOperation.Create(CreateDateTimeNode(Date),CreateIntNode(2),CreateIntNode(3));
- AssertNodeNotOK('First argument wrong',FN);
- end;
- procedure TTestIfOperation.TestDestroy;
- begin
- FN:=TIfOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for operand',3,self.FDestroyCalled)
- end;
- { TTestCaseOperation }
- function TTestCaseOperation.CreateArgs(
- Args: array of const): TExprArgumentArray;
- Var
- I : Integer;
- begin
- SetLength(Result,High(Args)-Low(Args)+1);
- For I:=Low(Args) to High(Args) do
- Result[I]:=Args[i].VObject as TFPExprNode;
- end;
- procedure TTestCaseOperation.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestCaseOperation.TestCreateOne;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False)]));
- AssertNodeNotOK('Too little arguments',FN);
- end;
- procedure TTestCaseOperation.TestCreateTwo;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False)]));
- AssertNodeNotOK('Too little arguments',FN);
- end;
- procedure TTestCaseOperation.TestCreateThree;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False),CreateBoolNode(False)]));
- AssertNodeNotOK('Too little arguments',FN);
- end;
- procedure TTestCaseOperation.TestCreateOdd;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False),
- CreateBoolNode(False),CreateBoolNode(False),
- CreateBoolNode(False)]));
- AssertNodeNotOK('Odd number of arguments',FN);
- end;
- procedure TTestCaseOperation.TestCreateNoExpression;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),
- CreateBoolNode(False),
- TFPBinaryOrOperation.Create(CreateBoolNode(False),CreateBoolNode(False)),
- CreateBoolNode(False)]));
- AssertNodeNotOK('Label is not a constant expression',FN);
- end;
- procedure TTestCaseOperation.TestCreateWrongLabel;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False),
- CreateIntNode(1),CreateBoolNode(False),
- CreateBoolNode(True),CreateBoolNode(False)]));
- AssertNodeNotOK('Wrong label',FN);
- end;
- procedure TTestCaseOperation.TestCreateWrongValue;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False),
- CreateIntNode(1),CreateBoolNode(False),
- CreateIntNode(2),CreateIntNode(1)]));
- AssertNodeNotOK('Wrong value',FN);
- end;
- procedure TTestCaseOperation.TestIntegerTag;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateStringNode('many'),
- CreateIntNode(1),CreateStringNode('one'),
- CreateIntNode(2),CreateStringNode('two')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','one',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestIntegerTagDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateStringNode('many'),
- CreateIntNode(1),CreateStringNode('one'),
- CreateIntNode(2),CreateStringNode('two')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','many',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestStringTag;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateStringNode('one'),CreateIntNode(3),
- CreateStringNode('one'),CreateIntNode(1),
- CreateStringNode('two'),CreateIntNode(2)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',1,FN.NodeValue.ResInteger);
- end;
- procedure TTestCaseOperation.TestStringTagDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateStringNode('many'),CreateIntNode(3),
- CreateStringNode('one'),CreateIntNode(1),
- CreateStringNode('two'),CreateIntNode(2)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
- end;
- procedure TTestCaseOperation.TestFloatTag;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateFloatNode(1.0),CreateStringNode('many'),
- CreateFloatNode(1.0),CreateStringNode('one'),
- CreateFloatNode(2.0),CreateStringNode('two')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','one',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestFloatTagDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateFloatNode(3.0),CreateStringNode('many'),
- CreateFloatNode(1.0),CreateStringNode('one'),
- CreateFloatNode(2.0),CreateStringNode('two')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','many',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestBooleanTag;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(True),CreateStringNode('unknown'),
- CreateBoolNode(True),CreateStringNode('one'),
- CreateBoolNode(False),CreateStringNode('two')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','one',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestBooleanTagDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(True),CreateStringNode('unknown'),
- CreateBoolNode(False),CreateStringNode('two')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','unknown',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestDateTimeTag;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateDateTimeNode(Date),CreateStringNode('later'),
- CreateDateTimeNode(Date),CreateStringNode('today'),
- CreateDateTimeNode(Date+1),CreateStringNode('tomorrow')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','today',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestDateTimeTagDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateDateTimeNode(Date+2),CreateStringNode('later'),
- CreateDateTimeNode(Date),CreateStringNode('today'),
- CreateDateTimeNode(Date+1),CreateStringNode('tomorrow')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','later',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestIntegerValue;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateIntNode(0),
- CreateIntNode(1),CreateIntNode(-1),
- CreateIntNode(2),CreateIntNode(-2)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',-1,FN.NodeValue.ResInteger);
- end;
- procedure TTestCaseOperation.TestIntegerValueDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateIntNode(0),
- CreateIntNode(1),CreateIntNode(-1),
- CreateIntNode(2),CreateIntNode(-2)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',0,FN.NodeValue.ResInteger);
- end;
- procedure TTestCaseOperation.TestStringValue;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateStringNode('many'),
- CreateIntNode(1),CreateStringNode('one'),
- CreateIntNode(2),CreateStringNode('two')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','one',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestStringValueDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateStringNode('many'),
- CreateIntNode(1),CreateStringNode('one'),
- CreateIntNode(2),CreateStringNode('two')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','many',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestFloatValue;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateFloatNode(0.0),
- CreateIntNode(1),CreateFloatNode(2.0),
- CreateIntNode(2),CreateFloatNode(1.0)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtFloat,FN.NodeType);
- AssertEquals('Correct result',2.0,FN.NodeValue.ResFloat);
- end;
- procedure TTestCaseOperation.TestFloatValueDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateFloatNode(0.0),
- CreateIntNode(1),CreateFloatNode(2.0),
- CreateIntNode(2),CreateFloatNode(1.0)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtFloat,FN.NodeType);
- AssertEquals('Correct result',0.0,FN.NodeValue.ResFloat);
- end;
- procedure TTestCaseOperation.TestBooleanValue;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False),
- CreateIntNode(1),CreateBoolNode(True),
- CreateIntNode(2),CreateBoolNode(False)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtBoolean,FN.NodeType);
- AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
- end;
- procedure TTestCaseOperation.TestBooleanValueDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateBoolNode(False),
- CreateIntNode(1),CreateBoolNode(True),
- CreateIntNode(2),CreateBoolNode(False)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtBoolean,FN.NodeType);
- AssertEquals('Correct result',False,FN.NodeValue.ResBoolean);
- end;
- procedure TTestCaseOperation.TestDateTimeValue;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateDateTimeNode(Date+1),
- CreateIntNode(1),CreateDateTimeNode(Date),
- CreateIntNode(2),CreateDateTimeNode(Date-1)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtDateTime,FN.NodeType);
- AssertEquals('Correct result',Date,FN.NodeValue.ResDateTime);
- end;
- procedure TTestCaseOperation.TestDateTimeValueDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateDateTimeNode(Date+1),
- CreateIntNode(1),CreateDateTimeNode(Date),
- CreateIntNode(2),CreateDateTimeNode(Date-1)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtDateTime,FN.NodeType);
- AssertEquals('Correct result',Date+1,FN.NodeValue.ResDateTime);
- end;
- procedure TTestCaseOperation.TestDestroy;
- begin
- FN:=TCaseOperation.Create(CreateArgs([TMyDestroyNode.CreateTest(Self),
- TMyDestroyNode.CreateTest(Self),
- TMyDestroyNode.CreateTest(Self),
- TMyDestroyNode.CreateTest(Self)]));
- FreeAndNil(FN);
- AssertEquals('Destroy called for operand',4,self.FDestroyCalled)
- end;
- initialization
- RegisterTests([TTestExpressionScanner, TTestDestroyNode,
- TTestConstExprNode,TTestNegateExprNode,
- TTestBinaryAndNode,TTestBinaryOrNode,TTestBinaryXOrNode,
- TTestNotNode,TTestEqualNode,TTestUnEqualNode,
- TTestIfOperation,TTestCaseOperation,
- TTestLessThanNode,TTestLessThanEqualNode,
- TTestLargerThanNode,TTestLargerThanEqualNode,
- TTestAddNode,TTestSubtractNode,
- TTestMultiplyNode,TTestDivideNode,
- TTestIntToFloatNode,TTestIntToDateTimeNode,
- TTestFloatToDateTimeNode,
- TTestParserExpressions, TTestParserBooleanOperations,
- TTestParserOperands, TTestParserTypeMatch,
- TTestParserVariables,TTestParserFunctions,
- TTestBuiltinsManager,TTestBuiltins]);
- end.
|