testexprpars.pp 191 KB

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