testexprpars.pp 206 KB

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