testexprpars.pp 192 KB

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