testexprpars.pp 172 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000
  1. {
  2. This file is part of the Free Component Library (FCL)
  3. Copyright (c) 2008 Michael Van Canneyt.
  4. File which provides examples and all testcases for the expression parser.
  5. It needs fcl-fpcunit to work.
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. unit testexprpars;
  13. {$mode objfpc}{$H+}
  14. interface
  15. uses
  16. Classes, SysUtils, fpcunit, testutils, testregistry,fpexprpars;
  17. type
  18. { TTestExpressionScanner }
  19. TTestExpressionScanner = class(TTestCase)
  20. Private
  21. FP : TFPExpressionScanner;
  22. FInvalidString : String;
  23. procedure DoInvalidNumber(AString: String);
  24. procedure TestInvalidNumber;
  25. protected
  26. procedure SetUp; override;
  27. procedure TearDown; override;
  28. Procedure AssertEquals(Msg : string; AExpected, AActual : TTokenType); overload;
  29. Procedure TestString(Const AString : String; AToken : TTokenType);
  30. published
  31. procedure TestCreate;
  32. procedure TestSetSource;
  33. Procedure TestWhiteSpace;
  34. Procedure TestTokens;
  35. Procedure TestNumber;
  36. Procedure TestInvalidCharacter;
  37. Procedure TestUnterminatedString;
  38. Procedure TestQuotesInString;
  39. end;
  40. { TMyFPExpressionParser }
  41. TMyFPExpressionParser = Class(TFPExpressionParser)
  42. Public
  43. Procedure BuildHashList;
  44. Property ExprNode;
  45. Property Scanner;
  46. Property Dirty;
  47. end;
  48. { TTestBaseParser }
  49. TTestBaseParser = class(TTestCase)
  50. private
  51. procedure DoCheck;
  52. Protected
  53. FDestroyCalled : Integer;
  54. FCheckNode : TFPExprNode;
  55. procedure AssertNodeType(Msg: String; AClass: TClass; ANode: TFPExprNode); overload;
  56. procedure AssertEquals(Msg: String; AResultType : TResultType; ANode: TFPExprNode); overload;
  57. procedure AssertEquals(Msg: String; AExpected,AActual : TResultType); overload;
  58. Function CreateBoolNode(ABoolean: Boolean) : TFPExprNode;
  59. Function CreateIntNode(AInteger: Integer) : TFPExprNode;
  60. Function CreateFloatNode(AFloat : TExprFloat) : TFPExprNode;
  61. Function CreateStringNode(Astring : String) : TFPExprNode;
  62. Function CreateDateTimeNode(ADateTime : TDateTime) : TFPExprNode;
  63. Procedure AssertNodeOK(FN : TFPExprNode);
  64. Procedure AssertNodeNotOK(Const Msg : String; FN : TFPExprNode);
  65. Procedure Setup; override;
  66. end;
  67. { TMyDestroyNode }
  68. TMyDestroyNode = Class(TFPConstExpression)
  69. FTest : TTestBaseParser;
  70. Public
  71. Constructor CreateTest(ATest : TTestBaseParser);
  72. Destructor Destroy; override;
  73. end;
  74. { TTestDestroyNode }
  75. TTestDestroyNode = Class(TTestBaseParser)
  76. Published
  77. Procedure TestDestroy;
  78. end;
  79. { TTestConstExprNode }
  80. TTestConstExprNode = Class(TTestBaseParser)
  81. private
  82. FN : TFPConstExpression;
  83. Protected
  84. Procedure TearDown; override;
  85. Published
  86. Procedure TestCreateInteger;
  87. procedure TestCreateFloat;
  88. procedure TestCreateBoolean;
  89. procedure TestCreateDateTime;
  90. procedure TestCreateString;
  91. end;
  92. { TTestNegateExprNode }
  93. TTestNegateExprNode = Class(TTestBaseParser)
  94. Private
  95. FN : TFPNegateOperation;
  96. Protected
  97. Procedure TearDown; override;
  98. Published
  99. Procedure TestCreateInteger;
  100. procedure TestCreateFloat;
  101. procedure TestCreateOther1;
  102. procedure TestCreateOther2;
  103. Procedure TestDestroy;
  104. end;
  105. { TTestBinaryAndNode }
  106. TTestBinaryAndNode = Class(TTestBaseParser)
  107. Private
  108. FN : TFPBinaryAndOperation;
  109. Protected
  110. Procedure TearDown; override;
  111. Published
  112. Procedure TestCreateInteger;
  113. procedure TestCreateBoolean;
  114. procedure TestCreateBooleanInteger;
  115. procedure TestCreateString;
  116. procedure TestCreateFloat;
  117. procedure TestCreateDateTime;
  118. Procedure TestDestroy;
  119. end;
  120. { TTestNotNode }
  121. TTestNotNode = Class(TTestBaseParser)
  122. Private
  123. FN : TFPNotNode;
  124. Protected
  125. Procedure TearDown; override;
  126. Published
  127. Procedure TestCreateInteger;
  128. procedure TestCreateBoolean;
  129. procedure TestCreateString;
  130. procedure TestCreateFloat;
  131. procedure TestCreateDateTime;
  132. Procedure TestDestroy;
  133. end;
  134. { TTestBinaryOrNode }
  135. TTestBinaryOrNode = Class(TTestBaseParser)
  136. Private
  137. FN : TFPBinaryOrOperation;
  138. Protected
  139. Procedure TearDown; override;
  140. Published
  141. Procedure TestCreateInteger;
  142. procedure TestCreateBoolean;
  143. procedure TestCreateBooleanInteger;
  144. procedure TestCreateString;
  145. procedure TestCreateFloat;
  146. procedure TestCreateDateTime;
  147. Procedure TestDestroy;
  148. end;
  149. { TTestBinaryXOrNode }
  150. TTestBinaryXOrNode = Class(TTestBaseParser)
  151. Private
  152. FN : TFPBinaryXOrOperation;
  153. Protected
  154. Procedure TearDown; override;
  155. Published
  156. Procedure TestCreateInteger;
  157. procedure TestCreateBoolean;
  158. procedure TestCreateBooleanInteger;
  159. procedure TestCreateString;
  160. procedure TestCreateFloat;
  161. procedure TestCreateDateTime;
  162. Procedure TestDestroy;
  163. end;
  164. { TTestIfOperation }
  165. TTestIfOperation = Class(TTestBaseParser)
  166. Private
  167. FN : TIfOperation;
  168. Protected
  169. Procedure TearDown; override;
  170. Published
  171. Procedure TestCreateInteger;
  172. procedure TestCreateBoolean;
  173. procedure TestCreateBoolean2;
  174. procedure TestCreateString;
  175. procedure TestCreateFloat;
  176. procedure TestCreateDateTime;
  177. procedure TestCreateBooleanInteger;
  178. procedure TestCreateBooleanInteger2;
  179. procedure TestCreateBooleanString;
  180. procedure TestCreateBooleanString2;
  181. procedure TestCreateBooleanDateTime;
  182. procedure TestCreateBooleanDateTime2;
  183. Procedure TestDestroy;
  184. end;
  185. { TTestCaseOperation }
  186. TTestCaseOperation = Class(TTestBaseParser)
  187. Private
  188. FN : TCaseOperation;
  189. Protected
  190. Function CreateArgs(Args : Array of Const) : TExprArgumentArray;
  191. Procedure TearDown; override;
  192. Published
  193. Procedure TestCreateOne;
  194. procedure TestCreateTwo;
  195. procedure TestCreateThree;
  196. procedure TestCreateOdd;
  197. procedure TestCreateNoExpression;
  198. procedure TestCreateWrongLabel;
  199. procedure TestCreateWrongValue;
  200. procedure TestIntegerTag;
  201. procedure TestIntegerTagDefault;
  202. procedure TestStringTag;
  203. procedure TestStringTagDefault;
  204. procedure TestFloatTag;
  205. procedure TestFloatTagDefault;
  206. procedure TestBooleanTag;
  207. procedure TestBooleanTagDefault;
  208. procedure TestDateTimeTag;
  209. procedure TestDateTimeTagDefault;
  210. procedure TestIntegerValue;
  211. procedure TestIntegerValueDefault;
  212. procedure TestStringValue;
  213. procedure TestStringValueDefault;
  214. procedure TestFloatValue;
  215. procedure TestFloatValueDefault;
  216. procedure TestBooleanValue;
  217. procedure TestBooleanValueDefault;
  218. procedure TestDateTimeValue;
  219. procedure TestDateTimeValueDefault;
  220. Procedure TestDestroy;
  221. end;
  222. { TTestBooleanNode }
  223. TTestBooleanNode = Class(TTestBaseParser)
  224. Protected
  225. Procedure TestNode(B : TFPBooleanResultOperation; AResult : Boolean);
  226. end;
  227. { TTestEqualNode }
  228. TTestEqualNode = Class(TTestBooleanNode)
  229. Private
  230. FN : TFPBooleanResultOperation;
  231. Protected
  232. Procedure TearDown; override;
  233. Class Function NodeClass : TFPBooleanResultOperationClass; virtual;
  234. Class Function ExpectedResult : Boolean; virtual;
  235. Class Function OperatorString : String; virtual;
  236. Published
  237. Procedure TestCreateIntegerEqual;
  238. procedure TestCreateIntegerUnEqual;
  239. Procedure TestCreateFloatEqual;
  240. procedure TestCreateFloatUnEqual;
  241. Procedure TestCreateStringEqual;
  242. procedure TestCreateStringUnEqual;
  243. Procedure TestCreateBooleanEqual;
  244. procedure TestCreateBooleanUnEqual;
  245. Procedure TestCreateDateTimeEqual;
  246. procedure TestCreateDateTimeUnEqual;
  247. Procedure TestDestroy;
  248. Procedure TestWrongTypes1;
  249. procedure TestWrongTypes2;
  250. procedure TestWrongTypes3;
  251. procedure TestWrongTypes4;
  252. procedure TestWrongTypes5;
  253. Procedure TestAsString;
  254. end;
  255. { TTestUnEqualNode }
  256. TTestUnEqualNode = Class(TTestEqualNode)
  257. Protected
  258. Class Function NodeClass : TFPBooleanResultOperationClass; override;
  259. Class Function ExpectedResult : Boolean; override;
  260. Class Function OperatorString : String; override;
  261. end;
  262. { TTestLessThanNode }
  263. TTestLessThanNode = Class(TTestBooleanNode)
  264. Private
  265. FN : TFPBooleanResultOperation;
  266. Protected
  267. Class Function NodeClass : TFPBooleanResultOperationClass; virtual;
  268. Class Function Larger : Boolean; virtual;
  269. Class Function AllowEqual : Boolean; virtual;
  270. Class Function OperatorString : String; virtual;
  271. Procedure TearDown; override;
  272. Published
  273. Procedure TestCreateIntegerEqual;
  274. procedure TestCreateIntegerSmaller;
  275. procedure TestCreateIntegerLarger;
  276. Procedure TestCreateFloatEqual;
  277. procedure TestCreateFloatSmaller;
  278. procedure TestCreateFloatLarger;
  279. Procedure TestCreateDateTimeEqual;
  280. procedure TestCreateDateTimeSmaller;
  281. procedure TestCreateDateTimeLarger;
  282. Procedure TestCreateStringEqual;
  283. procedure TestCreateStringSmaller;
  284. procedure TestCreateStringLarger;
  285. Procedure TestWrongTypes1;
  286. procedure TestWrongTypes2;
  287. procedure TestWrongTypes3;
  288. procedure TestWrongTypes4;
  289. procedure TestWrongTypes5;
  290. Procedure TestNoBoolean1;
  291. Procedure TestNoBoolean2;
  292. Procedure TestNoBoolean3;
  293. Procedure TestAsString;
  294. end;
  295. { TTestLessThanEqualNode }
  296. TTestLessThanEqualNode = Class(TTestLessThanNode)
  297. protected
  298. Class Function NodeClass : TFPBooleanResultOperationClass; override;
  299. Class Function AllowEqual : Boolean; override;
  300. Class Function OperatorString : String; override;
  301. end;
  302. { TTestLargerThanNode }
  303. TTestLargerThanNode = Class(TTestLessThanNode)
  304. protected
  305. Class Function NodeClass : TFPBooleanResultOperationClass; override;
  306. Class Function Larger : Boolean; override;
  307. Class Function OperatorString : String; override;
  308. end;
  309. { TTestLargerThanEqualNode }
  310. TTestLargerThanEqualNode = Class(TTestLargerThanNode)
  311. protected
  312. Class Function NodeClass : TFPBooleanResultOperationClass; override;
  313. Class Function AllowEqual : Boolean; override;
  314. Class Function OperatorString : String; override;
  315. end;
  316. { TTestAddNode }
  317. TTestAddNode = Class(TTestBaseParser)
  318. Private
  319. FN : TFPAddOperation;
  320. Protected
  321. Procedure TearDown; override;
  322. Published
  323. Procedure TestCreateInteger;
  324. Procedure TestCreateFloat;
  325. Procedure TestCreateDateTime;
  326. Procedure TestCreateString;
  327. Procedure TestCreateBoolean;
  328. Procedure TestDestroy;
  329. Procedure TestAsString;
  330. end;
  331. { TTestSubtractNode }
  332. TTestSubtractNode = Class(TTestBaseParser)
  333. Private
  334. FN : TFPSubtractOperation;
  335. Protected
  336. Procedure TearDown; override;
  337. Published
  338. Procedure TestCreateInteger;
  339. Procedure TestCreateFloat;
  340. Procedure TestCreateDateTime;
  341. Procedure TestCreateString;
  342. Procedure TestCreateBoolean;
  343. Procedure TestDestroy;
  344. Procedure TestAsString;
  345. end;
  346. { TTestMultiplyNode }
  347. TTestMultiplyNode = Class(TTestBaseParser)
  348. Private
  349. FN : TFPMultiplyOperation;
  350. Protected
  351. Procedure TearDown; override;
  352. Published
  353. Procedure TestCreateInteger;
  354. Procedure TestCreateFloat;
  355. Procedure TestCreateDateTime;
  356. Procedure TestCreateString;
  357. Procedure TestCreateBoolean;
  358. Procedure TestDestroy;
  359. Procedure TestAsString;
  360. end;
  361. { TTestDivideNode }
  362. TTestDivideNode = Class(TTestBaseParser)
  363. Private
  364. FN : TFPDivideOperation;
  365. Protected
  366. Procedure TearDown; override;
  367. Published
  368. Procedure TestCreateInteger;
  369. Procedure TestCreateFloat;
  370. Procedure TestCreateDateTime;
  371. Procedure TestCreateString;
  372. Procedure TestCreateBoolean;
  373. Procedure TestDestroy;
  374. Procedure TestAsString;
  375. end;
  376. { TTestIntToFloatNode }
  377. TTestIntToFloatNode = Class(TTestBaseParser)
  378. Private
  379. FN : TIntToFloatNode;
  380. Protected
  381. Procedure TearDown; override;
  382. Published
  383. Procedure TestCreateInteger;
  384. Procedure TestCreateFloat;
  385. Procedure TestDestroy;
  386. Procedure TestAsString;
  387. end;
  388. { TTestIntToDateTimeNode }
  389. TTestIntToDateTimeNode = Class(TTestBaseParser)
  390. Private
  391. FN : TIntToDateTimeNode;
  392. Protected
  393. Procedure TearDown; override;
  394. Published
  395. Procedure TestCreateInteger;
  396. Procedure TestCreateFloat;
  397. Procedure TestDestroy;
  398. Procedure TestAsString;
  399. end;
  400. { TTestFloatToDateTimeNode }
  401. TTestFloatToDateTimeNode = Class(TTestBaseParser)
  402. Private
  403. FN : TFloatToDateTimeNode;
  404. Protected
  405. Procedure TearDown; override;
  406. Published
  407. Procedure TestCreateInteger;
  408. Procedure TestCreateFloat;
  409. Procedure TestDestroy;
  410. Procedure TestAsString;
  411. end;
  412. { TTestExpressionParser }
  413. TTestExpressionParser = class(TTestBaseParser)
  414. Private
  415. FP : TMyFPExpressionParser;
  416. FTestExpr : String;
  417. procedure DoAddInteger(var Result: TFPExpressionResult;
  418. const Args: TExprParameterArray);
  419. procedure DoDeleteString(var Result: TFPExpressionResult;
  420. const Args: TExprParameterArray);
  421. procedure DoEchoBoolean(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
  422. procedure DoEchoDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
  423. procedure DoEchoFloat(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
  424. procedure DoEchoInteger(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
  425. procedure DoEchoString(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
  426. procedure DoGetDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
  427. procedure DoParse;
  428. procedure TestParser(AExpr: string);
  429. protected
  430. procedure SetUp; override;
  431. procedure TearDown; override;
  432. Procedure AssertLeftRight(N : TFPExprNode; LeftClass,RightClass : TClass);
  433. Procedure AssertOperand(N : TFPExprNode; OperandClass : TClass);
  434. Procedure AssertResultType(RT : TResultType);
  435. Procedure AssertResult(F : TExprFloat);
  436. Procedure AssertResult(I : Int64);
  437. Procedure AssertResult(S : String);
  438. Procedure AssertResult(B : Boolean);
  439. Procedure AssertDateTimeResult(D : TDateTime);
  440. end;
  441. { TTestParserExpressions }
  442. TTestParserExpressions = Class(TTestExpressionParser)
  443. private
  444. Published
  445. Procedure TestCreate;
  446. Procedure TestSimpleNodeFloat;
  447. procedure TestSimpleNodeInteger;
  448. procedure TestSimpleNodeBooleanTrue;
  449. procedure TestSimpleNodeBooleanFalse;
  450. procedure TestSimpleNodeString;
  451. procedure TestSimpleNegativeInteger;
  452. procedure TestSimpleNegativeFloat;
  453. procedure TestSimpleAddInteger;
  454. procedure TestSimpleAddFloat;
  455. procedure TestSimpleAddIntegerFloat;
  456. procedure TestSimpleAddFloatInteger;
  457. procedure TestSimpleAddString;
  458. procedure TestSimpleSubtractInteger;
  459. procedure TestSimpleSubtractFloat;
  460. procedure TestSimpleSubtractIntegerFloat;
  461. procedure TestSimpleSubtractFloatInteger;
  462. procedure TestSimpleMultiplyFloat;
  463. procedure TestSimpleMultiplyInteger;
  464. procedure TestSimpleDivideFloat;
  465. procedure TestSimpleDivideInteger;
  466. procedure TestSimpleBooleanAnd;
  467. procedure TestSimpleIntegerAnd;
  468. procedure TestSimpleBooleanOr;
  469. procedure TestSimpleIntegerOr;
  470. procedure TestSimpleBooleanNot;
  471. procedure TestSimpleIntegerNot;
  472. procedure TestSimpleAddSeries;
  473. procedure TestSimpleMultiplySeries;
  474. procedure TestSimpleAddMultiplySeries;
  475. procedure TestSimpleAddAndSeries;
  476. procedure TestSimpleAddOrSeries;
  477. procedure TestSimpleOrNotSeries;
  478. procedure TestSimpleAndNotSeries;
  479. procedure TestDoubleAddMultiplySeries;
  480. procedure TestDoubleSubtractMultiplySeries;
  481. procedure TestSimpleIfInteger;
  482. procedure TestSimpleIfString;
  483. procedure TestSimpleIfFloat;
  484. procedure TestSimpleIfBoolean;
  485. procedure TestSimpleIfDateTime;
  486. procedure TestSimpleIfOperation;
  487. procedure TestSimpleBrackets;
  488. procedure TestSimpleBrackets2;
  489. procedure TestSimpleBracketsLeft;
  490. procedure TestSimpleBracketsRight;
  491. procedure TestSimpleBracketsDouble;
  492. end;
  493. TTestParserBooleanOperations = Class(TTestExpressionParser)
  494. Published
  495. Procedure TestEqualInteger;
  496. procedure TestUnEqualInteger;
  497. procedure TestEqualFloat;
  498. procedure TestEqualFloat2;
  499. procedure TestUnEqualFloat;
  500. procedure TestEqualString;
  501. procedure TestEqualString2;
  502. procedure TestUnEqualString;
  503. procedure TestUnEqualString2;
  504. Procedure TestEqualBoolean;
  505. procedure TestUnEqualBoolean;
  506. procedure TestLessThanInteger;
  507. procedure TestLessThanInteger2;
  508. procedure TestLessThanEqualInteger;
  509. procedure TestLessThanEqualInteger2;
  510. procedure TestLessThanFloat;
  511. procedure TestLessThanFloat2;
  512. procedure TestLessThanEqualFloat;
  513. procedure TestLessThanEqualFloat2;
  514. procedure TestLessThanString;
  515. procedure TestLessThanString2;
  516. procedure TestLessThanEqualString;
  517. procedure TestLessThanEqualString2;
  518. procedure TestGreaterThanInteger;
  519. procedure TestGreaterThanInteger2;
  520. procedure TestGreaterThanEqualInteger;
  521. procedure TestGreaterThanEqualInteger2;
  522. procedure TestGreaterThanFloat;
  523. procedure TestGreaterThanFloat2;
  524. procedure TestGreaterThanEqualFloat;
  525. procedure TestGreaterThanEqualFloat2;
  526. procedure TestGreaterThanString;
  527. procedure TestGreaterThanString2;
  528. procedure TestGreaterThanEqualString;
  529. procedure TestGreaterThanEqualString2;
  530. procedure EqualAndSeries;
  531. procedure EqualAndSeries2;
  532. procedure EqualOrSeries;
  533. procedure EqualOrSeries2;
  534. procedure UnEqualAndSeries;
  535. procedure UnEqualAndSeries2;
  536. procedure UnEqualOrSeries;
  537. procedure UnEqualOrSeries2;
  538. procedure LessThanAndSeries;
  539. procedure LessThanAndSeries2;
  540. procedure LessThanOrSeries;
  541. procedure LessThanOrSeries2;
  542. procedure GreaterThanAndSeries;
  543. procedure GreaterThanAndSeries2;
  544. procedure GreaterThanOrSeries;
  545. procedure GreaterThanOrSeries2;
  546. procedure LessThanEqualAndSeries;
  547. procedure LessThanEqualAndSeries2;
  548. procedure LessThanEqualOrSeries;
  549. procedure LessThanEqualOrSeries2;
  550. procedure GreaterThanEqualAndSeries;
  551. procedure GreaterThanEqualAndSeries2;
  552. procedure GreaterThanEqualOrSeries;
  553. procedure GreaterThanEqualOrSeries2;
  554. end;
  555. { TTestParserOperands }
  556. TTestParserOperands = Class(TTestExpressionParser)
  557. private
  558. Published
  559. Procedure MissingOperand1;
  560. procedure MissingOperand2;
  561. procedure MissingOperand3;
  562. procedure MissingOperand4;
  563. procedure MissingOperand5;
  564. procedure MissingOperand6;
  565. procedure MissingOperand7;
  566. procedure MissingOperand8;
  567. procedure MissingOperand9;
  568. procedure MissingOperand10;
  569. procedure MissingOperand11;
  570. procedure MissingOperand12;
  571. procedure MissingOperand13;
  572. procedure MissingOperand14;
  573. procedure MissingOperand15;
  574. procedure MissingOperand16;
  575. procedure MissingOperand17;
  576. procedure MissingOperand18;
  577. procedure MissingOperand19;
  578. procedure MissingOperand20;
  579. procedure MissingOperand21;
  580. procedure MissingBracket1;
  581. procedure MissingBracket2;
  582. procedure MissingBracket3;
  583. procedure MissingBracket4;
  584. procedure MissingBracket5;
  585. procedure MissingBracket6;
  586. procedure MissingBracket7;
  587. procedure MissingArgument1;
  588. procedure MissingArgument2;
  589. procedure MissingArgument3;
  590. procedure MissingArgument4;
  591. procedure MissingArgument5;
  592. procedure MissingArgument6;
  593. procedure MissingArgument7;
  594. end;
  595. { TTestParserTypeMatch }
  596. TTestParserTypeMatch = Class(TTestExpressionParser)
  597. Private
  598. Procedure AccessString;
  599. Procedure AccessInteger;
  600. Procedure AccessFloat;
  601. Procedure AccessDateTime;
  602. Procedure AccessBoolean;
  603. Published
  604. Procedure TestTypeMismatch1;
  605. procedure TestTypeMismatch2;
  606. procedure TestTypeMismatch3;
  607. procedure TestTypeMismatch4;
  608. procedure TestTypeMismatch5;
  609. procedure TestTypeMismatch6;
  610. procedure TestTypeMismatch7;
  611. procedure TestTypeMismatch8;
  612. procedure TestTypeMismatch9;
  613. procedure TestTypeMismatch10;
  614. procedure TestTypeMismatch11;
  615. procedure TestTypeMismatch12;
  616. procedure TestTypeMismatch13;
  617. procedure TestTypeMismatch14;
  618. procedure TestTypeMismatch15;
  619. procedure TestTypeMismatch16;
  620. procedure TestTypeMismatch17;
  621. procedure TestTypeMismatch18;
  622. procedure TestTypeMismatch19;
  623. procedure TestTypeMismatch20;
  624. procedure TestTypeMismatch21;
  625. procedure TestTypeMismatch22;
  626. procedure TestTypeMismatch23;
  627. procedure TestTypeMismatch24;
  628. end;
  629. { TTestParserVariables }
  630. TTestParserVariables = Class(TTestExpressionParser)
  631. private
  632. FAsWrongType : TResultType;
  633. procedure TestAccess(Skip: TResultType);
  634. Protected
  635. procedure AddVariabletwice;
  636. procedure UnknownVariable;
  637. Procedure ReadWrongType;
  638. procedure WriteWrongType;
  639. Procedure DoDummy(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
  640. Published
  641. Procedure TestVariableAssign;
  642. Procedure TestVariableAssignAgain;
  643. Procedure TestVariable1;
  644. procedure TestVariable2;
  645. procedure TestVariable3;
  646. procedure TestVariable4;
  647. procedure TestVariable5;
  648. procedure TestVariable6;
  649. procedure TestVariable7;
  650. procedure TestVariable8;
  651. procedure TestVariable9;
  652. procedure TestVariable10;
  653. procedure TestVariable11;
  654. procedure TestVariable12;
  655. procedure TestVariable13;
  656. procedure TestVariable14;
  657. procedure TestVariable15;
  658. procedure TestVariable16;
  659. procedure TestVariable17;
  660. procedure TestVariable18;
  661. procedure TestVariable19;
  662. procedure TestVariable20;
  663. procedure TestVariable21;
  664. procedure TestVariable22;
  665. procedure TestVariable23;
  666. procedure TestVariable24;
  667. procedure TestVariable25;
  668. procedure TestVariable26;
  669. procedure TestVariable27;
  670. procedure TestVariable28;
  671. procedure TestVariable29;
  672. procedure TestVariable30;
  673. end;
  674. { TTestParserFunctions }
  675. TTestParserFunctions = Class(TTestExpressionParser)
  676. private
  677. FAccessAs : TResultType;
  678. Procedure TryRead;
  679. procedure TryWrite;
  680. Published
  681. Procedure TestFunction1;
  682. procedure TestFunction2;
  683. procedure TestFunction3;
  684. procedure TestFunction4;
  685. procedure TestFunction5;
  686. procedure TestFunction6;
  687. procedure TestFunction7;
  688. procedure TestFunction8;
  689. procedure TestFunction9;
  690. procedure TestFunction10;
  691. procedure TestFunction11;
  692. procedure TestFunction12;
  693. procedure TestFunction13;
  694. procedure TestFunction14;
  695. procedure TestFunction15;
  696. procedure TestFunction16;
  697. procedure TestFunction17;
  698. procedure TestFunction18;
  699. procedure TestFunction19;
  700. procedure TestFunction20;
  701. procedure TestFunction21;
  702. procedure TestFunction22;
  703. procedure TestFunction23;
  704. procedure TestFunction24;
  705. procedure TestFunction25;
  706. procedure TestFunction26;
  707. procedure TestFunction27;
  708. procedure TestFunction28;
  709. procedure TestFunction29;
  710. end;
  711. { TTestBuiltinsManager }
  712. TTestBuiltinsManager = Class(TTestExpressionParser)
  713. private
  714. FM : TExprBuiltInManager;
  715. Protected
  716. procedure Setup; override;
  717. procedure Teardown; override;
  718. Published
  719. procedure TestCreate;
  720. procedure TestVariable1;
  721. procedure TestVariable2;
  722. procedure TestVariable3;
  723. procedure TestVariable4;
  724. procedure TestVariable5;
  725. procedure TestVariable6;
  726. procedure TestFunction1;
  727. procedure TestFunction2;
  728. end;
  729. TTestBuiltins = Class(TTestExpressionParser)
  730. private
  731. FM : TExprBuiltInManager;
  732. FExpr : String;
  733. Protected
  734. procedure Setup; override;
  735. procedure Teardown; override;
  736. Procedure SetExpression(Const AExpression : String);
  737. Procedure AssertVariable(Const ADefinition : String; AResultType : TResultType);
  738. Procedure AssertFunction(Const ADefinition,AResultType,ArgumentTypes : String; ACategory : TBuiltinCategory);
  739. procedure AssertExpression(Const AExpression : String; AResult : Int64);
  740. procedure AssertExpression(Const AExpression : String; Const AResult : String);
  741. procedure AssertExpression(Const AExpression : String; Const AResult : TExprFloat);
  742. procedure AssertExpression(Const AExpression : String; Const AResult : Boolean);
  743. procedure AssertDateTimeExpression(Const AExpression : String; Const AResult : TDateTime);
  744. Published
  745. procedure TestRegister;
  746. Procedure TestVariablepi;
  747. Procedure TestFunctioncos;
  748. Procedure TestFunctionsin;
  749. Procedure TestFunctionarctan;
  750. Procedure TestFunctionabs;
  751. Procedure TestFunctionsqr;
  752. Procedure TestFunctionsqrt;
  753. Procedure TestFunctionexp;
  754. Procedure TestFunctionln;
  755. Procedure TestFunctionlog;
  756. Procedure TestFunctionfrac;
  757. Procedure TestFunctionint;
  758. Procedure TestFunctionround;
  759. Procedure TestFunctiontrunc;
  760. Procedure TestFunctionlength;
  761. Procedure TestFunctioncopy;
  762. Procedure TestFunctiondelete;
  763. Procedure TestFunctionpos;
  764. Procedure TestFunctionlowercase;
  765. Procedure TestFunctionuppercase;
  766. Procedure TestFunctionstringreplace;
  767. Procedure TestFunctioncomparetext;
  768. Procedure TestFunctiondate;
  769. Procedure TestFunctiontime;
  770. Procedure TestFunctionnow;
  771. Procedure TestFunctiondayofweek;
  772. Procedure TestFunctionextractyear;
  773. Procedure TestFunctionextractmonth;
  774. Procedure TestFunctionextractday;
  775. Procedure TestFunctionextracthour;
  776. Procedure TestFunctionextractmin;
  777. Procedure TestFunctionextractsec;
  778. Procedure TestFunctionextractmsec;
  779. Procedure TestFunctionencodedate;
  780. Procedure TestFunctionencodetime;
  781. Procedure TestFunctionencodedatetime;
  782. Procedure TestFunctionshortdayname;
  783. Procedure TestFunctionshortmonthname;
  784. Procedure TestFunctionlongdayname;
  785. Procedure TestFunctionlongmonthname;
  786. Procedure TestFunctionformatdatetime;
  787. Procedure TestFunctionshl;
  788. Procedure TestFunctionshr;
  789. Procedure TestFunctionIFS;
  790. Procedure TestFunctionIFF;
  791. Procedure TestFunctionIFD;
  792. Procedure TestFunctionIFI;
  793. Procedure TestFunctioninttostr;
  794. Procedure TestFunctionstrtoint;
  795. Procedure TestFunctionstrtointdef;
  796. Procedure TestFunctionfloattostr;
  797. Procedure TestFunctionstrtofloat;
  798. Procedure TestFunctionstrtofloatdef;
  799. Procedure TestFunctionbooltostr;
  800. Procedure TestFunctionstrtobool;
  801. Procedure TestFunctionstrtobooldef;
  802. Procedure TestFunctiondatetostr;
  803. Procedure TestFunctiontimetostr;
  804. Procedure TestFunctionstrtodate;
  805. Procedure TestFunctionstrtodatedef;
  806. Procedure TestFunctionstrtotime;
  807. Procedure TestFunctionstrtotimedef;
  808. Procedure TestFunctionstrtodatetime;
  809. Procedure TestFunctionstrtodatetimedef;
  810. end;
  811. implementation
  812. uses typinfo;
  813. procedure TTestExpressionScanner.TestCreate;
  814. begin
  815. AssertEquals('Empty source','',FP.Source);
  816. AssertEquals('Pos is zero',0,FP.Pos);
  817. AssertEquals('CurrentChar is zero',#0,FP.CurrentChar);
  818. AssertEquals('Current token type is EOF',ttEOF,FP.TokenType);
  819. AssertEquals('Current token is empty','',FP.Token);
  820. end;
  821. procedure TTestExpressionScanner.TestSetSource;
  822. begin
  823. FP.Source:='Abc';
  824. FP.Source:='';
  825. AssertEquals('Empty source','',FP.Source);
  826. AssertEquals('Pos is zero',0,FP.Pos);
  827. AssertEquals('CurrentChar is zero',#0,FP.CurrentChar);
  828. AssertEquals('Current token type is EOF',ttEOF,FP.TokenType);
  829. AssertEquals('Current token is empty','',FP.Token);
  830. end;
  831. procedure TTestExpressionScanner.TestWhiteSpace;
  832. begin
  833. TestString(' ',ttEOF);
  834. end;
  835. procedure TTestExpressionScanner.TestTokens;
  836. Const
  837. TestStrings : Array[TTokenType] of String
  838. = ('+','-','<','>','=','/',
  839. '*','(',')','<=','>=',
  840. '<>','1','''abc''','abc',',','and',
  841. 'or','xor','true','false','not','if','case','');
  842. var
  843. t : TTokenType;
  844. begin
  845. For T:=Low(TTokenType) to High(TTokenType) do
  846. TestString(TestStrings[t],t);
  847. end;
  848. procedure TTestExpressionScanner.TestInvalidNumber;
  849. begin
  850. TestString(FInvalidString,ttNumber);
  851. end;
  852. procedure TTestExpressionScanner.DoInvalidNumber(AString : String);
  853. begin
  854. FInvalidString:=AString;
  855. AssertException('Invalid number "'+AString+'"',EExprScanner,@TestInvalidNumber);
  856. end;
  857. procedure TTestExpressionScanner.TestNumber;
  858. begin
  859. TestString('123',ttNumber);
  860. TestString('123.4',ttNumber);
  861. TestString('123.E4',ttNumber);
  862. TestString('1.E4',ttNumber);
  863. TestString('1e-2',ttNumber);
  864. DoInvalidNumber('1..1');
  865. DoInvalidNumber('1.E--1');
  866. DoInvalidNumber('.E-1');
  867. end;
  868. procedure TTestExpressionScanner.TestInvalidCharacter;
  869. begin
  870. DoInvalidNumber('~');
  871. DoInvalidNumber('^');
  872. DoInvalidNumber('#');
  873. DoInvalidNumber('$');
  874. DoInvalidNumber('^');
  875. end;
  876. procedure TTestExpressionScanner.TestUnterminatedString;
  877. begin
  878. DoInvalidNumber('''abc');
  879. end;
  880. procedure TTestExpressionScanner.TestQuotesInString;
  881. begin
  882. TestString('''That''''s it''',ttString);
  883. TestString('''''''s it''',ttString);
  884. TestString('''s it''''''',ttString);
  885. end;
  886. procedure TTestExpressionScanner.SetUp;
  887. begin
  888. FP:=TFPExpressionScanner.Create;
  889. end;
  890. procedure TTestExpressionScanner.TearDown;
  891. begin
  892. FreeAndNil(FP);
  893. end;
  894. procedure TTestExpressionScanner.AssertEquals(Msg: string; AExpected,
  895. AActual: TTokenType);
  896. Var
  897. S1,S2 : String;
  898. begin
  899. S1:=TokenName(AExpected);
  900. S2:=GetEnumName(TypeInfo(TTokenType),Ord(AActual));
  901. AssertEquals(Msg,S1,S2);
  902. end;
  903. procedure TTestExpressionScanner.TestString(const AString: String;
  904. AToken: TTokenType);
  905. begin
  906. FP.Source:=AString;
  907. AssertEquals('String "'+AString+'" results in token '+TokenName(AToken),AToken,FP.GetToken);
  908. If Not (FP.TokenType in [ttString,ttEOF]) then
  909. AssertEquals('String "'+AString+'" results in token string '+TokenName(AToken),AString,FP.Token)
  910. else if FP.TokenType=ttString then
  911. AssertEquals('String "'+AString+'" results in token string '+TokenName(AToken),
  912. StringReplace(AString,'''''','''',[rfreplaceAll]),
  913. ''''+FP.Token+'''');
  914. end;
  915. { TTestBaseParser }
  916. procedure TTestBaseParser.DoCheck;
  917. begin
  918. FCheckNode.Check;
  919. end;
  920. procedure TTestBaseParser.AssertNodeType(Msg: String; AClass: TClass;
  921. ANode: TFPExprNode);
  922. begin
  923. AssertNotNull(Msg+': Not null',ANode);
  924. AssertEquals(Msg+': Class OK',AClass,ANode.ClassType);
  925. end;
  926. procedure TTestBaseParser.AssertEquals(Msg: String; AResultType: TResultType;
  927. ANode: TFPExprNode);
  928. begin
  929. AssertNotNull(Msg+': Node not null',ANode);
  930. AssertEquals(Msg,AResultType,Anode.NodeType);
  931. end;
  932. procedure TTestBaseParser.AssertEquals(Msg: String; AExpected,
  933. AActual: TResultType);
  934. begin
  935. AssertEquals(Msg,ResultTypeName(AExpected),ResultTypeName(AActual));
  936. end;
  937. function TTestBaseParser.CreateIntNode(AInteger: Integer): TFPExprNode;
  938. begin
  939. Result:=TFPConstExpression.CreateInteger(AInteger);
  940. end;
  941. function TTestBaseParser.CreateFloatNode(AFloat: TExprFloat): TFPExprNode;
  942. begin
  943. Result:=TFPConstExpression.CreateFloat(AFloat);
  944. end;
  945. function TTestBaseParser.CreateStringNode(Astring: String): TFPExprNode;
  946. begin
  947. Result:=TFPConstExpression.CreateString(AString);
  948. end;
  949. function TTestBaseParser.CreateDateTimeNode(ADateTime: TDateTime): TFPExprNode;
  950. begin
  951. Result:=TFPConstExpression.CreateDateTime(ADateTime);
  952. end;
  953. procedure TTestBaseParser.AssertNodeOK(FN: TFPExprNode);
  954. Var
  955. B : Boolean;
  956. Msg : String;
  957. begin
  958. AssertNotNull('Node to test OK',FN);
  959. B:=False;
  960. try
  961. FN.Check;
  962. B:=True;
  963. except
  964. On E : Exception do
  965. Msg:=E.Message;
  966. end;
  967. If Not B then
  968. Fail(Format('Node %s not OK: %s',[FN.ClassName,Msg]));
  969. end;
  970. procedure TTestBaseParser.AssertNodeNotOK(const MSg : String; FN: TFPExprNode);
  971. begin
  972. FCheckNode:=FN;
  973. AssertException(Msg,EExprParser,@DoCheck);
  974. end;
  975. function TTestBaseParser.CreateBoolNode(ABoolean: Boolean): TFPExprNode;
  976. begin
  977. Result:=TFPConstExpression.CreateBoolean(ABoolean);
  978. end;
  979. procedure TTestBaseParser.Setup;
  980. begin
  981. inherited Setup;
  982. FDestroyCalled:=0;
  983. end;
  984. { TTestConstExprNode }
  985. procedure TTestConstExprNode.TearDown;
  986. begin
  987. FreeAndNil(FN);
  988. inherited TearDown;
  989. end;
  990. procedure TTestConstExprNode.TestCreateInteger;
  991. begin
  992. FN:=TFPConstExpression.CreateInteger(1);
  993. AssertEquals('Correct type',rtInteger,FN.NodeType);
  994. AssertEquals('Correct result',1,FN.ConstValue.ResInteger);
  995. AssertEquals('Correct result',1,FN.NodeValue.ResInteger);
  996. AssertEquals('AsString ok','1',FN.AsString);
  997. end;
  998. procedure TTestConstExprNode.TestCreateFloat;
  999. Var
  1000. S : String;
  1001. begin
  1002. FN:=TFPConstExpression.CreateFloat(2.34);
  1003. AssertEquals('Correct type',rtFloat,FN.NodeType);
  1004. AssertEquals('Correct result',2.34,FN.ConstValue.ResFloat);
  1005. AssertEquals('Correct result',2.34,FN.NodeValue.ResFloat);
  1006. Str(TExprFLoat(2.34),S);
  1007. AssertEquals('AsString ok',S,FN.AsString);
  1008. end;
  1009. procedure TTestConstExprNode.TestCreateBoolean;
  1010. begin
  1011. FN:=TFPConstExpression.CreateBoolean(True);
  1012. AssertEquals('Correct type',rtBoolean,FN.NodeType);
  1013. AssertEquals('Correct result',True,FN.ConstValue.ResBoolean);
  1014. AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
  1015. AssertEquals('AsString ok','True',FN.AsString);
  1016. FreeAndNil(FN);
  1017. FN:=TFPConstExpression.CreateBoolean(False);
  1018. AssertEquals('AsString ok','False',FN.AsString);
  1019. end;
  1020. procedure TTestConstExprNode.TestCreateDateTime;
  1021. Var
  1022. D : TDateTime;
  1023. S : String;
  1024. begin
  1025. D:=Now;
  1026. FN:=TFPConstExpression.CreateDateTime(D);
  1027. AssertEquals('Correct type',rtDateTime,FN.NodeType);
  1028. AssertEquals('Correct result',D,FN.ConstValue.ResDateTime);
  1029. AssertEquals('Correct result',D,FN.NodeValue.ResDateTime);
  1030. S:=''''+FormatDateTime('cccc',D)+'''';
  1031. AssertEquals('AsString ok',S,FN.AsString);
  1032. end;
  1033. procedure TTestConstExprNode.TestCreateString;
  1034. Var
  1035. S : String;
  1036. begin
  1037. S:='Ohlala';
  1038. FN:=TFPConstExpression.CreateString(S);
  1039. AssertEquals('Correct type',rtString,FN.NodeType);
  1040. AssertEquals('Correct result',S,FN.ConstValue.ResString);
  1041. AssertEquals('Correct result',S,FN.NodeValue.ResString);
  1042. AssertEquals('AsString ok',''''+S+'''',FN.AsString);
  1043. end;
  1044. { TTestNegateExprNode }
  1045. procedure TTestNegateExprNode.TearDown;
  1046. begin
  1047. FreeAndNil(FN);
  1048. inherited TearDown;
  1049. end;
  1050. procedure TTestNegateExprNode.TestCreateInteger;
  1051. begin
  1052. FN:=TFPNegateOperation.Create(CreateIntNode(23));
  1053. AssertEquals('Negate has correct type',rtInteger,FN.NodeType);
  1054. AssertEquals('Negate has correct result',-23,FN.NodeValue.Resinteger);
  1055. AssertEquals('Negate has correct string','-23',FN.AsString);
  1056. AssertNodeOK(FN);
  1057. end;
  1058. procedure TTestNegateExprNode.TestCreateFloat;
  1059. Var
  1060. S : String;
  1061. begin
  1062. FN:=TFPNegateOperation.Create(CreateFloatNode(1.23));
  1063. AssertEquals('Negate has correct type',rtFloat,FN.NodeType);
  1064. AssertEquals('Negate has correct result',-1.23,FN.NodeValue.ResFloat);
  1065. Str(TExprFloat(-1.23),S);
  1066. AssertEquals('Negate has correct string',S,FN.AsString);
  1067. AssertNodeOK(FN);
  1068. end;
  1069. procedure TTestNegateExprNode.TestCreateOther1;
  1070. begin
  1071. FN:=TFPNegateOperation.Create(TFPConstExpression.CreateString('1.23'));
  1072. AssertNodeNotOK('Negate does not accept string',FN);
  1073. end;
  1074. procedure TTestNegateExprNode.TestCreateOther2;
  1075. begin
  1076. FN:=TFPNegateOperation.Create(TFPConstExpression.CreateBoolean(True));
  1077. AssertNodeNotOK('Negate does not accept boolean',FN)
  1078. end;
  1079. procedure TTestNegateExprNode.TestDestroy;
  1080. begin
  1081. FN:=TFPNegateOperation.Create(TMyDestroyNode.CreateTest(Self));
  1082. FreeAndNil(FN);
  1083. AssertEquals('Operand Destroy called',1,self.FDestroyCalled)
  1084. end;
  1085. { TTestDestroyNode }
  1086. procedure TTestDestroyNode.TestDestroy;
  1087. Var
  1088. FN : TMyDestroyNode;
  1089. begin
  1090. AssertEquals('Destroy not called yet',0,self.FDestroyCalled);
  1091. FN:=TMyDestroyNode.CreateTest(Self);
  1092. FN.Free;
  1093. AssertEquals('Destroy called',1,self.FDestroyCalled)
  1094. end;
  1095. { TMyDestroyNode }
  1096. constructor TMyDestroyNode.CreateTest(ATest: TTestBaseParser);
  1097. begin
  1098. FTest:=ATest;
  1099. Inherited CreateInteger(1);
  1100. end;
  1101. destructor TMyDestroyNode.Destroy;
  1102. begin
  1103. Inc(FTest.FDestroyCalled);
  1104. inherited Destroy;
  1105. end;
  1106. { TTestBinaryAndNode }
  1107. procedure TTestBinaryAndNode.TearDown;
  1108. begin
  1109. FreeAndNil(FN);
  1110. inherited TearDown;
  1111. end;
  1112. procedure TTestBinaryAndNode.TestCreateInteger;
  1113. begin
  1114. FN:=TFPBinaryAndOperation.Create(CreateIntNode(3),CreateIntNode(2));
  1115. AssertNodeOK(FN);
  1116. AssertEquals('Correct node type',rtInteger,FN.NodeType);
  1117. AssertEquals('Correct result',2,FN.NodeValue.ResInteger);
  1118. end;
  1119. procedure TTestBinaryAndNode.TestCreateBoolean;
  1120. begin
  1121. FN:=TFPBinaryAndOperation.Create(CreateBoolNode(True),CreateBoolNode(True));
  1122. AssertNodeOK(FN);
  1123. AssertEquals('Correct node type',rtBoolean,FN.NodeType);
  1124. AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
  1125. end;
  1126. procedure TTestBinaryAndNode.TestCreateBooleanInteger;
  1127. begin
  1128. FN:=TFPBinaryAndOperation.Create(CreateBoolNode(True),CreateIntNode(0));
  1129. AssertNodeNotOK('Different node types',FN);
  1130. end;
  1131. procedure TTestBinaryAndNode.TestCreateString;
  1132. begin
  1133. FN:=TFPBinaryAndOperation.Create(CreateStringNode('True'),CreateStringNode('True'));
  1134. AssertNodeNotOK('String node type',FN);
  1135. end;
  1136. procedure TTestBinaryAndNode.TestCreateFloat;
  1137. begin
  1138. FN:=TFPBinaryAndOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
  1139. AssertNodeNotOK('float node type',FN);
  1140. end;
  1141. procedure TTestBinaryAndNode.TestCreateDateTime;
  1142. begin
  1143. FN:=TFPBinaryAndOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now));
  1144. AssertNodeNotOK('DateTime node type',FN);
  1145. end;
  1146. procedure TTestBinaryAndNode.TestDestroy;
  1147. begin
  1148. FN:=TFPBinaryAndOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
  1149. FreeAndNil(FN);
  1150. AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
  1151. end;
  1152. { TTestBinaryOrNode }
  1153. procedure TTestBinaryOrNode.TearDown;
  1154. begin
  1155. FreeAndNil(FN);
  1156. inherited TearDown;
  1157. end;
  1158. procedure TTestBinaryOrNode.TestCreateInteger;
  1159. begin
  1160. FN:=TFPBinaryOrOperation.Create(CreateIntNode(1),CreateIntNode(2));
  1161. AssertNodeOK(FN);
  1162. AssertEquals('Correct node type',rtInteger,FN.NodeType);
  1163. AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
  1164. end;
  1165. procedure TTestBinaryOrNode.TestCreateBoolean;
  1166. begin
  1167. FN:=TFPBinaryOrOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
  1168. AssertNodeOK(FN);
  1169. AssertEquals('Correct node type',rtBoolean,FN.NodeType);
  1170. AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
  1171. end;
  1172. procedure TTestBinaryOrNode.TestCreateBooleanInteger;
  1173. begin
  1174. FN:=TFPBinaryOrOperation.Create(CreateBoolNode(True),CreateIntNode(0));
  1175. AssertNodeNotOK('Different node types',FN);
  1176. end;
  1177. procedure TTestBinaryOrNode.TestCreateString;
  1178. begin
  1179. FN:=TFPBinaryOrOperation.Create(CreateStringNode('True'),CreateStringNode('True'));
  1180. AssertNodeNotOK('String node type',FN);
  1181. end;
  1182. procedure TTestBinaryOrNode.TestCreateFloat;
  1183. begin
  1184. FN:=TFPBinaryOrOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
  1185. AssertNodeNotOK('float node type',FN);
  1186. end;
  1187. procedure TTestBinaryOrNode.TestCreateDateTime;
  1188. begin
  1189. FN:=TFPBinaryOrOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now));
  1190. AssertNodeNotOK('DateTime node type',FN);
  1191. end;
  1192. procedure TTestBinaryOrNode.TestDestroy;
  1193. begin
  1194. FN:=TFPBinaryOrOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
  1195. FreeAndNil(FN);
  1196. AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
  1197. end;
  1198. { TTestBinaryXorNode }
  1199. procedure TTestBinaryXorNode.TearDown;
  1200. begin
  1201. FreeAndNil(FN);
  1202. inherited TearDown;
  1203. end;
  1204. procedure TTestBinaryXorNode.TestCreateInteger;
  1205. begin
  1206. FN:=TFPBinaryXorOperation.Create(CreateIntNode(1),CreateIntNode(2));
  1207. AssertNodeOK(FN);
  1208. AssertEquals('Correct node type',rtInteger,FN.NodeType);
  1209. AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
  1210. end;
  1211. procedure TTestBinaryXorNode.TestCreateBoolean;
  1212. begin
  1213. FN:=TFPBinaryXorOperation.Create(CreateBoolNode(True),CreateBoolNode(True));
  1214. AssertNodeOK(FN);
  1215. AssertEquals('Correct node type',rtBoolean,FN.NodeType);
  1216. AssertEquals('Correct result',False,FN.NodeValue.ResBoolean);
  1217. end;
  1218. procedure TTestBinaryXorNode.TestCreateBooleanInteger;
  1219. begin
  1220. FN:=TFPBinaryXorOperation.Create(CreateBoolNode(True),CreateIntNode(0));
  1221. AssertNodeNotOK('Different node types',FN);
  1222. end;
  1223. procedure TTestBinaryXorNode.TestCreateString;
  1224. begin
  1225. FN:=TFPBinaryXorOperation.Create(CreateStringNode('True'),CreateStringNode('True'));
  1226. AssertNodeNotOK('String node type',FN);
  1227. end;
  1228. procedure TTestBinaryXorNode.TestCreateFloat;
  1229. begin
  1230. FN:=TFPBinaryXorOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
  1231. AssertNodeNotOK('float node type',FN);
  1232. end;
  1233. procedure TTestBinaryXorNode.TestCreateDateTime;
  1234. begin
  1235. FN:=TFPBinaryXorOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now));
  1236. AssertNodeNotOK('DateTime node type',FN);
  1237. end;
  1238. procedure TTestBinaryXorNode.TestDestroy;
  1239. begin
  1240. FN:=TFPBinaryXorOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
  1241. FreeAndNil(FN);
  1242. AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
  1243. end;
  1244. { TTestBooleanNode }
  1245. procedure TTestBooleanNode.TestNode(B: TFPBooleanResultOperation;
  1246. AResult: Boolean);
  1247. begin
  1248. AssertEquals(Format('Test %s(%s,%s) result',[B.ClassName,B.Left.AsString,B.Right.AsString]),Aresult,B.NodeValue.resBoolean);
  1249. end;
  1250. { TTestEqualNode }
  1251. procedure TTestEqualNode.TearDown;
  1252. begin
  1253. FreeAndNil(FN);
  1254. inherited TearDown;
  1255. end;
  1256. class function TTestEqualNode.NodeClass: TFPBooleanResultOperationClass;
  1257. begin
  1258. Result:=TFPEqualOperation;
  1259. end;
  1260. class function TTestEqualNode.ExpectedResult: Boolean;
  1261. begin
  1262. Result:=True
  1263. end;
  1264. class function TTestEqualNode.OperatorString: String;
  1265. begin
  1266. Result:='=';
  1267. end;
  1268. procedure TTestEqualNode.TestCreateIntegerEqual;
  1269. begin
  1270. FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(1));
  1271. AssertNodeOk(FN);
  1272. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1273. TestNode(FN,ExpectedResult);
  1274. end;
  1275. procedure TTestEqualNode.TestCreateIntegerUnEqual;
  1276. begin
  1277. FN:=NodeClass.Create(CreateIntNode(2),CreateIntNode(1));
  1278. AssertNodeOk(FN);
  1279. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1280. TestNode(FN,Not ExpectedResult);
  1281. end;
  1282. procedure TTestEqualNode.TestCreateFloatEqual;
  1283. begin
  1284. FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
  1285. AssertNodeOk(FN);
  1286. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1287. TestNode(FN,ExpectedResult);
  1288. end;
  1289. procedure TTestEqualNode.TestCreateFloatUnEqual;
  1290. begin
  1291. FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.34));
  1292. AssertNodeOk(FN);
  1293. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1294. TestNode(FN,Not ExpectedResult);
  1295. end;
  1296. procedure TTestEqualNode.TestCreateStringEqual;
  1297. begin
  1298. FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('now'));
  1299. AssertNodeOk(FN);
  1300. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1301. TestNode(FN,ExpectedResult);
  1302. end;
  1303. procedure TTestEqualNode.TestCreateStringUnEqual;
  1304. begin
  1305. FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('then'));
  1306. AssertNodeOk(FN);
  1307. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1308. TestNode(FN,Not ExpectedResult);
  1309. end;
  1310. procedure TTestEqualNode.TestCreateBooleanEqual;
  1311. begin
  1312. FN:=NodeClass.Create(CreateBoolNode(True),CreateBoolNode(True));
  1313. AssertNodeOk(FN);
  1314. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1315. TestNode(FN,ExpectedResult);
  1316. end;
  1317. procedure TTestEqualNode.TestCreateBooleanUnEqual;
  1318. begin
  1319. FN:=NodeClass.Create(CreateBoolNode(False),CreateBoolNode(True));
  1320. AssertNodeOk(FN);
  1321. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1322. TestNode(FN,Not ExpectedResult);
  1323. end;
  1324. procedure TTestEqualNode.TestCreateDateTimeEqual;
  1325. Var
  1326. D : TDateTime;
  1327. begin
  1328. D:=Now;
  1329. FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D));
  1330. AssertNodeOk(FN);
  1331. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1332. TestNode(FN,ExpectedResult);
  1333. end;
  1334. procedure TTestEqualNode.TestCreateDateTimeUnEqual;
  1335. Var
  1336. D : TDateTime;
  1337. begin
  1338. D:=Now;
  1339. FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1));
  1340. AssertNodeOk(FN);
  1341. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1342. TestNode(FN,Not ExpectedResult);
  1343. end;
  1344. procedure TTestEqualNode.TestDestroy;
  1345. begin
  1346. FN:=NodeClass.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
  1347. FreeAndNil(FN);
  1348. AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
  1349. end;
  1350. procedure TTestEqualNode.TestWrongTypes1;
  1351. begin
  1352. FN:=NodeClass.Create(CreateIntNode(3),CreateStringNode('1.23'));
  1353. AssertNodeNotOk('Wrong Types',FN);
  1354. end;
  1355. procedure TTestEqualNode.TestWrongTypes2;
  1356. begin
  1357. FN:=NodeClass.Create(CreateDateTimeNode(3),CreateStringNode('1.23'));
  1358. AssertNodeNotOk('Wrong Types',FN);
  1359. end;
  1360. procedure TTestEqualNode.TestWrongTypes3;
  1361. begin
  1362. FN:=NodeClass.Create(CreateFloatNode(1.3),CreateStringNode('1.23'));
  1363. AssertNodeNotOk('Wrong Types',FN);
  1364. end;
  1365. procedure TTestEqualNode.TestWrongTypes4;
  1366. begin
  1367. FN:=NodeClass.Create(CreateBoolNode(False),CreateStringNode('1.23'));
  1368. AssertNodeNotOk('Wrong Types',FN);
  1369. end;
  1370. procedure TTestEqualNode.TestWrongTypes5;
  1371. begin
  1372. FN:=NodeClass.Create(CreateFloatNode(1),CreateIntNode(1));
  1373. AssertNodeNotOk('Wrong Types',FN);
  1374. end;
  1375. procedure TTestEqualNode.TestAsString;
  1376. begin
  1377. FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2));
  1378. AssertEquals('Asstring works ok','1 '+OPeratorString+' 2',FN.AsString);
  1379. end;
  1380. { TTestUnEqualNode }
  1381. class function TTestUnEqualNode.NodeClass: TFPBooleanResultOperationClass;
  1382. begin
  1383. Result:=TFPUnEqualOperation;
  1384. end;
  1385. class function TTestUnEqualNode.ExpectedResult: Boolean;
  1386. begin
  1387. Result:=False;
  1388. end;
  1389. class function TTestUnEqualNode.OperatorString: String;
  1390. begin
  1391. Result:='<>';
  1392. end;
  1393. { TTestLessThanNode }
  1394. class function TTestLessThanNode.NodeClass: TFPBooleanResultOperationClass;
  1395. begin
  1396. Result:=TFPLessThanOperation;
  1397. end;
  1398. class function TTestLessThanNode.Larger: Boolean;
  1399. begin
  1400. Result:=False;
  1401. end;
  1402. class function TTestLessThanNode.AllowEqual: Boolean;
  1403. begin
  1404. Result:=False;
  1405. end;
  1406. class function TTestLessThanNode.OperatorString: String;
  1407. begin
  1408. Result:='<';
  1409. end;
  1410. procedure TTestLessThanNode.TearDown;
  1411. begin
  1412. FreeAndNil(FN);
  1413. inherited TearDown;
  1414. end;
  1415. procedure TTestLessThanNode.TestCreateIntegerEqual;
  1416. begin
  1417. FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(1));
  1418. AssertNodeOk(FN);
  1419. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1420. TestNode(FN,AllowEqual);
  1421. end;
  1422. procedure TTestLessThanNode.TestCreateIntegerSmaller;
  1423. begin
  1424. FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2));
  1425. AssertNodeOk(FN);
  1426. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1427. TestNode(FN,Not Larger);
  1428. end;
  1429. procedure TTestLessThanNode.TestCreateIntegerLarger;
  1430. begin
  1431. FN:=NodeClass.Create(CreateIntNode(2),CreateIntNode(1));
  1432. AssertNodeOk(FN);
  1433. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1434. TestNode(FN,Larger);
  1435. end;
  1436. procedure TTestLessThanNode.TestCreateFloatEqual;
  1437. begin
  1438. FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
  1439. AssertNodeOk(FN);
  1440. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1441. TestNode(FN,AllowEqual);
  1442. end;
  1443. procedure TTestLessThanNode.TestCreateFloatSmaller;
  1444. begin
  1445. FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(4.56));
  1446. AssertNodeOk(FN);
  1447. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1448. TestNode(FN,Not Larger);
  1449. end;
  1450. procedure TTestLessThanNode.TestCreateFloatLarger;
  1451. begin
  1452. FN:=NodeClass.Create(CreateFloatNode(4.56),CreateFloatNode(1.23));
  1453. AssertNodeOk(FN);
  1454. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1455. TestNode(FN,Larger);
  1456. end;
  1457. procedure TTestLessThanNode.TestCreateDateTimeEqual;
  1458. Var
  1459. D : TDateTime;
  1460. begin
  1461. D:=Now;
  1462. FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D));
  1463. AssertNodeOk(FN);
  1464. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1465. TestNode(FN,AllowEqual);
  1466. end;
  1467. procedure TTestLessThanNode.TestCreateDateTimeSmaller;
  1468. Var
  1469. D : TDateTime;
  1470. begin
  1471. D:=Now;
  1472. FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D+1));
  1473. AssertNodeOk(FN);
  1474. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1475. TestNode(FN,Not larger);
  1476. end;
  1477. procedure TTestLessThanNode.TestCreateDateTimeLarger;
  1478. Var
  1479. D : TDateTime;
  1480. begin
  1481. D:=Now;
  1482. FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1));
  1483. AssertNodeOk(FN);
  1484. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1485. TestNode(FN,larger);
  1486. end;
  1487. procedure TTestLessThanNode.TestCreateStringEqual;
  1488. begin
  1489. FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('now'));
  1490. AssertNodeOk(FN);
  1491. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1492. TestNode(FN,AllowEqual);
  1493. end;
  1494. procedure TTestLessThanNode.TestCreateStringSmaller;
  1495. begin
  1496. FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('then'));
  1497. AssertNodeOk(FN);
  1498. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1499. TestNode(FN,Not Larger);
  1500. end;
  1501. procedure TTestLessThanNode.TestCreateStringLarger;
  1502. begin
  1503. FN:=NodeClass.Create(CreateStringNode('then'),CreateStringNode('now'));
  1504. AssertNodeOk(FN);
  1505. AssertEquals('Boolean result',rtBoolean,FN.NodeType);
  1506. TestNode(FN,Larger);
  1507. end;
  1508. procedure TTestLessThanNode.TestWrongTypes1;
  1509. begin
  1510. FN:=NodeClass.Create(CreateIntNode(3),CreateStringNode('1.23'));
  1511. AssertNodeNotOk('Wrong Types',FN);
  1512. end;
  1513. procedure TTestLessThanNode.TestWrongTypes2;
  1514. begin
  1515. FN:=NodeClass.Create(CreateDateTimeNode(3),CreateStringNode('1.23'));
  1516. AssertNodeNotOk('Wrong Types',FN);
  1517. end;
  1518. procedure TTestLessThanNode.TestWrongTypes3;
  1519. begin
  1520. FN:=NodeClass.Create(CreateFloatNode(1.3),CreateStringNode('1.23'));
  1521. AssertNodeNotOk('Wrong Types',FN);
  1522. end;
  1523. procedure TTestLessThanNode.TestWrongTypes4;
  1524. begin
  1525. FN:=NodeClass.Create(CreateBoolNode(False),CreateStringNode('1.23'));
  1526. AssertNodeNotOk('Wrong Types',FN);
  1527. end;
  1528. procedure TTestLessThanNode.TestWrongTypes5;
  1529. begin
  1530. FN:=NodeClass.Create(CreateFloatNode(1.23),CreateIntNode(1));
  1531. AssertNodeNotOk('Wrong Types',FN);
  1532. end;
  1533. procedure TTestLessThanNode.TestNoBoolean1;
  1534. begin
  1535. FN:=NodeClass.Create(CreateBoolNode(False),CreateIntNode(1));
  1536. AssertNodeNotOk('Wrong Types',FN);
  1537. end;
  1538. procedure TTestLessThanNode.TestNoBoolean2;
  1539. begin
  1540. FN:=NodeClass.Create(CreateIntNode(1),CreateBoolNode(False));
  1541. AssertNodeNotOk('Wrong Types',FN);
  1542. end;
  1543. procedure TTestLessThanNode.TestNoBoolean3;
  1544. begin
  1545. FN:=NodeClass.Create(CreateBoolNode(False),CreateBoolNode(False));
  1546. AssertNodeNotOk('Wrong Types',FN);
  1547. end;
  1548. procedure TTestLessThanNode.TestAsString;
  1549. begin
  1550. FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2));
  1551. AssertEquals('Asstring works ok','1 '+OPeratorString+' 2',FN.AsString);
  1552. end;
  1553. { TTestLessThanEqualNode }
  1554. class function TTestLessThanEqualNode.NodeClass: TFPBooleanResultOperationClass;
  1555. begin
  1556. Result:=TFPLessThanEqualOperation;
  1557. end;
  1558. class function TTestLessThanEqualNode.AllowEqual: Boolean;
  1559. begin
  1560. Result:=True;
  1561. end;
  1562. class function TTestLessThanEqualNode.OperatorString: String;
  1563. begin
  1564. Result:='<=';
  1565. end;
  1566. { TTestLargerThanNode }
  1567. class function TTestLargerThanNode.NodeClass: TFPBooleanResultOperationClass;
  1568. begin
  1569. Result:=TFPGreaterThanOperation;
  1570. end;
  1571. class function TTestLargerThanNode.Larger: Boolean;
  1572. begin
  1573. Result:=True;
  1574. end;
  1575. class function TTestLargerThanNode.OperatorString: String;
  1576. begin
  1577. Result:='>';
  1578. end;
  1579. { TTestLargerThanEqualNode }
  1580. class function TTestLargerThanEqualNode.NodeClass: TFPBooleanResultOperationClass;
  1581. begin
  1582. Result:=TFPGreaterThanEqualOperation;
  1583. end;
  1584. class function TTestLargerThanEqualNode.AllowEqual: Boolean;
  1585. begin
  1586. Result:=True;
  1587. end;
  1588. class function TTestLargerThanEqualNode.OperatorString: String;
  1589. begin
  1590. Result:='>=';
  1591. end;
  1592. { TTestAddNode }
  1593. procedure TTestAddNode.TearDown;
  1594. begin
  1595. FreeAndNil(FN);
  1596. inherited TearDown;
  1597. end;
  1598. procedure TTestAddNode.TestCreateInteger;
  1599. begin
  1600. FN:=TFPAddOperation.Create(CreateIntNode(1),CreateIntNode(2));
  1601. AssertEquals('Add has correct type',rtInteger,FN.NodeType);
  1602. AssertEquals('Add has correct result',3,FN.NodeValue.ResInteger);
  1603. end;
  1604. procedure TTestAddNode.TestCreateFloat;
  1605. begin
  1606. FN:=TFPAddOperation.Create(CreateFloatNode(1.23),CreateFloatNode(4.56));
  1607. AssertEquals('Add has correct type',rtFloat,FN.NodeType);
  1608. AssertEquals('Add has correct result',5.79,FN.NodeValue.ResFloat);
  1609. end;
  1610. procedure TTestAddNode.TestCreateDateTime;
  1611. Var
  1612. D,T : TDateTime;
  1613. begin
  1614. D:=Date;
  1615. T:=Time;
  1616. FN:=TFPAddOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(T));
  1617. AssertEquals('Add has correct type',rtDateTime,FN.NodeType);
  1618. AssertEquals('Add has correct result',D+T,FN.NodeValue.ResDateTime);
  1619. end;
  1620. procedure TTestAddNode.TestCreateString;
  1621. begin
  1622. FN:=TFPAddOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
  1623. AssertEquals('Add has correct type',rtString,FN.NodeType);
  1624. AssertEquals('Add has correct result','aloha',FN.NodeValue.ResString);
  1625. end;
  1626. procedure TTestAddNode.TestCreateBoolean;
  1627. begin
  1628. FN:=TFPAddOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
  1629. AssertNodeNotOK('No boolean addition',FN);
  1630. end;
  1631. procedure TTestAddNode.TestDestroy;
  1632. begin
  1633. FN:=TFPAddOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
  1634. FreeAndNil(FN);
  1635. AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
  1636. end;
  1637. procedure TTestAddNode.TestAsString;
  1638. begin
  1639. FN:=TFPAddOperation.Create(CreateIntNode(1),CreateIntNode(2));
  1640. AssertEquals('Asstring works ok','1 + 2',FN.AsString);
  1641. end;
  1642. { TTestSubtractNode }
  1643. procedure TTestSubtractNode.TearDown;
  1644. begin
  1645. FreeAndNil(FN);
  1646. inherited TearDown;
  1647. end;
  1648. procedure TTestSubtractNode.TestCreateInteger;
  1649. begin
  1650. FN:=TFPSubtractOperation.Create(CreateIntNode(4),CreateIntNode(1));
  1651. AssertEquals('Subtract has correct type',rtInteger,FN.NodeType);
  1652. AssertEquals('Subtract has correct result',3,FN.NodeValue.ResInteger);
  1653. end;
  1654. procedure TTestSubtractNode.TestCreateFloat;
  1655. begin
  1656. FN:=TFPSubtractOperation.Create(CreateFloatNode(4.56),CreateFloatNode(1.23));
  1657. AssertEquals('Subtract has correct type',rtFloat,FN.NodeType);
  1658. AssertEquals('Subtract has correct result',3.33,FN.NodeValue.ResFloat);
  1659. end;
  1660. procedure TTestSubtractNode.TestCreateDateTime;
  1661. Var
  1662. D,T : TDateTime;
  1663. begin
  1664. D:=Date;
  1665. T:=Time;
  1666. FN:=TFPSubtractOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
  1667. AssertEquals('Subtract has correct type',rtDateTime,FN.NodeType);
  1668. AssertEquals('Subtract has correct result',D,FN.NodeValue.ResDateTime);
  1669. end;
  1670. procedure TTestSubtractNode.TestCreateString;
  1671. begin
  1672. FN:=TFPSubtractOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
  1673. AssertNodeNotOK('No string Subtract',FN);
  1674. end;
  1675. procedure TTestSubtractNode.TestCreateBoolean;
  1676. begin
  1677. FN:=TFPSubtractOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
  1678. AssertNodeNotOK('No boolean Subtract',FN);
  1679. end;
  1680. procedure TTestSubtractNode.TestDestroy;
  1681. begin
  1682. FN:=TFPSubtractOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
  1683. FreeAndNil(FN);
  1684. AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
  1685. end;
  1686. procedure TTestSubtractNode.TestAsString;
  1687. begin
  1688. FN:=TFPSubtractOperation.Create(CreateIntNode(1),CreateIntNode(2));
  1689. AssertEquals('Asstring works ok','1 - 2',FN.AsString);
  1690. end;
  1691. { TTestMultiplyNode }
  1692. procedure TTestMultiplyNode.TearDown;
  1693. begin
  1694. FreeAndNil(FN);
  1695. inherited TearDown;
  1696. end;
  1697. procedure TTestMultiplyNode.TestCreateInteger;
  1698. begin
  1699. FN:=TFPMultiplyOperation.Create(CreateIntNode(4),CreateIntNode(2));
  1700. AssertEquals('multiply has correct type',rtInteger,FN.NodeType);
  1701. AssertEquals('multiply has correct result',8,FN.NodeValue.ResInteger);
  1702. end;
  1703. procedure TTestMultiplyNode.TestCreateFloat;
  1704. begin
  1705. FN:=TFPMultiplyOperation.Create(CreateFloatNode(2.0),CreateFloatNode(1.23));
  1706. AssertEquals('multiply has correct type',rtFloat,FN.NodeType);
  1707. AssertEquals('multiply has correct result',2.46,FN.NodeValue.ResFloat);
  1708. end;
  1709. procedure TTestMultiplyNode.TestCreateDateTime;
  1710. Var
  1711. D,T : TDateTime;
  1712. begin
  1713. D:=Date;
  1714. T:=Time;
  1715. FN:=TFPMultiplyOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
  1716. AssertNodeNotOK('No datetime multiply',FN);
  1717. end;
  1718. procedure TTestMultiplyNode.TestCreateString;
  1719. begin
  1720. FN:=TFPMultiplyOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
  1721. AssertNodeNotOK('No string multiply',FN);
  1722. end;
  1723. procedure TTestMultiplyNode.TestCreateBoolean;
  1724. begin
  1725. FN:=TFPMultiplyOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
  1726. AssertNodeNotOK('No boolean multiply',FN);
  1727. end;
  1728. procedure TTestMultiplyNode.TestDestroy;
  1729. begin
  1730. FN:=TFPMultiplyOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
  1731. FreeAndNil(FN);
  1732. AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
  1733. end;
  1734. procedure TTestMultiplyNode.TestAsString;
  1735. begin
  1736. FN:=TFPMultiplyOperation.Create(CreateIntNode(1),CreateIntNode(2));
  1737. AssertEquals('Asstring works ok','1 * 2',FN.AsString);
  1738. end;
  1739. { TTestDivideNode }
  1740. procedure TTestDivideNode.TearDown;
  1741. begin
  1742. FreeAndNil(FN);
  1743. inherited TearDown;
  1744. end;
  1745. procedure TTestDivideNode.TestCreateInteger;
  1746. begin
  1747. FN:=TFPDivideOperation.Create(CreateIntNode(4),CreateIntNode(2));
  1748. AssertEquals('Divide has correct type',rtfloat,FN.NodeType);
  1749. AssertEquals('Divide has correct result',2.0,FN.NodeValue.ResFloat);
  1750. end;
  1751. procedure TTestDivideNode.TestCreateFloat;
  1752. begin
  1753. FN:=TFPDivideOperation.Create(CreateFloatNode(9.0),CreateFloatNode(3.0));
  1754. AssertEquals('Divide has correct type',rtFloat,FN.NodeType);
  1755. AssertEquals('Divide has correct result',3.0,FN.NodeValue.ResFloat);
  1756. end;
  1757. procedure TTestDivideNode.TestCreateDateTime;
  1758. Var
  1759. D,T : TDateTime;
  1760. begin
  1761. D:=Date;
  1762. T:=Time;
  1763. FN:=TFPDivideOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
  1764. AssertNodeNotOK('No datetime division',FN);
  1765. end;
  1766. procedure TTestDivideNode.TestCreateString;
  1767. begin
  1768. FN:=TFPDivideOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
  1769. AssertNodeNotOK('No string division',FN);
  1770. end;
  1771. procedure TTestDivideNode.TestCreateBoolean;
  1772. begin
  1773. FN:=TFPDivideOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
  1774. AssertNodeNotOK('No boolean division',FN);
  1775. end;
  1776. procedure TTestDivideNode.TestDestroy;
  1777. begin
  1778. FN:=TFPDivideOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
  1779. FreeAndNil(FN);
  1780. AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
  1781. end;
  1782. procedure TTestDivideNode.TestAsString;
  1783. begin
  1784. FN:=TFPDivideOperation.Create(CreateIntNode(1),CreateIntNode(2));
  1785. AssertEquals('Asstring works ok','1 / 2',FN.AsString);
  1786. end;
  1787. { TTestIntToFloatNode }
  1788. procedure TTestIntToFloatNode.TearDown;
  1789. begin
  1790. FreeAndNil(Fn);
  1791. inherited TearDown;
  1792. end;
  1793. procedure TTestIntToFloatNode.TestCreateInteger;
  1794. begin
  1795. FN:=TIntToFloatNode.Create(CreateIntNode(4));
  1796. AssertEquals('Convert has correct type',rtfloat,FN.NodeType);
  1797. AssertEquals('Convert has correct result',4.0,FN.NodeValue.ResFloat);
  1798. end;
  1799. procedure TTestIntToFloatNode.TestCreateFloat;
  1800. begin
  1801. FN:=TIntToFloatNode.Create(CreateFloatNode(4.0));
  1802. AssertNodeNotOK('No float allowed',FN);
  1803. end;
  1804. procedure TTestIntToFloatNode.TestDestroy;
  1805. begin
  1806. FN:=TIntToFloatNode.Create(TMyDestroyNode.CreateTest(Self));
  1807. FreeAndNil(FN);
  1808. AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled)
  1809. end;
  1810. procedure TTestIntToFloatNode.TestAsString;
  1811. begin
  1812. FN:=TIntToFloatNode.Create(CreateIntNode(4));
  1813. AssertEquals('Convert has correct asstring','4',FN.AsString);
  1814. end;
  1815. { TTestIntToDateTimeNode }
  1816. procedure TTestIntToDateTimeNode.TearDown;
  1817. begin
  1818. FreeAndNil(FN);
  1819. inherited TearDown;
  1820. end;
  1821. procedure TTestIntToDateTimeNode.TestCreateInteger;
  1822. begin
  1823. FN:=TIntToDateTimeNode.Create(CreateIntNode(Round(Date)));
  1824. AssertEquals('Convert has correct type',rtDateTime,FN.NodeType);
  1825. AssertEquals('Convert has correct result',Date,FN.NodeValue.ResDateTime);
  1826. end;
  1827. procedure TTestIntToDateTimeNode.TestCreateFloat;
  1828. begin
  1829. FN:=TIntToDateTimeNode.Create(CreateFloatNode(4.0));
  1830. AssertNodeNotOK('No float allowed',FN);
  1831. end;
  1832. procedure TTestIntToDateTimeNode.TestDestroy;
  1833. begin
  1834. FN:=TIntToDateTimeNode.Create(TMyDestroyNode.CreateTest(Self));
  1835. FreeAndNil(FN);
  1836. AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled)
  1837. end;
  1838. procedure TTestIntToDateTimeNode.TestAsString;
  1839. begin
  1840. FN:=TIntToDateTimeNode.Create(CreateIntNode(4));
  1841. AssertEquals('Convert has correct asstring','4',FN.AsString);
  1842. end;
  1843. { TTestFloatToDateTimeNode }
  1844. procedure TTestFloatToDateTimeNode.TearDown;
  1845. begin
  1846. FreeAndNil(FN);
  1847. inherited TearDown;
  1848. end;
  1849. procedure TTestFloatToDateTimeNode.TestCreateInteger;
  1850. begin
  1851. FN:=TFloatToDateTimeNode.Create(CreateIntNode(4));
  1852. AssertNodeNotOK('No int allowed',FN);
  1853. end;
  1854. procedure TTestFloatToDateTimeNode.TestCreateFloat;
  1855. Var
  1856. T : TExprFloat;
  1857. begin
  1858. T:=Time;
  1859. FN:=TFloatToDateTimeNode.Create(CreateFloatNode(T));
  1860. AssertEquals('Convert has correct type',rtDateTime,FN.NodeType);
  1861. AssertEquals('Convert has correct result',T,FN.NodeValue.ResDateTime);
  1862. end;
  1863. procedure TTestFloatToDateTimeNode.TestDestroy;
  1864. begin
  1865. FN:=TFloatToDateTimeNode.Create(TMyDestroyNode.CreateTest(Self));
  1866. FreeAndNil(FN);
  1867. AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled)
  1868. end;
  1869. procedure TTestFloatToDateTimeNode.TestAsString;
  1870. Var
  1871. S : String;
  1872. begin
  1873. FN:=TFloatToDateTimeNode.Create(CreateFloatNode(1.2));
  1874. Str(TExprFloat(1.2),S);
  1875. AssertEquals('Convert has correct asstring',S,FN.AsString);
  1876. end;
  1877. { TMyFPExpressionParser }
  1878. procedure TMyFPExpressionParser.BuildHashList;
  1879. begin
  1880. CreateHashList;
  1881. end;
  1882. { TTestExpressionParser }
  1883. procedure TTestExpressionParser.SetUp;
  1884. begin
  1885. inherited SetUp;
  1886. FP:=TMyFPExpressionParser.Create(Nil);
  1887. end;
  1888. procedure TTestExpressionParser.TearDown;
  1889. begin
  1890. FreeAndNil(FP);
  1891. inherited TearDown;
  1892. end;
  1893. procedure TTestExpressionParser.DoParse;
  1894. begin
  1895. FP.Expression:=FTestExpr;
  1896. end;
  1897. procedure TTestExpressionParser.TestParser(AExpr : string);
  1898. begin
  1899. FTestExpr:=AExpr;
  1900. AssertException(Format('Wrong expression: "%s"',[AExpr]),EExprParser,@DoParse);
  1901. end;
  1902. procedure TTestExpressionParser.AssertLeftRight(N: TFPExprNode; LeftClass,
  1903. RightClass: TClass);
  1904. begin
  1905. AssertNotNull('Binary node not null',N);
  1906. If Not N.InheritsFrom(TFPBinaryOperation) then
  1907. Fail(N.ClassName+' does not descend from TFPBinaryOperation');
  1908. AssertNotNull('Left node assigned',TFPBinaryOperation(N).Left);
  1909. AssertNotNull('Right node assigned',TFPBinaryOperation(N).Right);
  1910. AssertEquals('Left node correct class ',LeftClass, TFPBinaryOperation(N).Left.ClassType);
  1911. AssertEquals('Right node correct class ',RightClass, TFPBinaryOperation(N).Right.ClassType);
  1912. end;
  1913. procedure TTestExpressionParser.AssertOperand(N: TFPExprNode;
  1914. OperandClass: TClass);
  1915. begin
  1916. AssertNotNull('Unary node not null',N);
  1917. If Not N.InheritsFrom(TFPUnaryOperator) then
  1918. Fail(N.ClassName+' does not descend from TFPUnaryOperator');
  1919. AssertNotNull('Operand assigned',TFPUnaryOperator(N).Operand);
  1920. AssertEquals('Operand node correct class ',OperandClass, TFPUnaryOperator(N).Operand.ClassType);
  1921. end;
  1922. procedure TTestExpressionParser.AssertResultType(RT: TResultType);
  1923. begin
  1924. AssertEquals('Result type is '+ResultTypeName(rt),rt,FP.ExprNode);
  1925. AssertEquals('Result type is '+ResultTypeName(rt),rt,FP.ResultType);
  1926. end;
  1927. procedure TTestExpressionParser.AssertResult(F: TExprFloat);
  1928. begin
  1929. AssertEquals('Correct float result',F,FP.ExprNode.NodeValue.ResFloat);
  1930. AssertEquals('Correct float result',F,FP.Evaluate.ResFloat);
  1931. end;
  1932. procedure TTestExpressionParser.AssertResult(I: Int64);
  1933. begin
  1934. AssertEquals('Correct integer result',I,FP.ExprNode.NodeValue.ResInteger);
  1935. AssertEquals('Correct integer result',I,FP.Evaluate.ResInteger);
  1936. end;
  1937. procedure TTestExpressionParser.AssertResult(S: String);
  1938. begin
  1939. AssertEquals('Correct string result',S,FP.ExprNode.NodeValue.ResString);
  1940. AssertEquals('Correct string result',S,FP.Evaluate.ResString);
  1941. end;
  1942. procedure TTestExpressionParser.AssertResult(B: Boolean);
  1943. begin
  1944. AssertEquals('Correct boolean result',B,FP.ExprNode.NodeValue.ResBoolean);
  1945. AssertEquals('Correct boolean result',B,FP.Evaluate.ResBoolean);
  1946. end;
  1947. procedure TTestExpressionParser.AssertDateTimeResult(D: TDateTime);
  1948. begin
  1949. AssertEquals('Correct datetime result',D,FP.ExprNode.NodeValue.ResDateTime);
  1950. AssertEquals('Correct boolean result',D,FP.Evaluate.ResDateTime);
  1951. end;
  1952. //TTestParserExpressions
  1953. procedure TTestParserExpressions.TestCreate;
  1954. begin
  1955. AssertEquals('Expression is empty','',FP.Expression);
  1956. AssertNotNull('Identifiers assigned',FP.Identifiers);
  1957. AssertEquals('No identifiers',0,FP.Identifiers.Count);
  1958. end;
  1959. procedure TTestParserExpressions.TestSimpleNodeFloat;
  1960. begin
  1961. FP.Expression:='123.4';
  1962. AssertNotNull('Have result node',FP.ExprNode);
  1963. AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
  1964. AssertResultType(rtFloat);
  1965. AssertResult(123.4);
  1966. end;
  1967. procedure TTestParserExpressions.TestSimpleNodeInteger;
  1968. begin
  1969. FP.Expression:='1234';
  1970. AssertNotNull('Have result node',FP.ExprNode);
  1971. AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
  1972. AssertResultType(rtInteger);
  1973. AssertResult(1234);
  1974. end;
  1975. procedure TTestParserExpressions.TestSimpleNodeBooleanTrue;
  1976. begin
  1977. FP.Expression:='true';
  1978. AssertNotNull('Have result node',FP.ExprNode);
  1979. AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
  1980. AssertResultType(rtBoolean);
  1981. AssertResult(True);
  1982. end;
  1983. procedure TTestParserExpressions.TestSimpleNodeBooleanFalse;
  1984. begin
  1985. FP.Expression:='False';
  1986. AssertNotNull('Have result node',FP.ExprNode);
  1987. AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
  1988. AssertResultType(rtBoolean);
  1989. AssertResult(False);
  1990. end;
  1991. procedure TTestParserExpressions.TestSimpleNodeString;
  1992. begin
  1993. FP.Expression:='''A string''';
  1994. AssertNotNull('Have result node',FP.ExprNode);
  1995. AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
  1996. AssertResultType(rtString);
  1997. AssertResult('A string');
  1998. end;
  1999. procedure TTestParserExpressions.TestSimpleNegativeInteger;
  2000. begin
  2001. FP.Expression:='-1234';
  2002. AssertNotNull('Have result node',FP.ExprNode);
  2003. AssertNodeType('Constant expression',TFPNegateOperation, FP.ExprNode);
  2004. AssertNodeType('Constant expression',TFPConstExpression, TFPNegateOperation(FP.ExprNode).Operand);
  2005. AssertResultType(rtInteger);
  2006. AssertResult(-1234);
  2007. end;
  2008. procedure TTestParserExpressions.TestSimpleNegativeFloat;
  2009. begin
  2010. FP.Expression:='-1.234';
  2011. AssertNotNull('Have result node',FP.ExprNode);
  2012. AssertNodeType('Constant expression',TFPNegateOperation, FP.ExprNode);
  2013. AssertNodeType('Constant expression',TFPConstExpression, TFPNegateOperation(FP.ExprNode).Operand);
  2014. AssertResultType(rtFloat);
  2015. AssertResult(-1.234);
  2016. end;
  2017. procedure TTestParserExpressions.TestSimpleAddInteger;
  2018. begin
  2019. FP.Expression:='4+1';
  2020. AssertNotNull('Have result node',FP.ExprNode);
  2021. AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
  2022. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2023. AssertResultType(rtInteger);
  2024. AssertResult(5);
  2025. end;
  2026. procedure TTestParserExpressions.TestSimpleAddFloat;
  2027. begin
  2028. FP.Expression:='1.2+3.4';
  2029. AssertNotNull('Have result node',FP.ExprNode);
  2030. AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
  2031. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2032. AssertResultType(rtFloat);
  2033. AssertResult(4.6);
  2034. end;
  2035. procedure TTestParserExpressions.TestSimpleAddIntegerFloat;
  2036. begin
  2037. FP.Expression:='1+3.4';
  2038. AssertNotNull('Have result node',FP.ExprNode);
  2039. AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
  2040. AssertLeftRight(FP.ExprNode,TIntToFLoatNode,TFPConstExpression);
  2041. AssertResultType(rtFloat);
  2042. AssertResult(4.4);
  2043. end;
  2044. procedure TTestParserExpressions.TestSimpleAddFloatInteger;
  2045. begin
  2046. FP.Expression:='3.4 + 1';
  2047. AssertNotNull('Have result node',FP.ExprNode);
  2048. AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
  2049. AssertLeftRight(FP.ExprNode,TFPConstExpression,TIntToFLoatNode);
  2050. AssertResultType(rtFloat);
  2051. AssertResult(4.4);
  2052. end;
  2053. procedure TTestParserExpressions.TestSimpleAddString;
  2054. begin
  2055. FP.Expression:='''alo''+''ha''';
  2056. AssertNotNull('Have result node',FP.ExprNode);
  2057. AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
  2058. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2059. AssertResultType(rtString);
  2060. AssertResult('aloha');
  2061. end;
  2062. procedure TTestParserExpressions.TestSimpleSubtractInteger;
  2063. begin
  2064. FP.Expression:='4-1';
  2065. AssertNotNull('Have result node',FP.ExprNode);
  2066. AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
  2067. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2068. AssertResultType(rtInteger);
  2069. AssertResult(3);
  2070. end;
  2071. procedure TTestParserExpressions.TestSimpleSubtractFloat;
  2072. begin
  2073. FP.Expression:='3.4-1.2';
  2074. AssertNotNull('Have result node',FP.ExprNode);
  2075. AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
  2076. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2077. AssertResultType(rtFloat);
  2078. AssertResult(2.2);
  2079. end;
  2080. procedure TTestParserExpressions.TestSimpleSubtractIntegerFloat;
  2081. begin
  2082. FP.Expression:='3-1.2';
  2083. AssertNotNull('Have result node',FP.ExprNode);
  2084. AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
  2085. AssertLeftRight(FP.ExprNode,TIntToFloatNode,TFPConstExpression);
  2086. AssertResultType(rtFloat);
  2087. AssertResult(1.8);
  2088. end;
  2089. procedure TTestParserExpressions.TestSimpleSubtractFloatInteger;
  2090. begin
  2091. FP.Expression:='3.3-2';
  2092. AssertNotNull('Have result node',FP.ExprNode);
  2093. AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
  2094. AssertLeftRight(FP.ExprNode,TFPConstExpression,TIntToFloatNode);
  2095. AssertResultType(rtFloat);
  2096. AssertResult(1.3);
  2097. end;
  2098. procedure TTestParserExpressions.TestSimpleMultiplyInteger;
  2099. begin
  2100. FP.Expression:='4*2';
  2101. AssertNotNull('Have result node',FP.ExprNode);
  2102. AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
  2103. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2104. AssertResultType(rtInteger);
  2105. AssertResult(8);
  2106. end;
  2107. procedure TTestParserExpressions.TestSimpleMultiplyFloat;
  2108. begin
  2109. FP.Expression:='3.4*1.5';
  2110. AssertNotNull('Have result node',FP.ExprNode);
  2111. AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
  2112. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2113. AssertResultType(rtFloat);
  2114. AssertResult(5.1);
  2115. end;
  2116. procedure TTestParserExpressions.TestSimpleDivideInteger;
  2117. begin
  2118. FP.Expression:='4/2';
  2119. AssertNotNull('Have result node',FP.ExprNode);
  2120. AssertNodeType('Constant expression',TFPDivideOperation, FP.ExprNode);
  2121. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2122. AssertResultType(rtFloat);
  2123. AssertResult(2.0);
  2124. end;
  2125. procedure TTestParserExpressions.TestSimpleDivideFloat;
  2126. begin
  2127. FP.Expression:='5.1/1.5';
  2128. AssertNotNull('Have result node',FP.ExprNode);
  2129. AssertNodeType('Constant expression',TFPDivideOperation, FP.ExprNode);
  2130. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2131. AssertResultType(rtFloat);
  2132. AssertResult(3.4);
  2133. end;
  2134. procedure TTestParserExpressions.TestSimpleBooleanAnd;
  2135. begin
  2136. FP.Expression:='true and true';
  2137. AssertNotNull('Have result node',FP.ExprNode);
  2138. AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
  2139. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2140. AssertResultType(rtBoolean);
  2141. AssertResult(True);
  2142. end;
  2143. procedure TTestParserExpressions.TestSimpleIntegerAnd;
  2144. begin
  2145. FP.Expression:='3 and 1';
  2146. AssertNotNull('Have result node',FP.ExprNode);
  2147. AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
  2148. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2149. AssertResultType(rtInteger);
  2150. AssertResult(1);
  2151. end;
  2152. procedure TTestParserExpressions.TestSimpleBooleanOr;
  2153. begin
  2154. FP.Expression:='false or true';
  2155. AssertNotNull('Have result node',FP.ExprNode);
  2156. AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
  2157. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2158. AssertResultType(rtBoolean);
  2159. AssertResult(True);
  2160. end;
  2161. procedure TTestParserExpressions.TestSimpleIntegerOr;
  2162. begin
  2163. FP.Expression:='2 or 1';
  2164. AssertNotNull('Have result node',FP.ExprNode);
  2165. AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
  2166. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2167. AssertResultType(rtInteger);
  2168. AssertResult(3);
  2169. end;
  2170. procedure TTestParserExpressions.TestSimpleBooleanNot;
  2171. begin
  2172. FP.Expression:='not false';
  2173. AssertNotNull('Have result node',FP.ExprNode);
  2174. AssertNodeType('Not node',TFPNotNode, FP.ExprNode);
  2175. AssertOperand(FP.ExprNode,TFPConstExpression);
  2176. AssertResultType(rtBoolean);
  2177. AssertResult(true);
  2178. end;
  2179. procedure TTestParserExpressions.TestSimpleIntegerNot;
  2180. begin
  2181. FP.Expression:='Not 3';
  2182. AssertNotNull('Have result node',FP.ExprNode);
  2183. AssertNodeType('Not node',TFPNotNode, FP.ExprNode);
  2184. AssertOperand(FP.ExprNode,TFPConstExpression);
  2185. AssertResultType(rtInteger);
  2186. AssertResult(Not Int64(3));
  2187. end;
  2188. procedure TTestParserExpressions.TestSimpleAddSeries;
  2189. begin
  2190. FP.Expression:='1 + 2 + 3';
  2191. AssertNotNull('Have result node',FP.ExprNode);
  2192. AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
  2193. AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPConstExpression);
  2194. AssertResultType(rtInteger);
  2195. AssertResult(6);
  2196. end;
  2197. procedure TTestParserExpressions.TestSimpleMultiplySeries;
  2198. begin
  2199. FP.Expression:='2 * 3 * 4';
  2200. AssertNotNull('Have result node',FP.ExprNode);
  2201. AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
  2202. AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPConstExpression);
  2203. AssertResultType(rtInteger);
  2204. AssertResult(24);
  2205. end;
  2206. procedure TTestParserExpressions.TestSimpleAddMultiplySeries;
  2207. begin
  2208. FP.Expression:='2 * 3 + 4';
  2209. AssertNotNull('Have result node',FP.ExprNode);
  2210. AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
  2211. AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPConstExpression);
  2212. AssertResultType(rtInteger);
  2213. AssertResult(10);
  2214. end;
  2215. procedure TTestParserExpressions.TestSimpleAddAndSeries;
  2216. begin
  2217. // 2 and (3+4)
  2218. FP.Expression:='2 and 3 + 4';
  2219. AssertNotNull('Have result node',FP.ExprNode);
  2220. AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
  2221. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation);
  2222. AssertResultType(rtInteger);
  2223. AssertResult(2);
  2224. end;
  2225. procedure TTestParserExpressions.TestSimpleAddOrSeries;
  2226. begin
  2227. // 2 or (3+4)
  2228. FP.Expression:='2 or 3 + 4';
  2229. AssertNotNull('Have result node',FP.ExprNode);
  2230. AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
  2231. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation);
  2232. AssertResultType(rtInteger);
  2233. AssertResult(7);
  2234. end;
  2235. procedure TTestParserExpressions.TestSimpleOrNotSeries;
  2236. begin
  2237. FP.Expression:='Not 1 or 3';
  2238. AssertNotNull('Have result node',FP.ExprNode);
  2239. AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
  2240. AssertLeftRight(FP.ExprNode,TFPNotNode,TFPConstExpression);
  2241. AssertResultType(rtInteger);
  2242. AssertResult((Not Int64(1)) or Int64(3));
  2243. end;
  2244. procedure TTestParserExpressions.TestSimpleAndNotSeries;
  2245. begin
  2246. FP.Expression:='Not False and False';
  2247. AssertNotNull('Have result node',FP.ExprNode);
  2248. AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
  2249. AssertLeftRight(FP.ExprNode,TFPNotNode,TFPConstExpression);
  2250. AssertResultType(rtBoolean);
  2251. AssertResult(False);
  2252. end;
  2253. procedure TTestParserExpressions.TestDoubleAddMultiplySeries;
  2254. begin
  2255. FP.Expression:='2 * 3 + 4 * 5';
  2256. AssertNotNull('Have result node',FP.ExprNode);
  2257. AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
  2258. AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPMultiplyOperation);
  2259. AssertResultType(rtInteger);
  2260. AssertResult(26);
  2261. end;
  2262. procedure TTestParserExpressions.TestDoubleSubtractMultiplySeries;
  2263. begin
  2264. FP.Expression:='4 * 5 - 2 * 3';
  2265. AssertNotNull('Have result node',FP.ExprNode);
  2266. AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
  2267. AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPMultiplyOperation);
  2268. AssertResultType(rtInteger);
  2269. AssertResult(14);
  2270. end;
  2271. procedure TTestParserExpressions.TestSimpleIfInteger;
  2272. begin
  2273. FP.Expression:='If(True,1,2)';
  2274. AssertNotNull('Have result node',FP.ExprNode);
  2275. AssertNodeType('If operation',TIfOperation, FP.ExprNode);
  2276. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2277. AssertResultType(rtInteger);
  2278. AssertResult(1);
  2279. end;
  2280. procedure TTestParserExpressions.TestSimpleIfString;
  2281. begin
  2282. FP.Expression:='If(True,''a'',''b'')';
  2283. AssertNotNull('Have result node',FP.ExprNode);
  2284. AssertNodeType('If operation',TIfOperation, FP.ExprNode);
  2285. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2286. AssertResultType(rtString);
  2287. AssertResult('a');
  2288. end;
  2289. procedure TTestParserExpressions.TestSimpleIfFloat;
  2290. begin
  2291. FP.Expression:='If(True,1.2,3.4)';
  2292. AssertNotNull('Have result node',FP.ExprNode);
  2293. AssertNodeType('If operation',TIfOperation, FP.ExprNode);
  2294. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2295. AssertResultType(rtFloat);
  2296. AssertResult(1.2);
  2297. end;
  2298. procedure TTestParserExpressions.TestSimpleIfBoolean;
  2299. begin
  2300. FP.Expression:='If(True,False,True)';
  2301. AssertNotNull('Have result node',FP.ExprNode);
  2302. AssertNodeType('If operation',TIfOperation, FP.ExprNode);
  2303. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2304. AssertResultType(rtBoolean);
  2305. AssertResult(False);
  2306. end;
  2307. procedure TTestParserExpressions.TestSimpleIfDateTime;
  2308. begin
  2309. FP.Identifiers.AddDateTimeVariable('a',Date);
  2310. FP.Identifiers.AddDateTimeVariable('b',Date-1);
  2311. FP.Expression:='If(True,a,b)';
  2312. AssertNotNull('Have result node',FP.ExprNode);
  2313. AssertNodeType('If operation',TIfOperation, FP.ExprNode);
  2314. AssertLeftRight(FP.ExprNode,TFPExprVariable,TFPExprVariable);
  2315. AssertResultType(rtDateTime);
  2316. AssertResult(Date);
  2317. end;
  2318. procedure TTestParserExpressions.TestSimpleIfOperation;
  2319. begin
  2320. FP.Expression:='If(True,''a'',''b'')+''c''';
  2321. AssertNotNull('Have result node',FP.ExprNode);
  2322. AssertResultType(rtString);
  2323. AssertResult('ac');
  2324. end;
  2325. procedure TTestParserExpressions.TestSimpleBrackets;
  2326. begin
  2327. FP.Expression:='(4 + 2)';
  2328. AssertNotNull('Have result node',FP.ExprNode);
  2329. AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
  2330. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2331. AssertResultType(rtInteger);
  2332. AssertResult(6);
  2333. end;
  2334. procedure TTestParserExpressions.TestSimpleBrackets2;
  2335. begin
  2336. FP.Expression:='(4 * 2)';
  2337. AssertNotNull('Have result node',FP.ExprNode);
  2338. AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
  2339. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2340. AssertResultType(rtInteger);
  2341. AssertResult(8);
  2342. end;
  2343. procedure TTestParserExpressions.TestSimpleBracketsLeft;
  2344. begin
  2345. FP.Expression:='(4 + 2) * 3';
  2346. AssertNotNull('Have result node',FP.ExprNode);
  2347. AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
  2348. AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPConstExpression);
  2349. AssertResultType(rtInteger);
  2350. AssertResult(18);
  2351. end;
  2352. procedure TTestParserExpressions.TestSimpleBracketsRight;
  2353. begin
  2354. FP.Expression:='3 * (4 + 2)';
  2355. AssertNotNull('Have result node',FP.ExprNode);
  2356. AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
  2357. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation);
  2358. AssertResultType(rtInteger);
  2359. AssertResult(18);
  2360. end;
  2361. procedure TTestParserExpressions.TestSimpleBracketsDouble;
  2362. begin
  2363. FP.Expression:='(3 + 4) * (4 + 2)';
  2364. AssertNotNull('Have result node',FP.ExprNode);
  2365. AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
  2366. AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPAddOperation);
  2367. AssertResultType(rtInteger);
  2368. AssertResult(42);
  2369. end;
  2370. //TTestParserBooleanOperations
  2371. procedure TTestParserBooleanOperations.TestEqualInteger;
  2372. begin
  2373. FP.Expression:='1 = 2';
  2374. AssertNotNull('Have result node',FP.ExprNode);
  2375. AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
  2376. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2377. AssertResultType(rtBoolean);
  2378. AssertResult(False);
  2379. end;
  2380. procedure TTestParserBooleanOperations.TestUnEqualInteger;
  2381. begin
  2382. FP.Expression:='1 <> 2';
  2383. AssertNotNull('Have result node',FP.ExprNode);
  2384. AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
  2385. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2386. AssertResultType(rtBoolean);
  2387. AssertResult(True);
  2388. end;
  2389. procedure TTestParserBooleanOperations.TestEqualFloat;
  2390. begin
  2391. FP.Expression:='1.2 = 2.3';
  2392. AssertNotNull('Have result node',FP.ExprNode);
  2393. AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
  2394. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2395. AssertResultType(rtBoolean);
  2396. AssertResult(False);
  2397. end;
  2398. procedure TTestParserBooleanOperations.TestEqualFloat2;
  2399. begin
  2400. FP.Expression:='1.2 = 1.2';
  2401. AssertNotNull('Have result node',FP.ExprNode);
  2402. AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
  2403. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2404. AssertResultType(rtBoolean);
  2405. AssertResult(True);
  2406. end;
  2407. procedure TTestParserBooleanOperations.TestUnEqualFloat;
  2408. begin
  2409. FP.Expression:='1.2 <> 2.3';
  2410. AssertNotNull('Have result node',FP.ExprNode);
  2411. AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
  2412. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2413. AssertResultType(rtBoolean);
  2414. AssertResult(True);
  2415. end;
  2416. procedure TTestParserBooleanOperations.TestEqualString;
  2417. begin
  2418. FP.Expression:='''1.2'' = ''2.3''';
  2419. AssertNotNull('Have result node',FP.ExprNode);
  2420. AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
  2421. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2422. AssertResultType(rtBoolean);
  2423. AssertResult(False);
  2424. end;
  2425. procedure TTestParserBooleanOperations.TestEqualString2;
  2426. begin
  2427. FP.Expression:='''1.2'' = ''1.2''';
  2428. AssertNotNull('Have result node',FP.ExprNode);
  2429. AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
  2430. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2431. AssertResultType(rtBoolean);
  2432. AssertResult(True);
  2433. end;
  2434. procedure TTestParserBooleanOperations.TestUnEqualString;
  2435. begin
  2436. FP.Expression:='''1.2'' <> ''2.3''';
  2437. AssertNotNull('Have result node',FP.ExprNode);
  2438. AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
  2439. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2440. AssertResultType(rtBoolean);
  2441. AssertResult(True);
  2442. end;
  2443. procedure TTestParserBooleanOperations.TestUnEqualString2;
  2444. begin
  2445. FP.Expression:='''aa'' <> ''AA''';
  2446. AssertNotNull('Have result node',FP.ExprNode);
  2447. AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
  2448. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2449. AssertResultType(rtBoolean);
  2450. AssertResult(True);
  2451. end;
  2452. procedure TTestParserBooleanOperations.TestEqualBoolean;
  2453. begin
  2454. FP.Expression:='False = True';
  2455. AssertNotNull('Have result node',FP.ExprNode);
  2456. AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
  2457. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2458. AssertResultType(rtBoolean);
  2459. AssertResult(False);
  2460. end;
  2461. procedure TTestParserBooleanOperations.TestUnEqualBoolean;
  2462. begin
  2463. FP.Expression:='False <> True';
  2464. AssertNotNull('Have result node',FP.ExprNode);
  2465. AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
  2466. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2467. AssertResultType(rtBoolean);
  2468. AssertResult(True);
  2469. end;
  2470. procedure TTestParserBooleanOperations.TestLessThanInteger;
  2471. begin
  2472. FP.Expression:='1 < 2';
  2473. AssertNotNull('Have result node',FP.ExprNode);
  2474. AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
  2475. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2476. AssertResultType(rtBoolean);
  2477. AssertResult(True);
  2478. end;
  2479. procedure TTestParserBooleanOperations.TestLessThanInteger2;
  2480. begin
  2481. FP.Expression:='2 < 2';
  2482. AssertNotNull('Have result node',FP.ExprNode);
  2483. AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
  2484. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2485. AssertResultType(rtBoolean);
  2486. AssertResult(False);
  2487. end;
  2488. procedure TTestParserBooleanOperations.TestLessThanEqualInteger;
  2489. begin
  2490. FP.Expression:='3 <= 2';
  2491. AssertNotNull('Have result node',FP.ExprNode);
  2492. AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
  2493. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2494. AssertResultType(rtBoolean);
  2495. AssertResult(False);
  2496. end;
  2497. procedure TTestParserBooleanOperations.TestLessThanEqualInteger2;
  2498. begin
  2499. FP.Expression:='2 <= 2';
  2500. AssertNotNull('Have result node',FP.ExprNode);
  2501. AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
  2502. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2503. AssertResultType(rtBoolean);
  2504. AssertResult(True);
  2505. end;
  2506. procedure TTestParserBooleanOperations.TestLessThanFloat;
  2507. begin
  2508. FP.Expression:='1.2 < 2.3';
  2509. AssertNotNull('Have result node',FP.ExprNode);
  2510. AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
  2511. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2512. AssertResultType(rtBoolean);
  2513. AssertResult(True);
  2514. end;
  2515. procedure TTestParserBooleanOperations.TestLessThanFloat2;
  2516. begin
  2517. FP.Expression:='2.2 < 2.2';
  2518. AssertNotNull('Have result node',FP.ExprNode);
  2519. AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
  2520. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2521. AssertResultType(rtBoolean);
  2522. AssertResult(False);
  2523. end;
  2524. procedure TTestParserBooleanOperations.TestLessThanEqualFloat;
  2525. begin
  2526. FP.Expression:='3.1 <= 2.1';
  2527. AssertNotNull('Have result node',FP.ExprNode);
  2528. AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
  2529. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2530. AssertResultType(rtBoolean);
  2531. AssertResult(False);
  2532. end;
  2533. procedure TTestParserBooleanOperations.TestLessThanEqualFloat2;
  2534. begin
  2535. FP.Expression:='2.1 <= 2.1';
  2536. AssertNotNull('Have result node',FP.ExprNode);
  2537. AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
  2538. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2539. AssertResultType(rtBoolean);
  2540. AssertResult(True);
  2541. end;
  2542. procedure TTestParserBooleanOperations.TestLessThanString;
  2543. begin
  2544. FP.Expression:='''1'' < ''2''';
  2545. AssertNotNull('Have result node',FP.ExprNode);
  2546. AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
  2547. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2548. AssertResultType(rtBoolean);
  2549. AssertResult(True);
  2550. end;
  2551. procedure TTestParserBooleanOperations.TestLessThanString2;
  2552. begin
  2553. FP.Expression:='''2'' < ''2''';
  2554. AssertNotNull('Have result node',FP.ExprNode);
  2555. AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
  2556. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2557. AssertResultType(rtBoolean);
  2558. AssertResult(False);
  2559. end;
  2560. procedure TTestParserBooleanOperations.TestLessThanEqualString;
  2561. begin
  2562. FP.Expression:='''3'' <= ''2''';
  2563. AssertNotNull('Have result node',FP.ExprNode);
  2564. AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
  2565. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2566. AssertResultType(rtBoolean);
  2567. AssertResult(False);
  2568. end;
  2569. procedure TTestParserBooleanOperations.TestLessThanEqualString2;
  2570. begin
  2571. FP.Expression:='''2'' <= ''2''';
  2572. AssertNotNull('Have result node',FP.ExprNode);
  2573. AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
  2574. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2575. AssertResultType(rtBoolean);
  2576. AssertResult(True);
  2577. end;
  2578. procedure TTestParserBooleanOperations.TestGreaterThanInteger;
  2579. begin
  2580. FP.Expression:='1 > 2';
  2581. AssertNotNull('Have result node',FP.ExprNode);
  2582. AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
  2583. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2584. AssertResultType(rtBoolean);
  2585. AssertResult(False);
  2586. end;
  2587. procedure TTestParserBooleanOperations.TestGreaterThanInteger2;
  2588. begin
  2589. FP.Expression:='2 > 2';
  2590. AssertNotNull('Have result node',FP.ExprNode);
  2591. AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
  2592. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2593. AssertResultType(rtBoolean);
  2594. AssertResult(False);
  2595. end;
  2596. procedure TTestParserBooleanOperations.TestGreaterThanEqualInteger;
  2597. begin
  2598. FP.Expression:='3 >= 2';
  2599. AssertNotNull('Have result node',FP.ExprNode);
  2600. AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
  2601. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2602. AssertResultType(rtBoolean);
  2603. AssertResult(True);
  2604. end;
  2605. procedure TTestParserBooleanOperations.TestGreaterThanEqualInteger2;
  2606. begin
  2607. FP.Expression:='2 >= 2';
  2608. AssertNotNull('Have result node',FP.ExprNode);
  2609. AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
  2610. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2611. AssertResultType(rtBoolean);
  2612. AssertResult(True);
  2613. end;
  2614. procedure TTestParserBooleanOperations.TestGreaterThanFloat;
  2615. begin
  2616. FP.Expression:='1.2 > 2.3';
  2617. AssertNotNull('Have result node',FP.ExprNode);
  2618. AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
  2619. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2620. AssertResultType(rtBoolean);
  2621. AssertResult(False);
  2622. end;
  2623. procedure TTestParserBooleanOperations.TestGreaterThanFloat2;
  2624. begin
  2625. FP.Expression:='2.2 > 2.2';
  2626. AssertNotNull('Have result node',FP.ExprNode);
  2627. AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
  2628. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2629. AssertResultType(rtBoolean);
  2630. AssertResult(False);
  2631. end;
  2632. procedure TTestParserBooleanOperations.TestGreaterThanEqualFloat;
  2633. begin
  2634. FP.Expression:='3.1 >= 2.1';
  2635. AssertNotNull('Have result node',FP.ExprNode);
  2636. AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
  2637. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2638. AssertResultType(rtBoolean);
  2639. AssertResult(True);
  2640. end;
  2641. procedure TTestParserBooleanOperations.TestGreaterThanEqualFloat2;
  2642. begin
  2643. FP.Expression:='2.1 >= 2.1';
  2644. AssertNotNull('Have result node',FP.ExprNode);
  2645. AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
  2646. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2647. AssertResultType(rtBoolean);
  2648. AssertResult(True);
  2649. end;
  2650. procedure TTestParserBooleanOperations.TestGreaterThanString;
  2651. begin
  2652. FP.Expression:='''1'' > ''2''';
  2653. AssertNotNull('Have result node',FP.ExprNode);
  2654. AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
  2655. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2656. AssertResultType(rtBoolean);
  2657. AssertResult(False);
  2658. end;
  2659. procedure TTestParserBooleanOperations.TestGreaterThanString2;
  2660. begin
  2661. FP.Expression:='''2'' > ''2''';
  2662. AssertNotNull('Have result node',FP.ExprNode);
  2663. AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
  2664. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2665. AssertResultType(rtBoolean);
  2666. AssertResult(False);
  2667. end;
  2668. procedure TTestParserBooleanOperations.TestGreaterThanEqualString;
  2669. begin
  2670. FP.Expression:='''3'' >= ''2''';
  2671. AssertNotNull('Have result node',FP.ExprNode);
  2672. AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
  2673. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2674. AssertResultType(rtBoolean);
  2675. AssertResult(True);
  2676. end;
  2677. procedure TTestParserBooleanOperations.TestGreaterThanEqualString2;
  2678. begin
  2679. FP.Expression:='''2'' >= ''2''';
  2680. AssertNotNull('Have result node',FP.ExprNode);
  2681. AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
  2682. AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
  2683. AssertResultType(rtBoolean);
  2684. AssertResult(True);
  2685. end;
  2686. procedure TTestParserBooleanOperations.EqualAndSeries;
  2687. begin
  2688. // (1=2) and (3=4)
  2689. FP.Expression:='1 = 2 and 3 = 4';
  2690. AssertNotNull('Have result node',FP.ExprNode);
  2691. AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
  2692. AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation);
  2693. AssertResultType(rtBoolean);
  2694. AssertResult(False);
  2695. end;
  2696. procedure TTestParserBooleanOperations.EqualAndSeries2;
  2697. begin
  2698. // (1=2) and (3=4)
  2699. FP.Expression:='1 = 1 and 3 = 3';
  2700. AssertNotNull('Have result node',FP.ExprNode);
  2701. AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
  2702. AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation);
  2703. AssertResultType(rtBoolean);
  2704. AssertResult(True);
  2705. end;
  2706. procedure TTestParserBooleanOperations.EqualOrSeries;
  2707. begin
  2708. // (1=2) or (3=4)
  2709. FP.Expression:='1 = 2 or 3 = 4';
  2710. AssertNotNull('Have result node',FP.ExprNode);
  2711. AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
  2712. AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation);
  2713. AssertResultType(rtBoolean);
  2714. AssertResult(False);
  2715. end;
  2716. procedure TTestParserBooleanOperations.EqualOrSeries2;
  2717. begin
  2718. // (1=1) or (3=4)
  2719. FP.Expression:='1 = 1 or 3 = 4';
  2720. AssertNotNull('Have result node',FP.ExprNode);
  2721. AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
  2722. AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation);
  2723. AssertResultType(rtBoolean);
  2724. AssertResult(True);
  2725. end;
  2726. procedure TTestParserBooleanOperations.UnEqualAndSeries;
  2727. begin
  2728. // (1<>2) and (3<>4)
  2729. FP.Expression:='1 <> 2 and 3 <> 4';
  2730. AssertNotNull('Have result node',FP.ExprNode);
  2731. AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
  2732. AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation);
  2733. AssertResultType(rtBoolean);
  2734. AssertResult(True);
  2735. end;
  2736. procedure TTestParserBooleanOperations.UnEqualAndSeries2;
  2737. begin
  2738. // (1<>2) and (3<>4)
  2739. FP.Expression:='1 <> 1 and 3 <> 3';
  2740. AssertNotNull('Have result node',FP.ExprNode);
  2741. AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
  2742. AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation);
  2743. AssertResultType(rtBoolean);
  2744. AssertResult(False);
  2745. end;
  2746. procedure TTestParserBooleanOperations.UnEqualOrSeries;
  2747. begin
  2748. // (1<>2) or (3<>4)
  2749. FP.Expression:='1 <> 2 or 3 <> 4';
  2750. AssertNotNull('Have result node',FP.ExprNode);
  2751. AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
  2752. AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation);
  2753. AssertResultType(rtBoolean);
  2754. AssertResult(True);
  2755. end;
  2756. procedure TTestParserBooleanOperations.UnEqualOrSeries2;
  2757. begin
  2758. // (1<>1) or (3<>4)
  2759. FP.Expression:='1 <> 1 or 3 <> 4';
  2760. AssertNotNull('Have result node',FP.ExprNode);
  2761. AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
  2762. AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation);
  2763. AssertResultType(rtBoolean);
  2764. AssertResult(True);
  2765. end;
  2766. procedure TTestParserBooleanOperations.LessThanAndSeries;
  2767. begin
  2768. // (1<2) and (3<4)
  2769. FP.Expression:='1 < 2 and 3 < 4';
  2770. AssertNotNull('Have result node',FP.ExprNode);
  2771. AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
  2772. AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation);
  2773. AssertResultType(rtBoolean);
  2774. AssertResult(True);
  2775. end;
  2776. procedure TTestParserBooleanOperations.LessThanAndSeries2;
  2777. begin
  2778. // (1<2) and (3<4)
  2779. FP.Expression:='1 < 1 and 3 < 3';
  2780. AssertNotNull('Have result node',FP.ExprNode);
  2781. AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
  2782. AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation);
  2783. AssertResultType(rtBoolean);
  2784. AssertResult(False);
  2785. end;
  2786. procedure TTestParserBooleanOperations.LessThanOrSeries;
  2787. begin
  2788. // (1<2) or (3<4)
  2789. FP.Expression:='1 < 2 or 3 < 4';
  2790. AssertNotNull('Have result node',FP.ExprNode);
  2791. AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
  2792. AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation);
  2793. AssertResultType(rtBoolean);
  2794. AssertResult(True);
  2795. end;
  2796. procedure TTestParserBooleanOperations.LessThanOrSeries2;
  2797. begin
  2798. // (1<1) or (3<4)
  2799. FP.Expression:='1 < 1 or 3 < 4';
  2800. AssertNotNull('Have result node',FP.ExprNode);
  2801. AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
  2802. AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation);
  2803. AssertResultType(rtBoolean);
  2804. AssertResult(True);
  2805. end;
  2806. procedure TTestParserBooleanOperations.GreaterThanAndSeries;
  2807. begin
  2808. // (1>2) and (3>4)
  2809. FP.Expression:='1 > 2 and 3 > 4';
  2810. AssertNotNull('Have result node',FP.ExprNode);
  2811. AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
  2812. AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation);
  2813. AssertResultType(rtBoolean);
  2814. AssertResult(False);
  2815. end;
  2816. procedure TTestParserBooleanOperations.GreaterThanAndSeries2;
  2817. begin
  2818. // (1>2) and (3>4)
  2819. FP.Expression:='1 > 1 and 3 > 3';
  2820. AssertNotNull('Have result node',FP.ExprNode);
  2821. AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
  2822. AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation);
  2823. AssertResultType(rtBoolean);
  2824. AssertResult(False);
  2825. end;
  2826. procedure TTestParserBooleanOperations.GreaterThanOrSeries;
  2827. begin
  2828. // (1>2) or (3>4)
  2829. FP.Expression:='1 > 2 or 3 > 4';
  2830. AssertNotNull('Have result node',FP.ExprNode);
  2831. AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
  2832. AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation);
  2833. AssertResultType(rtBoolean);
  2834. AssertResult(False);
  2835. end;
  2836. procedure TTestParserBooleanOperations.GreaterThanOrSeries2;
  2837. begin
  2838. // (1>1) or (3>4)
  2839. FP.Expression:='1 > 1 or 3 > 4';
  2840. AssertNotNull('Have result node',FP.ExprNode);
  2841. AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
  2842. AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation);
  2843. AssertResultType(rtBoolean);
  2844. AssertResult(False);
  2845. end;
  2846. procedure TTestParserBooleanOperations.LessThanEqualAndSeries;
  2847. begin
  2848. // (1<=2) and (3<=4)
  2849. FP.Expression:='1 <= 2 and 3 <= 4';
  2850. AssertNotNull('Have result node',FP.ExprNode);
  2851. AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
  2852. AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation);
  2853. AssertResultType(rtBoolean);
  2854. AssertResult(True);
  2855. end;
  2856. procedure TTestParserBooleanOperations.LessThanEqualAndSeries2;
  2857. begin
  2858. // (1<=2) and (3<=4)
  2859. FP.Expression:='1 <= 1 and 3 <= 3';
  2860. AssertNotNull('Have result node',FP.ExprNode);
  2861. AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
  2862. AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation);
  2863. AssertResultType(rtBoolean);
  2864. AssertResult(True);
  2865. end;
  2866. procedure TTestParserBooleanOperations.LessThanEqualOrSeries;
  2867. begin
  2868. // (1<=2) or (3<=4)
  2869. FP.Expression:='1 <= 2 or 3 <= 4';
  2870. AssertNotNull('Have result node',FP.ExprNode);
  2871. AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
  2872. AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation);
  2873. AssertResultType(rtBoolean);
  2874. AssertResult(True);
  2875. end;
  2876. procedure TTestParserBooleanOperations.LessThanEqualOrSeries2;
  2877. begin
  2878. // (1<=1) or (3<=4)
  2879. FP.Expression:='1 <= 1 or 3 <= 4';
  2880. AssertNotNull('Have result node',FP.ExprNode);
  2881. AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
  2882. AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation);
  2883. AssertResultType(rtBoolean);
  2884. AssertResult(True);
  2885. end;
  2886. procedure TTestParserBooleanOperations.GreaterThanEqualAndSeries;
  2887. begin
  2888. // (1>=2) and (3>=4)
  2889. FP.Expression:='1 >= 2 and 3 >= 4';
  2890. AssertNotNull('Have result node',FP.ExprNode);
  2891. AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
  2892. AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation);
  2893. AssertResultType(rtBoolean);
  2894. AssertResult(False);
  2895. end;
  2896. procedure TTestParserBooleanOperations.GreaterThanEqualAndSeries2;
  2897. begin
  2898. // (1>=2) and (3>=4)
  2899. FP.Expression:='1 >= 1 and 3 >= 3';
  2900. AssertNotNull('Have result node',FP.ExprNode);
  2901. AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
  2902. AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation);
  2903. AssertResultType(rtBoolean);
  2904. AssertResult(True);
  2905. end;
  2906. procedure TTestParserBooleanOperations.GreaterThanEqualOrSeries;
  2907. begin
  2908. // (1>=2) or (3>=4)
  2909. FP.Expression:='1 >= 2 or 3 >= 4';
  2910. AssertNotNull('Have result node',FP.ExprNode);
  2911. AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
  2912. AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation);
  2913. AssertResultType(rtBoolean);
  2914. AssertResult(False);
  2915. end;
  2916. procedure TTestParserBooleanOperations.GreaterThanEqualOrSeries2;
  2917. begin
  2918. // (1>=1) or (3>=4)
  2919. FP.Expression:='1 >= 1 or 3 >= 4';
  2920. AssertNotNull('Have result node',FP.ExprNode);
  2921. AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
  2922. AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation);
  2923. AssertResultType(rtBoolean);
  2924. AssertResult(True);
  2925. end;
  2926. //TTestParserOperands
  2927. procedure TTestParserOperands.MissingOperand1;
  2928. begin
  2929. TestParser('1+');
  2930. end;
  2931. procedure TTestParserOperands.MissingOperand2;
  2932. begin
  2933. TestParser('*1');
  2934. end;
  2935. procedure TTestParserOperands.MissingOperand3;
  2936. begin
  2937. TestParser('1*');
  2938. end;
  2939. procedure TTestParserOperands.MissingOperand4;
  2940. begin
  2941. TestParser('1+');
  2942. end;
  2943. procedure TTestParserOperands.MissingOperand5;
  2944. begin
  2945. TestParser('1 and');
  2946. end;
  2947. procedure TTestParserOperands.MissingOperand6;
  2948. begin
  2949. TestParser('1 or');
  2950. end;
  2951. procedure TTestParserOperands.MissingOperand7;
  2952. begin
  2953. TestParser('and 1');
  2954. end;
  2955. procedure TTestParserOperands.MissingOperand8;
  2956. begin
  2957. TestParser('or 1');
  2958. end;
  2959. procedure TTestParserOperands.MissingOperand9;
  2960. begin
  2961. TestParser('1-');
  2962. end;
  2963. procedure TTestParserOperands.MissingOperand10;
  2964. begin
  2965. TestParser('1 = ');
  2966. end;
  2967. procedure TTestParserOperands.MissingOperand11;
  2968. begin
  2969. TestParser('= 1');
  2970. end;
  2971. procedure TTestParserOperands.MissingOperand12;
  2972. begin
  2973. TestParser('1 <> ');
  2974. end;
  2975. procedure TTestParserOperands.MissingOperand13;
  2976. begin
  2977. TestParser('<> 1');
  2978. end;
  2979. procedure TTestParserOperands.MissingOperand14;
  2980. begin
  2981. TestParser('1 >= ');
  2982. end;
  2983. procedure TTestParserOperands.MissingOperand15;
  2984. begin
  2985. TestParser('>= 1');
  2986. end;
  2987. procedure TTestParserOperands.MissingOperand16;
  2988. begin
  2989. TestParser('1 <= ');
  2990. end;
  2991. procedure TTestParserOperands.MissingOperand17;
  2992. begin
  2993. TestParser('<= 1');
  2994. end;
  2995. procedure TTestParserOperands.MissingOperand18;
  2996. begin
  2997. TestParser('1 < ');
  2998. end;
  2999. procedure TTestParserOperands.MissingOperand19;
  3000. begin
  3001. TestParser('< 1');
  3002. end;
  3003. procedure TTestParserOperands.MissingOperand20;
  3004. begin
  3005. TestParser('1 > ');
  3006. end;
  3007. procedure TTestParserOperands.MissingOperand21;
  3008. begin
  3009. TestParser('> 1');
  3010. end;
  3011. procedure TTestParserOperands.MissingBracket1;
  3012. begin
  3013. TestParser('(1+3');
  3014. end;
  3015. procedure TTestParserOperands.MissingBracket2;
  3016. begin
  3017. TestParser('1+3)');
  3018. end;
  3019. procedure TTestParserOperands.MissingBracket3;
  3020. begin
  3021. TestParser('(1+3))');
  3022. end;
  3023. procedure TTestParserOperands.MissingBracket4;
  3024. begin
  3025. TestParser('((1+3)');
  3026. end;
  3027. procedure TTestParserOperands.MissingBracket5;
  3028. begin
  3029. TestParser('((1+3) 4');
  3030. end;
  3031. procedure TTestParserOperands.MissingBracket6;
  3032. begin
  3033. TestParser('IF(true,1,2');
  3034. end;
  3035. procedure TTestParserOperands.MissingBracket7;
  3036. begin
  3037. TestParser('case(1,1,2,4');
  3038. end;
  3039. procedure TTestParserOperands.MissingArgument1;
  3040. begin
  3041. TestParser('IF(true,1)');
  3042. end;
  3043. procedure TTestParserOperands.MissingArgument2;
  3044. begin
  3045. TestParser('IF(True)');
  3046. end;
  3047. procedure TTestParserOperands.MissingArgument3;
  3048. begin
  3049. TestParser('case(1)');
  3050. end;
  3051. procedure TTestParserOperands.MissingArgument4;
  3052. begin
  3053. TestParser('case(1,2)');
  3054. end;
  3055. procedure TTestParserOperands.MissingArgument5;
  3056. begin
  3057. TestParser('case(1,2,3)');
  3058. end;
  3059. procedure TTestParserOperands.MissingArgument6;
  3060. begin
  3061. TestParser('IF(true,1,2,3)');
  3062. end;
  3063. procedure TTestParserOperands.MissingArgument7;
  3064. begin
  3065. TestParser('case(0,1,2,3,4,5,6)');
  3066. end;
  3067. procedure TTestParserTypeMatch.AccessString;
  3068. begin
  3069. FP.AsString;
  3070. end;
  3071. procedure TTestParserTypeMatch.AccessInteger;
  3072. begin
  3073. FP.AsInteger;
  3074. end;
  3075. procedure TTestParserTypeMatch.AccessFloat;
  3076. begin
  3077. FP.AsFloat;
  3078. end;
  3079. procedure TTestParserTypeMatch.AccessDateTime;
  3080. begin
  3081. FP.AsDateTime;
  3082. end;
  3083. procedure TTestParserTypeMatch.AccessBoolean;
  3084. begin
  3085. FP.AsBoolean;
  3086. end;
  3087. //TTestParserTypeMatch
  3088. procedure TTestParserTypeMatch.TestTypeMismatch1;
  3089. begin
  3090. TestParser('1+''string''');
  3091. end;
  3092. procedure TTestParserTypeMatch.TestTypeMismatch2;
  3093. begin
  3094. TestParser('1+True');
  3095. end;
  3096. procedure TTestParserTypeMatch.TestTypeMismatch3;
  3097. begin
  3098. TestParser('True+''string''');
  3099. end;
  3100. procedure TTestParserTypeMatch.TestTypeMismatch4;
  3101. begin
  3102. TestParser('1.23+''string''');
  3103. end;
  3104. procedure TTestParserTypeMatch.TestTypeMismatch5;
  3105. begin
  3106. TestParser('1.23+true');
  3107. end;
  3108. procedure TTestParserTypeMatch.TestTypeMismatch6;
  3109. begin
  3110. TestParser('1.23 and true');
  3111. end;
  3112. procedure TTestParserTypeMatch.TestTypeMismatch7;
  3113. begin
  3114. TestParser('1.23 or true');
  3115. end;
  3116. procedure TTestParserTypeMatch.TestTypeMismatch8;
  3117. begin
  3118. TestParser('''string'' or true');
  3119. end;
  3120. procedure TTestParserTypeMatch.TestTypeMismatch9;
  3121. begin
  3122. TestParser('''string'' and true');
  3123. end;
  3124. procedure TTestParserTypeMatch.TestTypeMismatch10;
  3125. begin
  3126. TestParser('1.23 or 1');
  3127. end;
  3128. procedure TTestParserTypeMatch.TestTypeMismatch11;
  3129. begin
  3130. TestParser('1.23 and 1');
  3131. end;
  3132. procedure TTestParserTypeMatch.TestTypeMismatch12;
  3133. begin
  3134. TestParser('''astring'' = 1');
  3135. end;
  3136. procedure TTestParserTypeMatch.TestTypeMismatch13;
  3137. begin
  3138. TestParser('true = 1');
  3139. end;
  3140. procedure TTestParserTypeMatch.TestTypeMismatch14;
  3141. begin
  3142. TestParser('true * 1');
  3143. end;
  3144. procedure TTestParserTypeMatch.TestTypeMismatch15;
  3145. begin
  3146. TestParser('''astring'' * 1');
  3147. end;
  3148. procedure TTestParserTypeMatch.TestTypeMismatch16;
  3149. begin
  3150. TestParser('If(1,1,1)');
  3151. end;
  3152. procedure TTestParserTypeMatch.TestTypeMismatch17;
  3153. begin
  3154. TestParser('If(True,1,''3'')');
  3155. end;
  3156. procedure TTestParserTypeMatch.TestTypeMismatch18;
  3157. begin
  3158. TestParser('case(1,1,''3'',1)');
  3159. end;
  3160. procedure TTestParserTypeMatch.TestTypeMismatch19;
  3161. begin
  3162. TestParser('case(1,1,1,''3'')');
  3163. end;
  3164. procedure TTestParserTypeMatch.TestTypeMismatch20;
  3165. begin
  3166. FP.Expression:='1';
  3167. AssertException('Accessing integer as string',EExprParser,@AccessString);
  3168. end;
  3169. procedure TTestParserTypeMatch.TestTypeMismatch21;
  3170. begin
  3171. FP.Expression:='''a''';
  3172. AssertException('Accessing string as integer',EExprParser,@AccessInteger);
  3173. end;
  3174. procedure TTestParserTypeMatch.TestTypeMismatch22;
  3175. begin
  3176. FP.Expression:='''a''';
  3177. AssertException('Accessing string as float',EExprParser,@AccessFloat);
  3178. end;
  3179. procedure TTestParserTypeMatch.TestTypeMismatch23;
  3180. begin
  3181. FP.Expression:='''a''';
  3182. AssertException('Accessing string as boolean',EExprParser,@AccessBoolean);
  3183. end;
  3184. procedure TTestParserTypeMatch.TestTypeMismatch24;
  3185. begin
  3186. FP.Expression:='''a''';
  3187. AssertException('Accessing string as datetime',EExprParser,@AccessDateTime);
  3188. end;
  3189. //TTestParserVariables
  3190. Procedure GetDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
  3191. begin
  3192. Result.resDateTime:=Date;
  3193. end;
  3194. procedure TTestParserVariables.TestVariable1;
  3195. Var
  3196. I : TFPExprIdentifierDef;
  3197. begin
  3198. I:=FP.Identifiers.AddVariable('a',rtBoolean,'True');
  3199. AssertEquals('List is dirty',True,FP.Dirty);
  3200. AssertNotNull('Addvariable returns result',I);
  3201. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3202. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3203. AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
  3204. AssertEquals('Variable has correct value','True',I.Value);
  3205. end;
  3206. procedure TTestParserVariables.TestVariable2;
  3207. Var
  3208. I : TFPExprIdentifierDef;
  3209. begin
  3210. I:=FP.Identifiers.AddBooleanVariable('a',False);
  3211. AssertEquals('List is dirty',True,FP.Dirty);
  3212. AssertNotNull('Addvariable returns result',I);
  3213. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3214. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3215. AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
  3216. AssertEquals('Variable has correct value','False',I.Value);
  3217. end;
  3218. procedure TTestParserVariables.TestVariable3;
  3219. Var
  3220. I : TFPExprIdentifierDef;
  3221. begin
  3222. I:=FP.Identifiers.AddIntegerVariable('a',123);
  3223. AssertEquals('List is dirty',True,FP.Dirty);
  3224. AssertNotNull('Addvariable returns result',I);
  3225. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3226. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3227. AssertEquals('Variable has correct resulttype',rtInteger,I.ResultType);
  3228. AssertEquals('Variable has correct value','123',I.Value);
  3229. end;
  3230. procedure TTestParserVariables.TestVariable4;
  3231. Var
  3232. I : TFPExprIdentifierDef;
  3233. begin
  3234. I:=FP.Identifiers.AddFloatVariable('a',1.23);
  3235. AssertEquals('List is dirty',True,FP.Dirty);
  3236. AssertNotNull('Addvariable returns result',I);
  3237. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3238. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3239. AssertEquals('Variable has correct resulttype',rtFloat,I.ResultType);
  3240. AssertEquals('Variable has correct value',FloatToStr(1.23),I.Value);
  3241. end;
  3242. procedure TTestParserVariables.TestVariable5;
  3243. Var
  3244. I : TFPExprIdentifierDef;
  3245. begin
  3246. I:=FP.Identifiers.AddStringVariable('a','1.23');
  3247. AssertEquals('List is dirty',True,FP.Dirty);
  3248. AssertNotNull('Addvariable returns result',I);
  3249. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3250. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3251. AssertEquals('Variable has correct resulttype',rtString,I.ResultType);
  3252. AssertEquals('Variable has correct value','1.23',I.Value);
  3253. end;
  3254. procedure TTestParserVariables.TestVariable6;
  3255. Var
  3256. I : TFPExprIdentifierDef;
  3257. D : TDateTime;
  3258. begin
  3259. D:=Now;
  3260. I:=FP.Identifiers.AddDateTimeVariable('a',D);
  3261. AssertEquals('List is dirty',True,FP.Dirty);
  3262. AssertNotNull('Addvariable returns result',I);
  3263. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3264. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3265. AssertEquals('Variable has correct resulttype',rtDateTime,I.ResultType);
  3266. AssertEquals('Variable has correct value',FormatDateTime('cccc',D),I.Value);
  3267. end;
  3268. procedure TTestParserVariables.AddVariabletwice;
  3269. begin
  3270. FP.Identifiers.AddDateTimeVariable('a',Now);
  3271. end;
  3272. procedure TTestParserVariables.UnknownVariable;
  3273. begin
  3274. FP.Identifiers.IdentifierByName('unknown');
  3275. end;
  3276. procedure TTestParserVariables.ReadWrongType;
  3277. Var
  3278. Res : TFPExpressioNResult;
  3279. begin
  3280. AssertEquals('Only one identifier',1,FP.Identifiers.Count);
  3281. Case FAsWrongType of
  3282. rtBoolean : res.ResBoolean:=FP.Identifiers[0].AsBoolean;
  3283. rtString : res.ResString:=FP.Identifiers[0].AsString;
  3284. rtInteger : Res.ResInteger:=FP.Identifiers[0].AsInteger;
  3285. rtFloat : Res.ResFloat:=FP.Identifiers[0].AsFloat;
  3286. rtDateTime : Res.ResDateTime:=FP.Identifiers[0].AsDateTime;
  3287. end;
  3288. end;
  3289. procedure TTestParserVariables.WriteWrongType;
  3290. Var
  3291. Res : TFPExpressioNResult;
  3292. begin
  3293. AssertEquals('Only one identifier',1,FP.Identifiers.Count);
  3294. Case FAsWrongType of
  3295. rtBoolean : FP.Identifiers[0].AsBoolean:=res.ResBoolean;
  3296. rtString : FP.Identifiers[0].AsString:=res.ResString;
  3297. rtInteger : FP.Identifiers[0].AsInteger:=Res.ResInteger;
  3298. rtFloat : FP.Identifiers[0].AsFloat:=Res.ResFloat;
  3299. rtDateTime : FP.Identifiers[0].AsDateTime:=Res.ResDateTime;
  3300. end;
  3301. end;
  3302. procedure TTestParserVariables.DoDummy(var Result: TFPExpressionResult;
  3303. const Args: TExprParameterArray);
  3304. begin
  3305. // Do nothing;
  3306. end;
  3307. procedure TTestParserVariables.TestVariableAssign;
  3308. Var
  3309. I,J : TFPExprIdentifierDef;
  3310. begin
  3311. I:=TFPExprIdentifierDef.Create(Nil);
  3312. try
  3313. J:=TFPExprIdentifierDef.Create(Nil);
  3314. try
  3315. I.Name:='Aname';
  3316. I.ParameterTypes:='ISDBF';
  3317. I.ResultType:=rtFloat;
  3318. I.Value:='1.23';
  3319. I.OnGetFunctionValue:=@DoDummy;
  3320. I.OnGetFunctionValueCallBack:=@GetDate;
  3321. J.Assign(I);
  3322. AssertEquals('Names match',I.Name,J.Name);
  3323. AssertEquals('Parametertypes match',I.ParameterTypes,J.ParameterTypes);
  3324. AssertEquals('Values match',I.Value,J.Value);
  3325. AssertEquals('Result types match',Ord(I.ResultType),Ord(J.ResultType));
  3326. AssertSame('Callbacks match',Pointer(I.OnGetFunctionValueCallBack),Pointer(J.OnGetFunctionValueCallback));
  3327. If (I.OnGetFunctionValue)<>(J.OnGetFunctionValue) then
  3328. Fail('OnGetFUnctionValue as Method does not match');
  3329. finally
  3330. J.Free;
  3331. end;
  3332. finally
  3333. I.Free;
  3334. end;
  3335. end;
  3336. procedure TTestParserVariables.TestVariableAssignAgain;
  3337. Var
  3338. I,J : TFPBuiltinExprIdentifierDef;
  3339. begin
  3340. I:=TFPBuiltinExprIdentifierDef.Create(Nil);
  3341. try
  3342. J:=TFPBuiltinExprIdentifierDef.Create(Nil);
  3343. try
  3344. I.Name:='Aname';
  3345. I.ParameterTypes:='ISDBF';
  3346. I.ResultType:=rtFloat;
  3347. I.Value:='1.23';
  3348. I.OnGetFunctionValue:=@DoDummy;
  3349. I.OnGetFunctionValueCallBack:=@GetDate;
  3350. I.Category:=bcUser;
  3351. J.Assign(I);
  3352. AssertEquals('Names match',I.Name,J.Name);
  3353. AssertEquals('Parametertypes match',I.ParameterTypes,J.ParameterTypes);
  3354. AssertEquals('Values match',I.Value,J.Value);
  3355. AssertEquals('Result types match',Ord(I.ResultType),Ord(J.ResultType));
  3356. AssertEquals('Categories match',Ord(I.Category),Ord(J.Category));
  3357. AssertSame('Callbacks match',Pointer(I.OnGetFunctionValueCallBack),Pointer(J.OnGetFunctionValueCallback));
  3358. If (I.OnGetFunctionValue)<>(J.OnGetFunctionValue) then
  3359. Fail('OnGetFUnctionValue as Method does not match');
  3360. finally
  3361. J.Free;
  3362. end;
  3363. finally
  3364. I.Free;
  3365. end;
  3366. end;
  3367. procedure TTestParserVariables.TestVariable7;
  3368. Var
  3369. I : TFPExprIdentifierDef;
  3370. D : TDateTime;
  3371. begin
  3372. D:=Now;
  3373. I:=FP.Identifiers.AddDateTimeVariable('a',D);
  3374. AssertException('Cannot add same name twice',EExprParser,@AddVariabletwice);
  3375. end;
  3376. procedure TTestParserVariables.TestVariable8;
  3377. Var
  3378. I : TFPExprIdentifierDef;
  3379. begin
  3380. FP.Identifiers.AddIntegerVariable('a',123);
  3381. FP.Identifiers.AddIntegerVariable('b',123);
  3382. AssertEquals('List is dirty',True,FP.Dirty);
  3383. FP.BuildHashList;
  3384. FP.Identifiers.Delete(0);
  3385. AssertEquals('List is dirty',True,FP.Dirty);
  3386. end;
  3387. procedure TTestParserVariables.TestVariable9;
  3388. Var
  3389. I : TFPExprIdentifierDef;
  3390. begin
  3391. I:=FP.Identifiers.AddIntegerVariable('a',123);
  3392. FP.Expression:='a';
  3393. AssertNotNull('Have result node',FP.ExprNode);
  3394. AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
  3395. AssertResultType(rtInteger);
  3396. AssertResult(123);
  3397. end;
  3398. procedure TTestParserVariables.TestVariable10;
  3399. Var
  3400. I : TFPExprIdentifierDef;
  3401. begin
  3402. I:=FP.Identifiers.AddStringVariable('a','a123');
  3403. FP.Expression:='a';
  3404. AssertNotNull('Have result node',FP.ExprNode);
  3405. AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
  3406. AssertResultType(rtString);
  3407. AssertResult('a123');
  3408. end;
  3409. procedure TTestParserVariables.TestVariable11;
  3410. Var
  3411. I : TFPExprIdentifierDef;
  3412. begin
  3413. I:=FP.Identifiers.AddFloatVariable('a',1.23);
  3414. FP.Expression:='a';
  3415. AssertNotNull('Have result node',FP.ExprNode);
  3416. AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
  3417. AssertResultType(rtFloat);
  3418. AssertResult(1.23);
  3419. end;
  3420. procedure TTestParserVariables.TestVariable12;
  3421. Var
  3422. I : TFPExprIdentifierDef;
  3423. begin
  3424. I:=FP.Identifiers.AddBooleanVariable('a',True);
  3425. FP.Expression:='a';
  3426. AssertNotNull('Have result node',FP.ExprNode);
  3427. AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
  3428. AssertResultType(rtBoolean);
  3429. AssertResult(True);
  3430. end;
  3431. procedure TTestParserVariables.TestVariable13;
  3432. Var
  3433. I : TFPExprIdentifierDef;
  3434. D : TDateTime;
  3435. begin
  3436. D:=Date;
  3437. I:=FP.Identifiers.AddDateTimeVariable('a',D);
  3438. FP.Expression:='a';
  3439. AssertNotNull('Have result node',FP.ExprNode);
  3440. AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
  3441. AssertResultType(rtDateTime);
  3442. AssertDateTimeResult(D);
  3443. end;
  3444. procedure TTestParserVariables.TestVariable14;
  3445. Var
  3446. I,S : TFPExprIdentifierDef;
  3447. begin
  3448. I:=FP.Identifiers.AddIntegerVariable('a',1);
  3449. FP.BuildHashList;
  3450. S:=FP.IdentifierByName('a');
  3451. AssertSame('Identifier found',I,S);
  3452. end;
  3453. procedure TTestParserVariables.TestVariable15;
  3454. Var
  3455. I,S : TFPExprIdentifierDef;
  3456. begin
  3457. I:=FP.Identifiers.AddIntegerVariable('a',1);
  3458. FP.BuildHashList;
  3459. S:=FP.IdentifierByName('A');
  3460. AssertSame('Identifier found',I,S);
  3461. end;
  3462. procedure TTestParserVariables.TestVariable16;
  3463. Var
  3464. I,S : TFPExprIdentifierDef;
  3465. begin
  3466. I:=FP.Identifiers.AddIntegerVariable('a',1);
  3467. FP.BuildHashList;
  3468. S:=FP.IdentifierByName('B');
  3469. AssertNull('Identifier not found',S);
  3470. end;
  3471. procedure TTestParserVariables.TestVariable17;
  3472. Var
  3473. I,S : TFPExprIdentifierDef;
  3474. begin
  3475. I:=FP.Identifiers.AddIntegerVariable('a',1);
  3476. FP.BuildHashList;
  3477. AssertException('Identifier not found',EExprParser,@unknownvariable);
  3478. end;
  3479. procedure TTestParserVariables.TestVariable18;
  3480. Var
  3481. I,S : TFPExprIdentifierDef;
  3482. begin
  3483. I:=FP.Identifiers.AddIntegerVariable('a',1);
  3484. S:=FP.Identifiers.FindIdentifier('B');
  3485. AssertNull('Identifier not found',S);
  3486. end;
  3487. procedure TTestParserVariables.TestVariable19;
  3488. Var
  3489. I,S : TFPExprIdentifierDef;
  3490. begin
  3491. I:=FP.Identifiers.AddIntegerVariable('a',1);
  3492. S:=FP.Identifiers.FindIdentifier('a');
  3493. AssertSame('Identifier found',I,S);
  3494. end;
  3495. procedure TTestParserVariables.TestVariable20;
  3496. Var
  3497. I,S : TFPExprIdentifierDef;
  3498. begin
  3499. I:=FP.Identifiers.AddIntegerVariable('a',1);
  3500. S:=FP.Identifiers.FindIdentifier('A');
  3501. AssertSame('Identifier found',I,S);
  3502. end;
  3503. procedure TTestParserVariables.TestAccess(Skip : TResultType);
  3504. Var
  3505. rt : TResultType;
  3506. begin
  3507. For rt:=Low(TResultType) to High(TResultType) do
  3508. if rt<>skip then
  3509. begin
  3510. FasWrongType:=rt;
  3511. AssertException('Acces as '+ResultTypeName(rt),EExprParser,@ReadWrongtype);
  3512. end;
  3513. For rt:=Low(TResultType) to High(TResultType) do
  3514. if rt<>skip then
  3515. begin
  3516. FasWrongType:=rt;
  3517. AssertException('Acces as '+ResultTypeName(rt),EExprParser,@WriteWrongtype);
  3518. end;
  3519. end;
  3520. procedure TTestParserVariables.TestVariable21;
  3521. begin
  3522. FP.IDentifiers.AddIntegerVariable('a',1);
  3523. TestAccess(rtInteger);
  3524. end;
  3525. procedure TTestParserVariables.TestVariable22;
  3526. begin
  3527. FP.IDentifiers.AddFloatVariable('a',1.0);
  3528. TestAccess(rtFloat);
  3529. end;
  3530. procedure TTestParserVariables.TestVariable23;
  3531. begin
  3532. FP.IDentifiers.AddStringVariable('a','1.0');
  3533. TestAccess(rtString);
  3534. end;
  3535. procedure TTestParserVariables.TestVariable24;
  3536. begin
  3537. FP.IDentifiers.AddBooleanVariable('a',True);
  3538. TestAccess(rtBoolean);
  3539. end;
  3540. procedure TTestParserVariables.TestVariable25;
  3541. begin
  3542. FP.IDentifiers.AddDateTimeVariable('a',Date);
  3543. TestAccess(rtDateTime);
  3544. end;
  3545. procedure TTestParserVariables.TestVariable26;
  3546. Var
  3547. I : TFPExprIdentifierDef;
  3548. begin
  3549. I:=FP.IDentifiers.AddStringVariable('a','1.0');
  3550. I.AsString:='12';
  3551. AssertEquals('Correct value','12',I.AsString);
  3552. end;
  3553. procedure TTestParserVariables.TestVariable27;
  3554. Var
  3555. I : TFPExprIdentifierDef;
  3556. begin
  3557. I:=FP.IDentifiers.AddIntegerVariable('a',10);
  3558. I.Asinteger:=12;
  3559. AssertEquals('Correct value',12,I.AsInteger);
  3560. end;
  3561. procedure TTestParserVariables.TestVariable28;
  3562. Var
  3563. I : TFPExprIdentifierDef;
  3564. begin
  3565. I:=FP.IDentifiers.AddFloatVariable('a',1.0);
  3566. I.AsFloat:=1.2;
  3567. AssertEquals('Correct value',1.2,I.AsFloat);
  3568. end;
  3569. procedure TTestParserVariables.TestVariable29;
  3570. Var
  3571. I : TFPExprIdentifierDef;
  3572. begin
  3573. I:=FP.IDentifiers.AddDateTimeVariable('a',Now);
  3574. I.AsDateTime:=Date-1;
  3575. AssertEquals('Correct value',Date-1,I.AsDateTime);
  3576. end;
  3577. procedure TTestParserVariables.TestVariable30;
  3578. Var
  3579. I : TFPExprIdentifierDef;
  3580. begin
  3581. I:=FP.Identifiers.AddBooleanVariable('a',True);
  3582. I.AsBoolean:=False;
  3583. AssertEquals('Correct value',False,I.AsBoolean);
  3584. end;
  3585. Procedure EchoDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
  3586. begin
  3587. Result.resDateTime:=Args[0].resDateTime;
  3588. end;
  3589. Procedure EchoInteger(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
  3590. begin
  3591. Result.resInteger:=Args[0].resInteger;
  3592. end;
  3593. Procedure EchoBoolean(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
  3594. begin
  3595. Result.resBoolean:=Args[0].resBoolean;
  3596. end;
  3597. Procedure EchoFloat(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
  3598. begin
  3599. Result.resFloat:=Args[0].resFloat;
  3600. end;
  3601. Procedure EchoString(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
  3602. begin
  3603. Result.resString:=Args[0].resString;
  3604. end;
  3605. Procedure TTestExpressionParser.DoEchoDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
  3606. begin
  3607. Result.resDateTime:=Args[0].resDateTime;
  3608. end;
  3609. Procedure TTestExpressionParser.DoEchoInteger(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
  3610. begin
  3611. Result.resInteger:=Args[0].resInteger;
  3612. end;
  3613. Procedure TTestExpressionParser.DoEchoBoolean(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
  3614. begin
  3615. Result.resBoolean:=Args[0].resBoolean;
  3616. end;
  3617. Procedure TTestExpressionParser.DoEchoFloat(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
  3618. begin
  3619. Result.resFloat:=Args[0].resFloat;
  3620. end;
  3621. Procedure TTestExpressionParser.DoEchoString(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
  3622. begin
  3623. Result.resString:=Args[0].resString;
  3624. end;
  3625. procedure TTestExpressionParser.DoGetDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
  3626. begin
  3627. Result.ResDatetime:=Date;
  3628. end;
  3629. procedure TTestExpressionParser.DoAddInteger(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
  3630. begin
  3631. Result.Resinteger:=Args[0].ResInteger+Args[1].ResInteger;
  3632. end;
  3633. procedure TTestExpressionParser.DoDeleteString(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
  3634. begin
  3635. Result.ResString:=Args[0].ResString;
  3636. Delete(Result.ResString,Args[1].ResInteger,Args[2].ResInteger);
  3637. end;
  3638. procedure TTestParserFunctions.TryRead;
  3639. Var
  3640. Res : TFPExpressioNResult;
  3641. begin
  3642. AssertEquals('Only one identifier',1,FP.Identifiers.Count);
  3643. Case FAccessAs of
  3644. rtBoolean : res.ResBoolean:=FP.Identifiers[0].AsBoolean;
  3645. rtString : res.ResString:=FP.Identifiers[0].AsString;
  3646. rtInteger : Res.ResInteger:=FP.Identifiers[0].AsInteger;
  3647. rtFloat : Res.ResFloat:=FP.Identifiers[0].AsFloat;
  3648. rtDateTime : Res.ResDateTime:=FP.Identifiers[0].AsDateTime;
  3649. end;
  3650. end;
  3651. procedure TTestParserFunctions.TryWrite;
  3652. Var
  3653. Res : TFPExpressioNResult;
  3654. begin
  3655. AssertEquals('Only one identifier',1,FP.Identifiers.Count);
  3656. Case FAccessAs of
  3657. rtBoolean : FP.Identifiers[0].AsBoolean:=res.ResBoolean;
  3658. rtString : FP.Identifiers[0].AsString:=res.ResString;
  3659. rtInteger : FP.Identifiers[0].AsInteger:=Res.ResInteger;
  3660. rtFloat : FP.Identifiers[0].AsFloat:=Res.ResFloat;
  3661. rtDateTime : FP.Identifiers[0].AsDateTime:=Res.ResDateTime;
  3662. end;
  3663. end;
  3664. // TTestParserFunctions
  3665. procedure TTestParserFunctions.TestFunction1;
  3666. Var
  3667. I : TFPExprIdentifierDef;
  3668. begin
  3669. I:=FP.Identifiers.AddFunction('Date','D','',@GetDate);
  3670. AssertEquals('List is dirty',True,FP.Dirty);
  3671. AssertNotNull('Addvariable returns result',I);
  3672. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3673. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3674. AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
  3675. AssertSame('Function has correct address',Pointer(@GetDate),Pointer(I.OnGetFunctionValueCallBack));
  3676. FaccessAs:=rtDateTime;
  3677. AssertException('No read access',EExprParser,@TryRead);
  3678. AssertException('No write access',EExprParser,@TryWrite);
  3679. end;
  3680. procedure TTestParserFunctions.TestFunction2;
  3681. Var
  3682. I : TFPExprIdentifierDef;
  3683. begin
  3684. I:=FP.Identifiers.AddFunction('EchoDate','D','D',@EchoDate);
  3685. AssertEquals('List is dirty',True,FP.Dirty);
  3686. AssertNotNull('Addvariable returns result',I);
  3687. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3688. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3689. AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
  3690. AssertSame('Function has correct address',Pointer(@EchoDate),Pointer(I.OnGetFunctionValueCallBack));
  3691. end;
  3692. procedure TTestParserFunctions.TestFunction3;
  3693. Var
  3694. I : TFPExprIdentifierDef;
  3695. begin
  3696. I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@EchoInteger);
  3697. AssertEquals('List is dirty',True,FP.Dirty);
  3698. AssertNotNull('Addvariable returns result',I);
  3699. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3700. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3701. AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
  3702. AssertSame('Function has correct address',Pointer(@EchoInteger),Pointer(I.OnGetFunctionValueCallBack));
  3703. FaccessAs:=rtInteger;
  3704. AssertException('No read access',EExprParser,@TryRead);
  3705. AssertException('No write access',EExprParser,@TryWrite);
  3706. end;
  3707. procedure TTestParserFunctions.TestFunction4;
  3708. Var
  3709. I : TFPExprIdentifierDef;
  3710. begin
  3711. I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@EchoBoolean);
  3712. AssertEquals('List is dirty',True,FP.Dirty);
  3713. AssertNotNull('Addvariable returns result',I);
  3714. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3715. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3716. AssertEquals('Function has correct resulttype',rtBoolean,I.ResultType);
  3717. AssertSame('Function has correct address',Pointer(@EchoBoolean),Pointer(I.OnGetFunctionValueCallBack));
  3718. FaccessAs:=rtBoolean;
  3719. AssertException('No read access',EExprParser,@TryRead);
  3720. AssertException('No write access',EExprParser,@TryWrite);
  3721. end;
  3722. procedure TTestParserFunctions.TestFunction5;
  3723. Var
  3724. I : TFPExprIdentifierDef;
  3725. begin
  3726. I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@EchoFloat);
  3727. AssertEquals('List is dirty',True,FP.Dirty);
  3728. AssertNotNull('Addvariable returns result',I);
  3729. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3730. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3731. AssertEquals('Function has correct resulttype',rtFloat,I.ResultType);
  3732. AssertSame('Function has correct address',Pointer(@EchoFloat),Pointer(I.OnGetFunctionValueCallBack));
  3733. FaccessAs:=rtfloat;
  3734. AssertException('No read access',EExprParser,@TryRead);
  3735. AssertException('No write access',EExprParser,@TryWrite);
  3736. end;
  3737. procedure TTestParserFunctions.TestFunction6;
  3738. Var
  3739. I : TFPExprIdentifierDef;
  3740. begin
  3741. I:=FP.Identifiers.AddFunction('EchoString','S','S',@EchoString);
  3742. AssertEquals('List is dirty',True,FP.Dirty);
  3743. AssertNotNull('Addvariable returns result',I);
  3744. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3745. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3746. AssertEquals('Function has correct resulttype',rtString,I.ResultType);
  3747. AssertSame('Function has correct address',Pointer(@EchoString),Pointer(I.OnGetFunctionValueCallBack));
  3748. FaccessAs:=rtString;
  3749. AssertException('No read access',EExprParser,@TryRead);
  3750. AssertException('No write access',EExprParser,@TryWrite);
  3751. end;
  3752. procedure TTestParserFunctions.TestFunction7;
  3753. Var
  3754. I : TFPExprIdentifierDef;
  3755. begin
  3756. I:=FP.Identifiers.AddFunction('EchoDate','D','D',@DoEchoDate);
  3757. AssertEquals('List is dirty',True,FP.Dirty);
  3758. AssertNotNull('Addvariable returns result',I);
  3759. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3760. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3761. AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
  3762. // AssertSame('Function has correct address',TMethod(@Self.DoEchoDate),TMethod(I.OnGetFunctionValue));
  3763. end;
  3764. procedure TTestParserFunctions.TestFunction8;
  3765. Var
  3766. I : TFPExprIdentifierDef;
  3767. begin
  3768. I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@DOEchoInteger);
  3769. AssertEquals('List is dirty',True,FP.Dirty);
  3770. AssertNotNull('Addvariable returns result',I);
  3771. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3772. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3773. AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
  3774. // AssertSame('Function has correct address',Pointer(@EchoInteger),Pointer(I.OnGetFunctionValueCallBack));
  3775. end;
  3776. procedure TTestParserFunctions.TestFunction9;
  3777. Var
  3778. I : TFPExprIdentifierDef;
  3779. begin
  3780. I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@DoEchoBoolean);
  3781. AssertEquals('List is dirty',True,FP.Dirty);
  3782. AssertNotNull('Addvariable returns result',I);
  3783. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3784. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3785. AssertEquals('Function has correct resulttype',rtBoolean,I.ResultType);
  3786. // AssertSame('Function has correct address',Pointer(@EchoBoolean),Pointer(I.OnGetFunctionValueCallBack));
  3787. end;
  3788. procedure TTestParserFunctions.TestFunction10;
  3789. Var
  3790. I : TFPExprIdentifierDef;
  3791. begin
  3792. I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@DoEchoFloat);
  3793. AssertEquals('List is dirty',True,FP.Dirty);
  3794. AssertNotNull('Addvariable returns result',I);
  3795. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3796. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3797. AssertEquals('Function has correct resulttype',rtFloat,I.ResultType);
  3798. // AssertSame('Function has correct address',Pointer(@EchoFloat),Pointer(I.OnGetFunctionValueCallBack));
  3799. end;
  3800. procedure TTestParserFunctions.TestFunction11;
  3801. Var
  3802. I : TFPExprIdentifierDef;
  3803. begin
  3804. I:=FP.Identifiers.AddFunction('EchoString','S','S',@DoEchoString);
  3805. AssertEquals('List is dirty',True,FP.Dirty);
  3806. AssertNotNull('Addvariable returns result',I);
  3807. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3808. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3809. AssertEquals('Function has correct resulttype',rtString,I.ResultType);
  3810. // AssertSame('Function has correct address',Pointer(@EchoString),Pointer(I.OnGetFunctionValueCallBack));
  3811. end;
  3812. procedure TTestParserFunctions.TestFunction12;
  3813. Var
  3814. I : TFPExprIdentifierDef;
  3815. D : TDateTime;
  3816. begin
  3817. D:=Date;
  3818. I:=FP.Identifiers.AddFunction('Date','D','',@GetDate);
  3819. FP.Expression:='Date';
  3820. AssertNotNull('Have result node',FP.ExprNode);
  3821. AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
  3822. AssertResultType(rtDateTime);
  3823. AssertDateTimeResult(D);
  3824. end;
  3825. procedure TTestParserFunctions.TestFunction13;
  3826. Var
  3827. I : TFPExprIdentifierDef;
  3828. D : TDateTime;
  3829. begin
  3830. D:=Date;
  3831. I:=FP.Identifiers.AddDateTimeVariable('a',D);
  3832. I:=FP.Identifiers.AddFunction('EchoDate','D','D',@EchoDate);
  3833. FP.Expression:='EchoDate(a)';
  3834. AssertNotNull('Have result node',FP.ExprNode);
  3835. AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
  3836. AssertResultType(rtDateTime);
  3837. AssertDateTimeResult(D);
  3838. end;
  3839. procedure TTestParserFunctions.TestFunction14;
  3840. Var
  3841. I : TFPExprIdentifierDef;
  3842. D : TDateTime;
  3843. begin
  3844. D:=Date;
  3845. I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@EchoInteger);
  3846. FP.Expression:='EchoInteger(13)';
  3847. AssertNotNull('Have result node',FP.ExprNode);
  3848. AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
  3849. AssertResultType(rtInteger);
  3850. AssertResult(13);
  3851. end;
  3852. procedure TTestParserFunctions.TestFunction15;
  3853. Var
  3854. I : TFPExprIdentifierDef;
  3855. D : TDateTime;
  3856. begin
  3857. D:=Date;
  3858. I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@EchoBoolean);
  3859. FP.Expression:='EchoBoolean(True)';
  3860. AssertNotNull('Have result node',FP.ExprNode);
  3861. AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
  3862. AssertResultType(rtBoolean);
  3863. AssertResult(True);
  3864. end;
  3865. procedure TTestParserFunctions.TestFunction16;
  3866. Var
  3867. I : TFPExprIdentifierDef;
  3868. D : TDateTime;
  3869. begin
  3870. D:=Date;
  3871. I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@EchoFloat);
  3872. FP.Expression:='EchoFloat(1.234)';
  3873. AssertNotNull('Have result node',FP.ExprNode);
  3874. AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
  3875. AssertResultType(rtFloat);
  3876. AssertResult(1.234);
  3877. end;
  3878. procedure TTestParserFunctions.TestFunction17;
  3879. Var
  3880. I : TFPExprIdentifierDef;
  3881. D : TDateTime;
  3882. begin
  3883. D:=Date;
  3884. I:=FP.Identifiers.AddFunction('EchoString','S','S',@EchoString);
  3885. FP.Expression:='EchoString(''Aloha'')';
  3886. AssertNotNull('Have result node',FP.ExprNode);
  3887. AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
  3888. AssertResultType(rtString);
  3889. AssertResult('Aloha');
  3890. end;
  3891. procedure TTestParserFunctions.TestFunction18;
  3892. Var
  3893. I : TFPExprIdentifierDef;
  3894. D : TDateTime;
  3895. begin
  3896. D:=Date;
  3897. I:=FP.Identifiers.AddDateTimeVariable('a',D);
  3898. I:=FP.Identifiers.AddFunction('EchoDate','D','D',@DoEchoDate);
  3899. FP.Expression:='EchoDate(a)';
  3900. AssertNotNull('Have result node',FP.ExprNode);
  3901. AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
  3902. AssertResultType(rtDateTime);
  3903. AssertDateTimeResult(D);
  3904. end;
  3905. procedure TTestParserFunctions.TestFunction19;
  3906. Var
  3907. I : TFPExprIdentifierDef;
  3908. D : TDateTime;
  3909. begin
  3910. D:=Date;
  3911. I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@DoEchoInteger);
  3912. FP.Expression:='EchoInteger(13)';
  3913. AssertNotNull('Have result node',FP.ExprNode);
  3914. AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
  3915. AssertResultType(rtInteger);
  3916. AssertResult(13);
  3917. end;
  3918. procedure TTestParserFunctions.TestFunction20;
  3919. Var
  3920. I : TFPExprIdentifierDef;
  3921. D : TDateTime;
  3922. begin
  3923. D:=Date;
  3924. I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@DoEchoBoolean);
  3925. FP.Expression:='EchoBoolean(True)';
  3926. AssertNotNull('Have result node',FP.ExprNode);
  3927. AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
  3928. AssertResultType(rtBoolean);
  3929. AssertResult(True);
  3930. end;
  3931. procedure TTestParserFunctions.TestFunction21;
  3932. Var
  3933. I : TFPExprIdentifierDef;
  3934. D : TDateTime;
  3935. begin
  3936. D:=Date;
  3937. I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@DoEchoFloat);
  3938. FP.Expression:='EchoFloat(1.234)';
  3939. AssertNotNull('Have result node',FP.ExprNode);
  3940. AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
  3941. AssertResultType(rtFloat);
  3942. AssertResult(1.234);
  3943. end;
  3944. procedure TTestParserFunctions.TestFunction22;
  3945. Var
  3946. I : TFPExprIdentifierDef;
  3947. D : TDateTime;
  3948. begin
  3949. D:=Date;
  3950. I:=FP.Identifiers.AddFunction('EchoString','S','S',@DoEchoString);
  3951. FP.Expression:='EchoString(''Aloha'')';
  3952. AssertNotNull('Have result node',FP.ExprNode);
  3953. AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
  3954. AssertResultType(rtString);
  3955. AssertResult('Aloha');
  3956. end;
  3957. procedure TTestParserFunctions.TestFunction23;
  3958. Var
  3959. I : TFPExprIdentifierDef;
  3960. D : TDateTime;
  3961. begin
  3962. D:=Date;
  3963. I:=FP.Identifiers.AddFunction('Date','D','',@DoGetDate);
  3964. AssertEquals('List is dirty',True,FP.Dirty);
  3965. AssertNotNull('Addvariable returns result',I);
  3966. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3967. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3968. AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
  3969. FP.Expression:='Date';
  3970. AssertNotNull('Have result node',FP.ExprNode);
  3971. AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
  3972. AssertResultType(rtDateTime);
  3973. AssertDateTimeResult(D);
  3974. end;
  3975. procedure TTestParserFunctions.TestFunction24;
  3976. Var
  3977. I : TFPExprIdentifierDef;
  3978. begin
  3979. I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
  3980. AssertEquals('List is dirty',True,FP.Dirty);
  3981. AssertNotNull('Addvariable returns result',I);
  3982. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3983. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  3984. AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
  3985. FP.Expression:='AddInteger(1,2)';
  3986. AssertNotNull('Have result node',FP.ExprNode);
  3987. AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
  3988. AssertResultType(rtInteger);
  3989. AssertResult(3);
  3990. end;
  3991. procedure TTestParserFunctions.TestFunction25;
  3992. Var
  3993. I : TFPExprIdentifierDef;
  3994. begin
  3995. I:=FP.Identifiers.AddFunction('Delete','S','SII',@DoDeleteString);
  3996. AssertEquals('List is dirty',True,FP.Dirty);
  3997. AssertNotNull('Addvariable returns result',I);
  3998. AssertEquals('One variable added',1,FP.Identifiers.Count);
  3999. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  4000. AssertEquals('Function has correct resulttype',rtString,I.ResultType);
  4001. FP.Expression:='Delete(''ABCDEFGHIJ'',3,2)';
  4002. AssertNotNull('Have result node',FP.ExprNode);
  4003. AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
  4004. AssertResultType(rtString);
  4005. AssertResult('ABEFGHIJ');
  4006. end;
  4007. procedure TTestParserFunctions.TestFunction26;
  4008. Var
  4009. I : TFPExprIdentifierDef;
  4010. begin
  4011. I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
  4012. AssertEquals('List is dirty',True,FP.Dirty);
  4013. AssertNotNull('Addvariable returns result',I);
  4014. AssertEquals('One variable added',1,FP.Identifiers.Count);
  4015. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  4016. AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
  4017. FP.Expression:='AddInteger(1,2+3)';
  4018. AssertNotNull('Have result node',FP.ExprNode);
  4019. AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
  4020. AssertResultType(rtInteger);
  4021. AssertResult(6);
  4022. end;
  4023. procedure TTestParserFunctions.TestFunction27;
  4024. Var
  4025. I : TFPExprIdentifierDef;
  4026. begin
  4027. I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
  4028. AssertEquals('List is dirty',True,FP.Dirty);
  4029. AssertNotNull('Addvariable returns result',I);
  4030. AssertEquals('One variable added',1,FP.Identifiers.Count);
  4031. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  4032. AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
  4033. FP.Expression:='AddInteger(1+2,3*4)';
  4034. AssertNotNull('Have result node',FP.ExprNode);
  4035. AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
  4036. AssertResultType(rtInteger);
  4037. AssertResult(15);
  4038. end;
  4039. procedure TTestParserFunctions.TestFunction28;
  4040. Var
  4041. I : TFPExprIdentifierDef;
  4042. begin
  4043. I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
  4044. AssertEquals('List is dirty',True,FP.Dirty);
  4045. AssertNotNull('Addvariable returns result',I);
  4046. AssertEquals('One variable added',1,FP.Identifiers.Count);
  4047. AssertSame('Result equals variable added',I,FP.Identifiers[0]);
  4048. AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
  4049. FP.Expression:='AddInteger(3 and 2,3*4)';
  4050. AssertNotNull('Have result node',FP.ExprNode);
  4051. AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
  4052. AssertResultType(rtInteger);
  4053. AssertResult(14);
  4054. end;
  4055. procedure TTestParserFunctions.TestFunction29;
  4056. Var
  4057. I : TFPExprIdentifierDef;
  4058. begin
  4059. // Test type mismatch
  4060. I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
  4061. TestParser('AddInteger(3 and 2,''s'')');
  4062. end;
  4063. { TTestBuiltinsManager }
  4064. procedure TTestBuiltinsManager.Setup;
  4065. begin
  4066. inherited Setup;
  4067. FM:=TExprBuiltInManager.Create(Nil);
  4068. end;
  4069. procedure TTestBuiltinsManager.Teardown;
  4070. begin
  4071. FreeAndNil(FM);
  4072. inherited Teardown;
  4073. end;
  4074. procedure TTestBuiltinsManager.TestCreate;
  4075. begin
  4076. AssertEquals('Have no builtin expressions',0,FM.IdentifierCount);
  4077. end;
  4078. procedure TTestBuiltinsManager.TestVariable1;
  4079. Var
  4080. I : TFPBuiltinExprIdentifierDef;
  4081. begin
  4082. I:=FM.AddVariable(bcuser,'a',rtBoolean,'True');
  4083. AssertNotNull('Addvariable returns result',I);
  4084. AssertEquals('One variable added',1,FM.IdentifierCount);
  4085. AssertSame('Result equals variable added',I,FM.Identifiers[0]);
  4086. AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
  4087. AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
  4088. AssertEquals('Variable has correct value','True',I.Value);
  4089. end;
  4090. procedure TTestBuiltinsManager.TestVariable2;
  4091. Var
  4092. I : TFPBuiltinExprIdentifierDef;
  4093. begin
  4094. I:=FM.AddBooleanVariable(bcUser,'a',False);
  4095. AssertNotNull('Addvariable returns result',I);
  4096. AssertEquals('One variable added',1,FM.IdentifierCount);
  4097. AssertSame('Result equals variable added',I,FM.Identifiers[0]);
  4098. AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
  4099. AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
  4100. AssertEquals('Variable has correct value','False',I.Value);
  4101. end;
  4102. procedure TTestBuiltinsManager.TestVariable3;
  4103. Var
  4104. I : TFPBuiltinExprIdentifierDef;
  4105. begin
  4106. I:=FM.AddIntegerVariable(bcUser,'a',123);
  4107. AssertNotNull('Addvariable returns result',I);
  4108. AssertEquals('One variable added',1,FM.IdentifierCount);
  4109. AssertSame('Result equals variable added',I,FM.Identifiers[0]);
  4110. AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
  4111. AssertEquals('Variable has correct resulttype',rtInteger,I.ResultType);
  4112. AssertEquals('Variable has correct value','123',I.Value);
  4113. end;
  4114. procedure TTestBuiltinsManager.TestVariable4;
  4115. Var
  4116. I : TFPBuiltinExprIdentifierDef;
  4117. begin
  4118. I:=FM.AddFloatVariable(bcUser,'a',1.23);
  4119. AssertNotNull('Addvariable returns result',I);
  4120. AssertEquals('One variable added',1,FM.IdentifierCount);
  4121. AssertSame('Result equals variable added',I,FM.Identifiers[0]);
  4122. AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
  4123. AssertEquals('Variable has correct resulttype',rtFloat,I.ResultType);
  4124. AssertEquals('Variable has correct value',FloatToStr(1.23),I.Value);
  4125. end;
  4126. procedure TTestBuiltinsManager.TestVariable5;
  4127. Var
  4128. I : TFPBuiltinExprIdentifierDef;
  4129. begin
  4130. I:=FM.AddStringVariable(bcUser,'a','1.23');
  4131. AssertNotNull('Addvariable returns result',I);
  4132. AssertEquals('One variable added',1,FM.IdentifierCount);
  4133. AssertSame('Result equals variable added',I,FM.Identifiers[0]);
  4134. AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
  4135. AssertEquals('Variable has correct resulttype',rtString,I.ResultType);
  4136. AssertEquals('Variable has correct value','1.23',I.Value);
  4137. end;
  4138. procedure TTestBuiltinsManager.TestVariable6;
  4139. Var
  4140. I : TFPBuiltinExprIdentifierDef;
  4141. D : TDateTime;
  4142. begin
  4143. D:=Now;
  4144. I:=FM.AddDateTimeVariable(bcUser,'a',D);
  4145. AssertNotNull('Addvariable returns result',I);
  4146. AssertEquals('One variable added',1,FM.IdentifierCount);
  4147. AssertSame('Result equals variable added',I,FM.Identifiers[0]);
  4148. AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
  4149. AssertEquals('Variable has correct resulttype',rtDateTime,I.ResultType);
  4150. AssertEquals('Variable has correct value',FormatDateTime('cccc',D),I.Value);
  4151. end;
  4152. procedure TTestBuiltinsManager.TestFunction1;
  4153. Var
  4154. I : TFPBuiltinExprIdentifierDef;
  4155. begin
  4156. I:=FM.AddFunction(bcUser,'Date','D','',@GetDate);
  4157. AssertNotNull('Addvariable returns result',I);
  4158. AssertEquals('One variable added',1,FM.IdentifierCount);
  4159. AssertSame('Result equals variable added',I,FM.Identifiers[0]);
  4160. AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
  4161. AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
  4162. AssertSame('Function has correct address',Pointer(@GetDate),Pointer(I.OnGetFunctionValueCallBack));
  4163. end;
  4164. procedure TTestBuiltinsManager.TestFunction2;
  4165. Var
  4166. I,I2 : TFPBuiltinExprIdentifierDef;
  4167. ind : Integer;
  4168. begin
  4169. FM.AddFunction(bcUser,'EchoDate','D','D',@EchoDate);
  4170. I:=FM.AddFunction(bcUser,'Echo','D','D',@EchoDate);
  4171. FM.AddFunction(bcUser,'DoEcho','D','D',@EchoDate);
  4172. ind:=FM.IndexOfIdentifier('Echo');
  4173. AssertEquals('Found identifier',1,ind);
  4174. I2:=FM.FindIdentifier('Echo');
  4175. AssertNotNull('FindIdentifier returns result',I2);
  4176. AssertSame('Findidentifier returns correct result',I,I2);
  4177. ind:=FM.IndexOfIdentifier('NoNoNo');
  4178. AssertEquals('Found no such identifier',-1,ind);
  4179. I2:=FM.FindIdentifier('NoNoNo');
  4180. AssertNull('FindIdentifier returns no result',I2);
  4181. end;
  4182. { TTestBuiltins }
  4183. procedure TTestBuiltins.Setup;
  4184. begin
  4185. inherited Setup;
  4186. FM:=TExprBuiltInManager.Create(Nil);
  4187. end;
  4188. procedure TTestBuiltins.Teardown;
  4189. begin
  4190. FreeAndNil(FM);
  4191. inherited Teardown;
  4192. end;
  4193. procedure TTestBuiltins.SetExpression(Const AExpression : String);
  4194. Var
  4195. Msg : String;
  4196. begin
  4197. Msg:='';
  4198. try
  4199. FP.Expression:=AExpression;
  4200. except
  4201. On E : Exception do
  4202. Msg:=E.message;
  4203. end;
  4204. If (Msg<>'') then
  4205. Fail('Parsing of expression "'+AExpression+'" failed :'+Msg);
  4206. end;
  4207. procedure TTestBuiltins.AssertVariable(const ADefinition: String;
  4208. AResultType: TResultType);
  4209. Var
  4210. I : TFPBuiltinExprIdentifierDef;
  4211. begin
  4212. I:=FM.FindIdentifier(ADefinition);
  4213. AssertNotNull('Definition '+ADefinition+' is present.',I);
  4214. AssertEquals('Correct result type',AResultType,I.ResultType);
  4215. end;
  4216. procedure TTestBuiltins.AssertFunction(const ADefinition, AResultType,
  4217. ArgumentTypes: String; ACategory : TBuiltinCategory);
  4218. Var
  4219. I : TFPBuiltinExprIdentifierDef;
  4220. begin
  4221. I:=FM.FindIdentifier(ADefinition);
  4222. AssertEquals('Correct result type for test',1,Length(AResultType));
  4223. AssertNotNull('Definition '+ADefinition+' is present.',I);
  4224. AssertEquals(ADefinition+' has correct parameter types',ArgumentTypes,I.ParameterTypes);
  4225. AssertEquals(ADefinition+' has correct result type',CharToResultType(AResultType[1]),I.ResultType);
  4226. AssertEquals(ADefinition+' has correct category',Ord(ACategory),Ord(I.Category));
  4227. end;
  4228. procedure TTestBuiltins.AssertExpression(const AExpression: String;
  4229. AResult: Int64);
  4230. begin
  4231. FP.BuiltIns:=AllBuiltIns;
  4232. SetExpression(AExpression);
  4233. AssertResult(AResult);
  4234. end;
  4235. procedure TTestBuiltins.AssertExpression(const AExpression: String;
  4236. const AResult: String);
  4237. begin
  4238. FP.BuiltIns:=AllBuiltIns;
  4239. SetExpression(AExpression);
  4240. AssertResult(AResult);
  4241. end;
  4242. procedure TTestBuiltins.AssertExpression(const AExpression: String;
  4243. const AResult: TExprFloat);
  4244. begin
  4245. FP.BuiltIns:=AllBuiltIns;
  4246. SetExpression(AExpression);
  4247. AssertResult(AResult);
  4248. end;
  4249. procedure TTestBuiltins.AssertExpression(const AExpression: String;
  4250. const AResult: Boolean);
  4251. begin
  4252. FP.BuiltIns:=AllBuiltIns;
  4253. SetExpression(AExpression);
  4254. AssertResult(AResult);
  4255. end;
  4256. procedure TTestBuiltins.AssertDateTimeExpression(const AExpression: String;
  4257. const AResult: TDateTime);
  4258. begin
  4259. FP.BuiltIns:=AllBuiltIns;
  4260. SetExpression(AExpression);
  4261. AssertDatetimeResult(AResult);
  4262. end;
  4263. procedure TTestBuiltins.TestRegister;
  4264. begin
  4265. RegisterStdBuiltins(FM);
  4266. AssertEquals('Correct number of identifiers',64,FM.IdentifierCount);
  4267. Assertvariable('pi',rtFloat);
  4268. AssertFunction('cos','F','F',bcMath);
  4269. AssertFunction('sin','F','F',bcMath);
  4270. AssertFunction('arctan','F','F',bcMath);
  4271. AssertFunction('abs','F','F',bcMath);
  4272. AssertFunction('sqr','F','F',bcMath);
  4273. AssertFunction('sqrt','F','F',bcMath);
  4274. AssertFunction('exp','F','F',bcMath);
  4275. AssertFunction('ln','F','F',bcMath);
  4276. AssertFunction('log','F','F',bcMath);
  4277. AssertFunction('frac','F','F',bcMath);
  4278. AssertFunction('int','F','F',bcMath);
  4279. AssertFunction('round','I','F',bcMath);
  4280. AssertFunction('trunc','I','F',bcMath);
  4281. AssertFunction('length','I','S',bcStrings);
  4282. AssertFunction('copy','S','SII',bcStrings);
  4283. AssertFunction('delete','S','SII',bcStrings);
  4284. AssertFunction('pos','I','SS',bcStrings);
  4285. AssertFunction('lowercase','S','S',bcStrings);
  4286. AssertFunction('uppercase','S','S',bcStrings);
  4287. AssertFunction('stringreplace','S','SSSBB',bcStrings);
  4288. AssertFunction('comparetext','I','SS',bcStrings);
  4289. AssertFunction('date','D','',bcDateTime);
  4290. AssertFunction('time','D','',bcDateTime);
  4291. AssertFunction('now','D','',bcDateTime);
  4292. AssertFunction('dayofweek','I','D',bcDateTime);
  4293. AssertFunction('extractyear','I','D',bcDateTime);
  4294. AssertFunction('extractmonth','I','D',bcDateTime);
  4295. AssertFunction('extractday','I','D',bcDateTime);
  4296. AssertFunction('extracthour','I','D',bcDateTime);
  4297. AssertFunction('extractmin','I','D',bcDateTime);
  4298. AssertFunction('extractsec','I','D',bcDateTime);
  4299. AssertFunction('extractmsec','I','D',bcDateTime);
  4300. AssertFunction('encodedate','D','III',bcDateTime);
  4301. AssertFunction('encodetime','D','IIII',bcDateTime);
  4302. AssertFunction('encodedatetime','D','IIIIIII',bcDateTime);
  4303. AssertFunction('shortdayname','S','I',bcDateTime);
  4304. AssertFunction('shortmonthname','S','I',bcDateTime);
  4305. AssertFunction('longdayname','S','I',bcDateTime);
  4306. AssertFunction('longmonthname','S','I',bcDateTime);
  4307. AssertFunction('formatdatetime','S','SD',bcDateTime);
  4308. AssertFunction('shl','I','II',bcBoolean);
  4309. AssertFunction('shr','I','II',bcBoolean);
  4310. AssertFunction('IFS','S','BSS',bcBoolean);
  4311. AssertFunction('IFF','F','BFF',bcBoolean);
  4312. AssertFunction('IFD','D','BDD',bcBoolean);
  4313. AssertFunction('IFI','I','BII',bcBoolean);
  4314. AssertFunction('inttostr','S','I',bcConversion);
  4315. AssertFunction('strtoint','I','S',bcConversion);
  4316. AssertFunction('strtointdef','I','SI',bcConversion);
  4317. AssertFunction('floattostr','S','F',bcConversion);
  4318. AssertFunction('strtofloat','F','S',bcConversion);
  4319. AssertFunction('strtofloatdef','F','SF',bcConversion);
  4320. AssertFunction('booltostr','S','B',bcConversion);
  4321. AssertFunction('strtobool','B','S',bcConversion);
  4322. AssertFunction('strtobooldef','B','SB',bcConversion);
  4323. AssertFunction('datetostr','S','D',bcConversion);
  4324. AssertFunction('timetostr','S','D',bcConversion);
  4325. AssertFunction('strtodate','D','S',bcConversion);
  4326. AssertFunction('strtodatedef','D','SD',bcConversion);
  4327. AssertFunction('strtotime','D','S',bcConversion);
  4328. AssertFunction('strtotimedef','D','SD',bcConversion);
  4329. AssertFunction('strtodatetime','D','S',bcConversion);
  4330. AssertFunction('strtodatetimedef','D','SD',bcConversion);
  4331. end;
  4332. procedure TTestBuiltins.TestVariablepi;
  4333. begin
  4334. AssertExpression('pi',Pi);
  4335. end;
  4336. procedure TTestBuiltins.TestFunctioncos;
  4337. begin
  4338. AssertExpression('cos(0.5)',Cos(0.5));
  4339. AssertExpression('cos(0.75)',Cos(0.75));
  4340. end;
  4341. procedure TTestBuiltins.TestFunctionsin;
  4342. begin
  4343. AssertExpression('sin(0.5)',sin(0.5));
  4344. AssertExpression('sin(0.75)',sin(0.75));
  4345. end;
  4346. procedure TTestBuiltins.TestFunctionarctan;
  4347. begin
  4348. AssertExpression('arctan(0.5)',arctan(0.5));
  4349. AssertExpression('arctan(0.75)',arctan(0.75));
  4350. end;
  4351. procedure TTestBuiltins.TestFunctionabs;
  4352. begin
  4353. AssertExpression('abs(0.5)',0.5);
  4354. AssertExpression('abs(-0.75)',0.75);
  4355. end;
  4356. procedure TTestBuiltins.TestFunctionsqr;
  4357. begin
  4358. AssertExpression('sqr(0.5)',sqr(0.5));
  4359. AssertExpression('sqr(-0.75)',sqr(0.75));
  4360. end;
  4361. procedure TTestBuiltins.TestFunctionsqrt;
  4362. begin
  4363. AssertExpression('sqrt(0.5)',sqrt(0.5));
  4364. AssertExpression('sqrt(0.75)',sqrt(0.75));
  4365. end;
  4366. procedure TTestBuiltins.TestFunctionexp;
  4367. begin
  4368. AssertExpression('exp(1.0)',exp(1));
  4369. AssertExpression('exp(0.0)',1.0);
  4370. end;
  4371. procedure TTestBuiltins.TestFunctionln;
  4372. begin
  4373. AssertExpression('ln(0.5)',ln(0.5));
  4374. AssertExpression('ln(1.5)',ln(1.5));
  4375. end;
  4376. procedure TTestBuiltins.TestFunctionlog;
  4377. begin
  4378. AssertExpression('log(0.5)',ln(0.5)/ln(10.0));
  4379. AssertExpression('log(1.5)',ln(1.5)/ln(10.0));
  4380. AssertExpression('log(10.0)',1.0);
  4381. end;
  4382. procedure TTestBuiltins.TestFunctionfrac;
  4383. begin
  4384. AssertExpression('frac(0.5)',frac(0.5));
  4385. AssertExpression('frac(1.5)',frac(1.5));
  4386. end;
  4387. procedure TTestBuiltins.TestFunctionint;
  4388. begin
  4389. AssertExpression('int(0.5)',int(0.5));
  4390. AssertExpression('int(1.5)',int(1.5));
  4391. end;
  4392. procedure TTestBuiltins.TestFunctionround;
  4393. begin
  4394. AssertExpression('round(0.5)',round(0.5));
  4395. AssertExpression('round(1.55)',round(1.55));
  4396. end;
  4397. procedure TTestBuiltins.TestFunctiontrunc;
  4398. begin
  4399. AssertExpression('trunc(0.5)',trunc(0.5));
  4400. AssertExpression('trunc(1.55)',trunc(1.55));
  4401. end;
  4402. procedure TTestBuiltins.TestFunctionlength;
  4403. begin
  4404. AssertExpression('length(''123'')',3);
  4405. end;
  4406. procedure TTestBuiltins.TestFunctioncopy;
  4407. begin
  4408. AssertExpression('copy(''123456'',2,4)','2345');
  4409. end;
  4410. procedure TTestBuiltins.TestFunctiondelete;
  4411. begin
  4412. AssertExpression('delete(''123456'',2,4)','16');
  4413. end;
  4414. procedure TTestBuiltins.TestFunctionpos;
  4415. begin
  4416. AssertExpression('pos(''234'',''123456'')',2);
  4417. end;
  4418. procedure TTestBuiltins.TestFunctionlowercase;
  4419. begin
  4420. AssertExpression('lowercase(''AbCdEf'')','abcdef');
  4421. end;
  4422. procedure TTestBuiltins.TestFunctionuppercase;
  4423. begin
  4424. AssertExpression('uppercase(''AbCdEf'')','ABCDEF');
  4425. end;
  4426. procedure TTestBuiltins.TestFunctionstringreplace;
  4427. begin
  4428. // last options are replaceall, ignorecase
  4429. AssertExpression('stringreplace(''AbCdEf'',''C'',''Z'',false,false)','AbZdEf');
  4430. AssertExpression('stringreplace(''AbCdEf'',''c'',''Z'',false,false)','AbCdEf');
  4431. AssertExpression('stringreplace(''AbCdEf'',''c'',''Z'',false,true)','AbZdEf');
  4432. AssertExpression('stringreplace(''AbCdEfC'',''C'',''Z'',false,false)','AbZdEfC');
  4433. AssertExpression('stringreplace(''AbCdEfC'',''C'',''Z'',True,false)','AbZdEfZ');
  4434. end;
  4435. procedure TTestBuiltins.TestFunctioncomparetext;
  4436. begin
  4437. AssertExpression('comparetext(''AbCdEf'',''AbCdEf'')',0);
  4438. AssertExpression('comparetext(''AbCdEf'',''ABCDEF'')',0);
  4439. AssertExpression('comparetext(''AbCdEf'',''FEDCBA'')',comparetext('AbCdEf','FEDCBA'));
  4440. end;
  4441. procedure TTestBuiltins.TestFunctiondate;
  4442. begin
  4443. AssertExpression('date',date);
  4444. end;
  4445. procedure TTestBuiltins.TestFunctiontime;
  4446. begin
  4447. AssertExpression('time',time);
  4448. end;
  4449. procedure TTestBuiltins.TestFunctionnow;
  4450. begin
  4451. AssertExpression('now',now);
  4452. end;
  4453. procedure TTestBuiltins.TestFunctiondayofweek;
  4454. begin
  4455. FP.Identifiers.AddDateTimeVariable('D',Date);
  4456. AssertExpression('dayofweek(d)',DayOfWeek(date));
  4457. end;
  4458. procedure TTestBuiltins.TestFunctionextractyear;
  4459. Var
  4460. Y,M,D : Word;
  4461. begin
  4462. DecodeDate(Date,Y,M,D);
  4463. FP.Identifiers.AddDateTimeVariable('D',Date);
  4464. AssertExpression('extractyear(d)',Y);
  4465. end;
  4466. procedure TTestBuiltins.TestFunctionextractmonth;
  4467. Var
  4468. Y,M,D : Word;
  4469. begin
  4470. FP.Identifiers.AddDateTimeVariable('D',Date);
  4471. DecodeDate(Date,Y,M,D);
  4472. AssertExpression('extractmonth(d)',M);
  4473. end;
  4474. procedure TTestBuiltins.TestFunctionextractday;
  4475. Var
  4476. Y,M,D : Word;
  4477. begin
  4478. DecodeDate(Date,Y,M,D);
  4479. FP.Identifiers.AddDateTimeVariable('D',Date);
  4480. AssertExpression('extractday(d)',D);
  4481. end;
  4482. procedure TTestBuiltins.TestFunctionextracthour;
  4483. Var
  4484. T : TDateTime;
  4485. H,m,s,ms : Word;
  4486. begin
  4487. T:=Time;
  4488. DecodeTime(T,h,m,s,ms);
  4489. FP.Identifiers.AddDateTimeVariable('T',T);
  4490. AssertExpression('extracthour(t)',h);
  4491. end;
  4492. procedure TTestBuiltins.TestFunctionextractmin;
  4493. Var
  4494. T : TDateTime;
  4495. H,m,s,ms : Word;
  4496. begin
  4497. T:=Time;
  4498. DecodeTime(T,h,m,s,ms);
  4499. FP.Identifiers.AddDateTimeVariable('T',T);
  4500. AssertExpression('extractmin(t)',m);
  4501. end;
  4502. procedure TTestBuiltins.TestFunctionextractsec;
  4503. Var
  4504. T : TDateTime;
  4505. H,m,s,ms : Word;
  4506. begin
  4507. T:=Time;
  4508. DecodeTime(T,h,m,s,ms);
  4509. FP.Identifiers.AddDateTimeVariable('T',T);
  4510. AssertExpression('extractsec(t)',s);
  4511. end;
  4512. procedure TTestBuiltins.TestFunctionextractmsec;
  4513. Var
  4514. T : TDateTime;
  4515. H,m,s,ms : Word;
  4516. begin
  4517. T:=Time;
  4518. DecodeTime(T,h,m,s,ms);
  4519. FP.Identifiers.AddDateTimeVariable('T',T);
  4520. AssertExpression('extractmsec(t)',ms);
  4521. end;
  4522. procedure TTestBuiltins.TestFunctionencodedate;
  4523. begin
  4524. AssertExpression('encodedate(2008,10,11)',EncodeDate(2008,10,11));
  4525. end;
  4526. procedure TTestBuiltins.TestFunctionencodetime;
  4527. begin
  4528. AssertExpression('encodetime(14,10,11,0)',EncodeTime(14,10,11,0));
  4529. end;
  4530. procedure TTestBuiltins.TestFunctionencodedatetime;
  4531. begin
  4532. AssertExpression('encodedatetime(2008,12,13,14,10,11,0)',EncodeDate(2008,12,13)+EncodeTime(14,10,11,0));
  4533. end;
  4534. procedure TTestBuiltins.TestFunctionshortdayname;
  4535. begin
  4536. AssertExpression('shortdayname(1)',ShortDayNames[1]);
  4537. AssertExpression('shortdayname(7)',ShortDayNames[7]);
  4538. end;
  4539. procedure TTestBuiltins.TestFunctionshortmonthname;
  4540. begin
  4541. AssertExpression('shortmonthname(1)',ShortMonthNames[1]);
  4542. AssertExpression('shortmonthname(12)',ShortMonthNames[12]);
  4543. end;
  4544. procedure TTestBuiltins.TestFunctionlongdayname;
  4545. begin
  4546. AssertExpression('longdayname(1)',longDayNames[1]);
  4547. AssertExpression('longdayname(7)',longDayNames[7]);
  4548. end;
  4549. procedure TTestBuiltins.TestFunctionlongmonthname;
  4550. begin
  4551. AssertExpression('longmonthname(1)',longMonthNames[1]);
  4552. AssertExpression('longmonthname(12)',longMonthNames[12]);
  4553. end;
  4554. procedure TTestBuiltins.TestFunctionformatdatetime;
  4555. begin
  4556. AssertExpression('FormatDateTime(''cccc'',Date)',FormatDateTime('cccc',Date));
  4557. end;
  4558. procedure TTestBuiltins.TestFunctionshl;
  4559. Var
  4560. I : Int64;
  4561. begin
  4562. AssertExpression('shl(12,3)',12 shl 3);
  4563. I:=12 shl 30;
  4564. AssertExpression('shl(12,30)',I);
  4565. end;
  4566. procedure TTestBuiltins.TestFunctionshr;
  4567. begin
  4568. AssertExpression('shr(12,2)',12 shr 2);
  4569. end;
  4570. procedure TTestBuiltins.TestFunctionIFS;
  4571. begin
  4572. AssertExpression('ifs(true,''string1'',''string2'')','string1');
  4573. AssertExpression('ifs(false,''string1'',''string2'')','string2');
  4574. end;
  4575. procedure TTestBuiltins.TestFunctionIFF;
  4576. begin
  4577. AssertExpression('iff(true,1.0,2.0)',1.0);
  4578. AssertExpression('iff(false,1.0,2.0)',2.0);
  4579. end;
  4580. procedure TTestBuiltins.TestFunctionIFD;
  4581. begin
  4582. FP.Identifiers.AddDateTimeVariable('A',Date);
  4583. FP.Identifiers.AddDateTimeVariable('B',Date-1);
  4584. AssertExpression('ifd(true,A,B)',Date);
  4585. AssertExpression('ifd(false,A,B)',Date-1);
  4586. end;
  4587. procedure TTestBuiltins.TestFunctionIFI;
  4588. begin
  4589. AssertExpression('ifi(true,1,2)',1);
  4590. AssertExpression('ifi(false,1,2)',2);
  4591. end;
  4592. procedure TTestBuiltins.TestFunctioninttostr;
  4593. begin
  4594. AssertExpression('inttostr(2)','2');
  4595. end;
  4596. procedure TTestBuiltins.TestFunctionstrtoint;
  4597. begin
  4598. AssertExpression('strtoint(''2'')',2);
  4599. end;
  4600. procedure TTestBuiltins.TestFunctionstrtointdef;
  4601. begin
  4602. AssertExpression('strtointdef(''abc'',2)',2);
  4603. end;
  4604. procedure TTestBuiltins.TestFunctionfloattostr;
  4605. begin
  4606. AssertExpression('floattostr(1.23)',Floattostr(1.23));
  4607. end;
  4608. procedure TTestBuiltins.TestFunctionstrtofloat;
  4609. Var
  4610. S : String;
  4611. begin
  4612. S:='1.23';
  4613. S[2]:=DecimalSeparator;
  4614. AssertExpression('strtofloat('''+S+''')',1.23);
  4615. end;
  4616. procedure TTestBuiltins.TestFunctionstrtofloatdef;
  4617. begin
  4618. AssertExpression('strtofloatdef(''abc'',1.23)',1.23);
  4619. end;
  4620. procedure TTestBuiltins.TestFunctionbooltostr;
  4621. begin
  4622. AssertExpression('strtofloatdef(''abc'',1.23)',1.23);
  4623. end;
  4624. procedure TTestBuiltins.TestFunctionstrtobool;
  4625. begin
  4626. AssertExpression('strtobool(''0'')',false);
  4627. end;
  4628. procedure TTestBuiltins.TestFunctionstrtobooldef;
  4629. begin
  4630. AssertExpression('strtobooldef(''XYZ'',True)',True);
  4631. end;
  4632. procedure TTestBuiltins.TestFunctiondatetostr;
  4633. begin
  4634. FP.Identifiers.AddDateTimeVariable('A',Date);
  4635. AssertExpression('DateToStr(A)',DateToStr(Date));
  4636. end;
  4637. procedure TTestBuiltins.TestFunctiontimetostr;
  4638. Var
  4639. T : TDateTime;
  4640. begin
  4641. T:=Time;
  4642. FP.Identifiers.AddDateTimeVariable('A',T);
  4643. AssertExpression('TimeToStr(A)',TimeToStr(T));
  4644. end;
  4645. procedure TTestBuiltins.TestFunctionstrtodate;
  4646. begin
  4647. FP.Identifiers.AddStringVariable('S',DateToStr(Date));
  4648. AssertExpression('StrToDate(S)',Date);
  4649. end;
  4650. procedure TTestBuiltins.TestFunctionstrtodatedef;
  4651. begin
  4652. FP.Identifiers.AddDateTimeVariable('A',Date);
  4653. AssertExpression('StrToDateDef(''S'',A)',Date);
  4654. end;
  4655. procedure TTestBuiltins.TestFunctionstrtotime;
  4656. Var
  4657. T : TDateTime;
  4658. begin
  4659. T:=Time;
  4660. FP.Identifiers.AddStringVariable('S',TimeToStr(T));
  4661. AssertExpression('StrToTime(S)',T);
  4662. end;
  4663. procedure TTestBuiltins.TestFunctionstrtotimedef;
  4664. Var
  4665. T : TDateTime;
  4666. begin
  4667. T:=Time;
  4668. FP.Identifiers.AddDateTimeVariable('S',T);
  4669. AssertExpression('StrToTimeDef(''q'',S)',T);
  4670. end;
  4671. procedure TTestBuiltins.TestFunctionstrtodatetime;
  4672. Var
  4673. T : TDateTime;
  4674. S : String;
  4675. begin
  4676. T:=Now;
  4677. S:=DateTimetostr(T);
  4678. AssertExpression('StrToDateTime('''+S+''')',T);
  4679. end;
  4680. procedure TTestBuiltins.TestFunctionstrtodatetimedef;
  4681. Var
  4682. T : TDateTime;
  4683. S : String;
  4684. begin
  4685. T:=Now;
  4686. S:=DateTimetostr(T);
  4687. FP.Identifiers.AddDateTimeVariable('S',T);
  4688. AssertExpression('StrToDateTimeDef('''+S+''',S)',T);
  4689. end;
  4690. { TTestNotNode }
  4691. procedure TTestNotNode.TearDown;
  4692. begin
  4693. FreeAndNil(FN);
  4694. inherited TearDown;
  4695. end;
  4696. procedure TTestNotNode.TestCreateInteger;
  4697. begin
  4698. FN:=TFPNotNode.Create(CreateIntNode(3));
  4699. AssertNodeOK(FN);
  4700. AssertEquals('Correct node type',rtInteger,FN.NodeType);
  4701. AssertEquals('Correct result',Not(Int64(3)),FN.NodeValue.ResInteger);
  4702. end;
  4703. procedure TTestNotNode.TestCreateBoolean;
  4704. begin
  4705. FN:=TFPNotNode.Create(CreateBoolNode(True));
  4706. AssertNodeOK(FN);
  4707. AssertEquals('Correct node type',rtBoolean,FN.NodeType);
  4708. AssertEquals('Correct result',False,FN.NodeValue.ResBoolean);
  4709. end;
  4710. procedure TTestNotNode.TestCreateString;
  4711. begin
  4712. FN:=TFPNotNode.Create(CreateStringNode('True'));
  4713. AssertNodeNotOK('String node type',FN);
  4714. end;
  4715. procedure TTestNotNode.TestCreateFloat;
  4716. begin
  4717. FN:=TFPNotNode.Create(CreateFloatNode(1.23));
  4718. AssertNodeNotOK('String node type',FN);
  4719. end;
  4720. procedure TTestNotNode.TestCreateDateTime;
  4721. begin
  4722. FN:=TFPNotNode.Create(CreateDateTimeNode(Now));
  4723. AssertNodeNotOK('String node type',FN);
  4724. end;
  4725. procedure TTestNotNode.TestDestroy;
  4726. begin
  4727. FN:=TFPNotNode.Create(TMyDestroyNode.CreateTest(Self));
  4728. FreeAndNil(FN);
  4729. AssertEquals('Destroy called for operand',1,self.FDestroyCalled)
  4730. end;
  4731. { TTestIfOperation }
  4732. procedure TTestIfOperation.TearDown;
  4733. begin
  4734. FreeAndNil(FN);
  4735. inherited TearDown;
  4736. end;
  4737. procedure TTestIfOperation.TestCreateInteger;
  4738. begin
  4739. FN:=TIfOperation.Create(CreateIntNode(1),CreateIntNode(2),CreateIntNode(3));
  4740. AssertNodeNotOK('First argument wrong',FN);
  4741. end;
  4742. procedure TTestIfOperation.TestCreateBoolean;
  4743. begin
  4744. FN:=TIfOperation.Create(CreateBoolNode(True),CreateIntNode(2),CreateIntNode(3));
  4745. AssertNodeOK(FN);
  4746. AssertEquals('Correct node type',rtInteger,FN.NodeType);
  4747. AssertEquals('Correct result',2,FN.NodeValue.ResInteger);
  4748. end;
  4749. procedure TTestIfOperation.TestCreateBoolean2;
  4750. begin
  4751. FN:=TIfOperation.Create(CreateBoolNode(False),CreateIntNode(2),CreateIntNode(3));
  4752. AssertNodeOK(FN);
  4753. AssertEquals('Correct node type',rtInteger,FN.NodeType);
  4754. AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
  4755. end;
  4756. procedure TTestIfOperation.TestCreateBooleanInteger;
  4757. begin
  4758. FN:=TIfOperation.Create(CreateBoolNode(False),CreateIntNode(2),CreateBoolNode(False));
  4759. AssertNodeNotOK('Arguments differ in type',FN);
  4760. end;
  4761. procedure TTestIfOperation.TestCreateBooleanInteger2;
  4762. begin
  4763. FN:=TIfOperation.Create(CreateBoolNode(True),CreateIntNode(2),CreateIntNode(3));
  4764. AssertNodeOK(FN);
  4765. AssertEquals('Correct node type',rtInteger,FN.NodeType);
  4766. AssertEquals('Correct result',2,FN.NodeValue.ResInteger);
  4767. end;
  4768. procedure TTestIfOperation.TestCreateBooleanString;
  4769. begin
  4770. FN:=TIfOperation.Create(CreateBoolNode(True),CreateStringNode('2'),CreateStringNode('3'));
  4771. AssertNodeOK(FN);
  4772. AssertEquals('Correct node type',rtString,FN.NodeType);
  4773. AssertEquals('Correct result','2',FN.NodeValue.ResString);
  4774. end;
  4775. procedure TTestIfOperation.TestCreateBooleanString2;
  4776. begin
  4777. FN:=TIfOperation.Create(CreateBoolNode(False),CreateStringNode('2'),CreateStringNode('3'));
  4778. AssertNodeOK(FN);
  4779. AssertEquals('Correct node type',rtString,FN.NodeType);
  4780. AssertEquals('Correct result','3',FN.NodeValue.ResString);
  4781. end;
  4782. procedure TTestIfOperation.TestCreateBooleanDateTime;
  4783. begin
  4784. FN:=TIfOperation.Create(CreateBoolNode(True),CreateDateTimeNode(Date),CreateDateTimeNode(Date-1));
  4785. AssertNodeOK(FN);
  4786. AssertEquals('Correct node type',rtDateTime,FN.NodeType);
  4787. AssertEquals('Correct result',Date,FN.NodeValue.ResDateTime);
  4788. end;
  4789. procedure TTestIfOperation.TestCreateBooleanDateTime2;
  4790. begin
  4791. FN:=TIfOperation.Create(CreateBoolNode(False),CreateDateTimeNode(Date),CreateDateTimeNode(Date-1));
  4792. AssertNodeOK(FN);
  4793. AssertEquals('Correct node type',rtDateTime,FN.NodeType);
  4794. AssertEquals('Correct result',Date-1,FN.NodeValue.ResDateTime);
  4795. end;
  4796. procedure TTestIfOperation.TestCreateString;
  4797. begin
  4798. FN:=TIfOperation.Create(CreateStringNode('1'),CreateIntNode(2),CreateIntNode(3));
  4799. AssertNodeNotOK('First argument wrong',FN);
  4800. end;
  4801. procedure TTestIfOperation.TestCreateFloat;
  4802. begin
  4803. FN:=TIfOperation.Create(CreateFloatNode(2.0),CreateIntNode(2),CreateIntNode(3));
  4804. AssertNodeNotOK('First argument wrong',FN);
  4805. end;
  4806. procedure TTestIfOperation.TestCreateDateTime;
  4807. begin
  4808. FN:=TIfOperation.Create(CreateDateTimeNode(Date),CreateIntNode(2),CreateIntNode(3));
  4809. AssertNodeNotOK('First argument wrong',FN);
  4810. end;
  4811. procedure TTestIfOperation.TestDestroy;
  4812. begin
  4813. FN:=TIfOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
  4814. FreeAndNil(FN);
  4815. AssertEquals('Destroy called for operand',3,self.FDestroyCalled)
  4816. end;
  4817. { TTestCaseOperation }
  4818. function TTestCaseOperation.CreateArgs(
  4819. Args: array of const): TExprArgumentArray;
  4820. Var
  4821. I : Integer;
  4822. begin
  4823. SetLength(Result,High(Args)-Low(Args)+1);
  4824. For I:=Low(Args) to High(Args) do
  4825. Result[I]:=Args[i].VObject as TFPExprNode;
  4826. end;
  4827. procedure TTestCaseOperation.TearDown;
  4828. begin
  4829. FreeAndNil(FN);
  4830. inherited TearDown;
  4831. end;
  4832. procedure TTestCaseOperation.TestCreateOne;
  4833. begin
  4834. FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False)]));
  4835. AssertNodeNotOK('Too little arguments',FN);
  4836. end;
  4837. procedure TTestCaseOperation.TestCreateTwo;
  4838. begin
  4839. FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False)]));
  4840. AssertNodeNotOK('Too little arguments',FN);
  4841. end;
  4842. procedure TTestCaseOperation.TestCreateThree;
  4843. begin
  4844. FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False),CreateBoolNode(False)]));
  4845. AssertNodeNotOK('Too little arguments',FN);
  4846. end;
  4847. procedure TTestCaseOperation.TestCreateOdd;
  4848. begin
  4849. FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False),
  4850. CreateBoolNode(False),CreateBoolNode(False),
  4851. CreateBoolNode(False)]));
  4852. AssertNodeNotOK('Odd number of arguments',FN);
  4853. end;
  4854. procedure TTestCaseOperation.TestCreateNoExpression;
  4855. begin
  4856. FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),
  4857. CreateBoolNode(False),
  4858. TFPBinaryOrOperation.Create(CreateBoolNode(False),CreateBoolNode(False)),
  4859. CreateBoolNode(False)]));
  4860. AssertNodeNotOK('Label is not a constant expression',FN);
  4861. end;
  4862. procedure TTestCaseOperation.TestCreateWrongLabel;
  4863. begin
  4864. FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False),
  4865. CreateIntNode(1),CreateBoolNode(False),
  4866. CreateBoolNode(True),CreateBoolNode(False)]));
  4867. AssertNodeNotOK('Wrong label',FN);
  4868. end;
  4869. procedure TTestCaseOperation.TestCreateWrongValue;
  4870. begin
  4871. FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False),
  4872. CreateIntNode(1),CreateBoolNode(False),
  4873. CreateIntNode(2),CreateIntNode(1)]));
  4874. AssertNodeNotOK('Wrong value',FN);
  4875. end;
  4876. procedure TTestCaseOperation.TestIntegerTag;
  4877. begin
  4878. FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateStringNode('many'),
  4879. CreateIntNode(1),CreateStringNode('one'),
  4880. CreateIntNode(2),CreateStringNode('two')]));
  4881. AssertNodeOK(FN);
  4882. AssertEquals('Correct node type',rtString,FN.NodeType);
  4883. AssertEquals('Correct result','one',FN.NodeValue.ResString);
  4884. end;
  4885. procedure TTestCaseOperation.TestIntegerTagDefault;
  4886. begin
  4887. FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateStringNode('many'),
  4888. CreateIntNode(1),CreateStringNode('one'),
  4889. CreateIntNode(2),CreateStringNode('two')]));
  4890. AssertNodeOK(FN);
  4891. AssertEquals('Correct node type',rtString,FN.NodeType);
  4892. AssertEquals('Correct result','many',FN.NodeValue.ResString);
  4893. end;
  4894. procedure TTestCaseOperation.TestStringTag;
  4895. begin
  4896. FN:=TCaseOperation.Create(CreateArgs([CreateStringNode('one'),CreateIntNode(3),
  4897. CreateStringNode('one'),CreateIntNode(1),
  4898. CreateStringNode('two'),CreateIntNode(2)]));
  4899. AssertNodeOK(FN);
  4900. AssertEquals('Correct node type',rtInteger,FN.NodeType);
  4901. AssertEquals('Correct result',1,FN.NodeValue.ResInteger);
  4902. end;
  4903. procedure TTestCaseOperation.TestStringTagDefault;
  4904. begin
  4905. FN:=TCaseOperation.Create(CreateArgs([CreateStringNode('many'),CreateIntNode(3),
  4906. CreateStringNode('one'),CreateIntNode(1),
  4907. CreateStringNode('two'),CreateIntNode(2)]));
  4908. AssertNodeOK(FN);
  4909. AssertEquals('Correct node type',rtInteger,FN.NodeType);
  4910. AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
  4911. end;
  4912. procedure TTestCaseOperation.TestFloatTag;
  4913. begin
  4914. FN:=TCaseOperation.Create(CreateArgs([CreateFloatNode(1.0),CreateStringNode('many'),
  4915. CreateFloatNode(1.0),CreateStringNode('one'),
  4916. CreateFloatNode(2.0),CreateStringNode('two')]));
  4917. AssertNodeOK(FN);
  4918. AssertEquals('Correct node type',rtString,FN.NodeType);
  4919. AssertEquals('Correct result','one',FN.NodeValue.ResString);
  4920. end;
  4921. procedure TTestCaseOperation.TestFloatTagDefault;
  4922. begin
  4923. FN:=TCaseOperation.Create(CreateArgs([CreateFloatNode(3.0),CreateStringNode('many'),
  4924. CreateFloatNode(1.0),CreateStringNode('one'),
  4925. CreateFloatNode(2.0),CreateStringNode('two')]));
  4926. AssertNodeOK(FN);
  4927. AssertEquals('Correct node type',rtString,FN.NodeType);
  4928. AssertEquals('Correct result','many',FN.NodeValue.ResString);
  4929. end;
  4930. procedure TTestCaseOperation.TestBooleanTag;
  4931. begin
  4932. FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(True),CreateStringNode('unknown'),
  4933. CreateBoolNode(True),CreateStringNode('one'),
  4934. CreateBoolNode(False),CreateStringNode('two')]));
  4935. AssertNodeOK(FN);
  4936. AssertEquals('Correct node type',rtString,FN.NodeType);
  4937. AssertEquals('Correct result','one',FN.NodeValue.ResString);
  4938. end;
  4939. procedure TTestCaseOperation.TestBooleanTagDefault;
  4940. begin
  4941. FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(True),CreateStringNode('unknown'),
  4942. CreateBoolNode(False),CreateStringNode('two')]));
  4943. AssertNodeOK(FN);
  4944. AssertEquals('Correct node type',rtString,FN.NodeType);
  4945. AssertEquals('Correct result','unknown',FN.NodeValue.ResString);
  4946. end;
  4947. procedure TTestCaseOperation.TestDateTimeTag;
  4948. begin
  4949. FN:=TCaseOperation.Create(CreateArgs([CreateDateTimeNode(Date),CreateStringNode('later'),
  4950. CreateDateTimeNode(Date),CreateStringNode('today'),
  4951. CreateDateTimeNode(Date+1),CreateStringNode('tomorrow')]));
  4952. AssertNodeOK(FN);
  4953. AssertEquals('Correct node type',rtString,FN.NodeType);
  4954. AssertEquals('Correct result','today',FN.NodeValue.ResString);
  4955. end;
  4956. procedure TTestCaseOperation.TestDateTimeTagDefault;
  4957. begin
  4958. FN:=TCaseOperation.Create(CreateArgs([CreateDateTimeNode(Date+2),CreateStringNode('later'),
  4959. CreateDateTimeNode(Date),CreateStringNode('today'),
  4960. CreateDateTimeNode(Date+1),CreateStringNode('tomorrow')]));
  4961. AssertNodeOK(FN);
  4962. AssertEquals('Correct node type',rtString,FN.NodeType);
  4963. AssertEquals('Correct result','later',FN.NodeValue.ResString);
  4964. end;
  4965. procedure TTestCaseOperation.TestIntegerValue;
  4966. begin
  4967. FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateIntNode(0),
  4968. CreateIntNode(1),CreateIntNode(-1),
  4969. CreateIntNode(2),CreateIntNode(-2)]));
  4970. AssertNodeOK(FN);
  4971. AssertEquals('Correct node type',rtInteger,FN.NodeType);
  4972. AssertEquals('Correct result',-1,FN.NodeValue.ResInteger);
  4973. end;
  4974. procedure TTestCaseOperation.TestIntegerValueDefault;
  4975. begin
  4976. FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateIntNode(0),
  4977. CreateIntNode(1),CreateIntNode(-1),
  4978. CreateIntNode(2),CreateIntNode(-2)]));
  4979. AssertNodeOK(FN);
  4980. AssertEquals('Correct node type',rtInteger,FN.NodeType);
  4981. AssertEquals('Correct result',0,FN.NodeValue.ResInteger);
  4982. end;
  4983. procedure TTestCaseOperation.TestStringValue;
  4984. begin
  4985. FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateStringNode('many'),
  4986. CreateIntNode(1),CreateStringNode('one'),
  4987. CreateIntNode(2),CreateStringNode('two')]));
  4988. AssertNodeOK(FN);
  4989. AssertEquals('Correct node type',rtString,FN.NodeType);
  4990. AssertEquals('Correct result','one',FN.NodeValue.ResString);
  4991. end;
  4992. procedure TTestCaseOperation.TestStringValueDefault;
  4993. begin
  4994. FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateStringNode('many'),
  4995. CreateIntNode(1),CreateStringNode('one'),
  4996. CreateIntNode(2),CreateStringNode('two')]));
  4997. AssertNodeOK(FN);
  4998. AssertEquals('Correct node type',rtString,FN.NodeType);
  4999. AssertEquals('Correct result','many',FN.NodeValue.ResString);
  5000. end;
  5001. procedure TTestCaseOperation.TestFloatValue;
  5002. begin
  5003. FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateFloatNode(0.0),
  5004. CreateIntNode(1),CreateFloatNode(2.0),
  5005. CreateIntNode(2),CreateFloatNode(1.0)]));
  5006. AssertNodeOK(FN);
  5007. AssertEquals('Correct node type',rtFloat,FN.NodeType);
  5008. AssertEquals('Correct result',2.0,FN.NodeValue.ResFloat);
  5009. end;
  5010. procedure TTestCaseOperation.TestFloatValueDefault;
  5011. begin
  5012. FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateFloatNode(0.0),
  5013. CreateIntNode(1),CreateFloatNode(2.0),
  5014. CreateIntNode(2),CreateFloatNode(1.0)]));
  5015. AssertNodeOK(FN);
  5016. AssertEquals('Correct node type',rtFloat,FN.NodeType);
  5017. AssertEquals('Correct result',0.0,FN.NodeValue.ResFloat);
  5018. end;
  5019. procedure TTestCaseOperation.TestBooleanValue;
  5020. begin
  5021. FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False),
  5022. CreateIntNode(1),CreateBoolNode(True),
  5023. CreateIntNode(2),CreateBoolNode(False)]));
  5024. AssertNodeOK(FN);
  5025. AssertEquals('Correct node type',rtBoolean,FN.NodeType);
  5026. AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
  5027. end;
  5028. procedure TTestCaseOperation.TestBooleanValueDefault;
  5029. begin
  5030. FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateBoolNode(False),
  5031. CreateIntNode(1),CreateBoolNode(True),
  5032. CreateIntNode(2),CreateBoolNode(False)]));
  5033. AssertNodeOK(FN);
  5034. AssertEquals('Correct node type',rtBoolean,FN.NodeType);
  5035. AssertEquals('Correct result',False,FN.NodeValue.ResBoolean);
  5036. end;
  5037. procedure TTestCaseOperation.TestDateTimeValue;
  5038. begin
  5039. FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateDateTimeNode(Date+1),
  5040. CreateIntNode(1),CreateDateTimeNode(Date),
  5041. CreateIntNode(2),CreateDateTimeNode(Date-1)]));
  5042. AssertNodeOK(FN);
  5043. AssertEquals('Correct node type',rtDateTime,FN.NodeType);
  5044. AssertEquals('Correct result',Date,FN.NodeValue.ResDateTime);
  5045. end;
  5046. procedure TTestCaseOperation.TestDateTimeValueDefault;
  5047. begin
  5048. FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateDateTimeNode(Date+1),
  5049. CreateIntNode(1),CreateDateTimeNode(Date),
  5050. CreateIntNode(2),CreateDateTimeNode(Date-1)]));
  5051. AssertNodeOK(FN);
  5052. AssertEquals('Correct node type',rtDateTime,FN.NodeType);
  5053. AssertEquals('Correct result',Date+1,FN.NodeValue.ResDateTime);
  5054. end;
  5055. procedure TTestCaseOperation.TestDestroy;
  5056. begin
  5057. FN:=TCaseOperation.Create(CreateArgs([TMyDestroyNode.CreateTest(Self),
  5058. TMyDestroyNode.CreateTest(Self),
  5059. TMyDestroyNode.CreateTest(Self),
  5060. TMyDestroyNode.CreateTest(Self)]));
  5061. FreeAndNil(FN);
  5062. AssertEquals('Destroy called for operand',4,self.FDestroyCalled)
  5063. end;
  5064. initialization
  5065. RegisterTests([TTestExpressionScanner, TTestDestroyNode,
  5066. TTestConstExprNode,TTestNegateExprNode,
  5067. TTestBinaryAndNode,TTestBinaryOrNode,TTestBinaryXOrNode,
  5068. TTestNotNode,TTestEqualNode,TTestUnEqualNode,
  5069. TTestIfOperation,TTestCaseOperation,
  5070. TTestLessThanNode,TTestLessThanEqualNode,
  5071. TTestLargerThanNode,TTestLargerThanEqualNode,
  5072. TTestAddNode,TTestSubtractNode,
  5073. TTestMultiplyNode,TTestDivideNode,
  5074. TTestIntToFloatNode,TTestIntToDateTimeNode,
  5075. TTestFloatToDateTimeNode,
  5076. TTestParserExpressions, TTestParserBooleanOperations,
  5077. TTestParserOperands, TTestParserTypeMatch,
  5078. TTestParserVariables,TTestParserFunctions,
  5079. TTestBuiltinsManager,TTestBuiltins]);
  5080. end.