testexprpars.pp 207 KB

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