testexprpars.pp 204 KB

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