testexprpars.pp 200 KB

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