1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946694769486949695069516952695369546955695669576958695969606961696269636964696569666967696869696970697169726973697469756976697769786979698069816982698369846985698669876988698969906991699269936994699569966997699869997000700170027003700470057006700770087009701070117012701370147015701670177018701970207021702270237024702570267027702870297030703170327033703470357036703770387039704070417042704370447045704670477048704970507051705270537054705570567057705870597060706170627063706470657066706770687069707070717072707370747075707670777078707970807081708270837084708570867087708870897090709170927093709470957096709770987099710071017102710371047105710671077108710971107111711271137114711571167117711871197120712171227123712471257126712771287129713071317132713371347135713671377138713971407141714271437144714571467147714871497150715171527153715471557156715771587159716071617162716371647165716671677168716971707171717271737174 |
- {
- This file is part of the Free Component Library (FCL)
- Copyright (c) 2008 Michael Van Canneyt.
-
- File which provides examples and all testcases for the expression parser.
- It needs fcl-fpcunit to work.
-
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit testexprpars;
- {$mode objfpc}{$H+}
- interface
- uses
- Classes, SysUtils, fpcunit, testutils, testregistry, math, fpexprpars;
- type
- { TTestExpressionScanner }
- TTestExpressionScanner = class(TTestCase)
- Private
- FP : TFPExpressionScanner;
- FInvalidString : String;
- procedure DoInvalidNumber(AString: String);
- procedure TestIdentifier(const ASource, ATokenName: string);
- procedure TestInvalidNumber;
- protected
- procedure SetUp; override;
- procedure TearDown; override;
- Procedure AssertEquals(Msg : string; AExpected, AActual : TTokenType); overload;
- Procedure TestString(Const AString : String; AToken : TTokenType);
- published
- procedure TestCreate;
- procedure TestSetSource;
- Procedure TestWhiteSpace;
- Procedure TestTokens;
- Procedure TestNumber;
- Procedure TestInvalidCharacter;
- Procedure TestUnterminatedString;
- Procedure TestQuotesInString;
- Procedure TestIdentifiers;
- end;
- { TMyFPExpressionParser }
- TMyFPExpressionParser = Class(TFPExpressionParser)
- Public
- Procedure BuildHashList;
- Property ExprNode;
- Property Scanner;
- Property Dirty;
- end;
- { TTestBaseParser }
- TTestBaseParser = class(TTestCase)
- private
- procedure DoCheck;
- Protected
- FDestroyCalled : Integer;
- FCheckNode : TFPExprNode;
- procedure AssertNodeType(Msg: String; AClass: TClass; ANode: TFPExprNode); overload;
- procedure AssertEquals(Msg: String; AResultType : TResultType; ANode: TFPExprNode); overload;
- procedure AssertEquals(Msg: String; AExpected,AActual : TResultType); overload;
- Function CreateBoolNode(ABoolean: Boolean) : TFPExprNode;
- Function CreateIntNode(AInteger: Integer) : TFPExprNode;
- Function CreateFloatNode(AFloat : TExprFloat) : TFPExprNode;
- Function CreateStringNode(Astring : String) : TFPExprNode;
- Function CreateDateTimeNode(ADateTime : TDateTime) : TFPExprNode;
- Procedure AssertNodeOK(FN : TFPExprNode);
- Procedure AssertNodeNotOK(Const Msg : String; FN : TFPExprNode);
- Procedure Setup; override;
- end;
- { TMyDestroyNode }
- TMyDestroyNode = Class(TFPConstExpression)
- FTest : TTestBaseParser;
- Public
- Constructor CreateTest(ATest : TTestBaseParser);
- Destructor Destroy; override;
- end;
- { TTestDestroyNode }
- TTestDestroyNode = Class(TTestBaseParser)
- Published
- Procedure TestDestroy;
- end;
- { TTestConstExprNode }
- TTestConstExprNode = Class(TTestBaseParser)
- private
- FN : TFPConstExpression;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- procedure TestCreateFloat;
- procedure TestCreateBoolean;
- procedure TestCreateDateTime;
- procedure TestCreateString;
- end;
- { TTestNegateExprNode }
- TTestNegateExprNode = Class(TTestBaseParser)
- Private
- FN : TFPNegateOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- procedure TestCreateFloat;
- procedure TestCreateOther1;
- procedure TestCreateOther2;
- Procedure TestDestroy;
- end;
- { TTestBinaryAndNode }
- TTestBinaryAndNode = Class(TTestBaseParser)
- Private
- FN : TFPBinaryAndOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- procedure TestCreateBoolean;
- procedure TestCreateBooleanInteger;
- procedure TestCreateString;
- procedure TestCreateFloat;
- procedure TestCreateDateTime;
- Procedure TestDestroy;
- end;
- { TTestNotNode }
- TTestNotNode = Class(TTestBaseParser)
- Private
- FN : TFPNotNode;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- procedure TestCreateBoolean;
- procedure TestCreateString;
- procedure TestCreateFloat;
- procedure TestCreateDateTime;
- Procedure TestDestroy;
- end;
- { TTestBinaryOrNode }
- TTestBinaryOrNode = Class(TTestBaseParser)
- Private
- FN : TFPBinaryOrOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- procedure TestCreateBoolean;
- procedure TestCreateBooleanInteger;
- procedure TestCreateString;
- procedure TestCreateFloat;
- procedure TestCreateDateTime;
- Procedure TestDestroy;
- end;
- { TTestBinaryXOrNode }
- TTestBinaryXOrNode = Class(TTestBaseParser)
- Private
- FN : TFPBinaryXOrOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- procedure TestCreateBoolean;
- procedure TestCreateBooleanInteger;
- procedure TestCreateString;
- procedure TestCreateFloat;
- procedure TestCreateDateTime;
- Procedure TestDestroy;
- end;
- { TTestIfOperation }
- TTestIfOperation = Class(TTestBaseParser)
- Private
- FN : TIfOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- procedure TestCreateBoolean;
- procedure TestCreateBoolean2;
- procedure TestCreateString;
- procedure TestCreateFloat;
- procedure TestCreateDateTime;
- procedure TestCreateBooleanInteger;
- procedure TestCreateBooleanInteger2;
- procedure TestCreateBooleanString;
- procedure TestCreateBooleanString2;
- procedure TestCreateBooleanDateTime;
- procedure TestCreateBooleanDateTime2;
- Procedure TestDestroy;
- end;
- { TTestCaseOperation }
- TTestCaseOperation = Class(TTestBaseParser)
- Private
- FN : TCaseOperation;
- Protected
- Function CreateArgs(Args : Array of Const) : TExprArgumentArray;
- Procedure TearDown; override;
- Published
- Procedure TestCreateOne;
- procedure TestCreateTwo;
- procedure TestCreateThree;
- procedure TestCreateOdd;
- procedure TestCreateNoExpression;
- procedure TestCreateWrongLabel;
- procedure TestCreateWrongValue;
- procedure TestIntegerTag;
- procedure TestIntegerTagDefault;
- procedure TestStringTag;
- procedure TestStringTagDefault;
- procedure TestFloatTag;
- procedure TestFloatTagDefault;
- procedure TestBooleanTag;
- procedure TestBooleanTagDefault;
- procedure TestDateTimeTag;
- procedure TestDateTimeTagDefault;
- procedure TestIntegerValue;
- procedure TestIntegerValueDefault;
- procedure TestStringValue;
- procedure TestStringValueDefault;
- procedure TestFloatValue;
- procedure TestFloatValueDefault;
- procedure TestBooleanValue;
- procedure TestBooleanValueDefault;
- procedure TestDateTimeValue;
- procedure TestDateTimeValueDefault;
- Procedure TestDestroy;
- end;
- { TTestBooleanNode }
- TTestBooleanNode = Class(TTestBaseParser)
- Protected
- Procedure TestNode(B : TFPBooleanResultOperation; AResult : Boolean);
- end;
- { TTestEqualNode }
- TTestEqualNode = Class(TTestBooleanNode)
- Private
- FN : TFPBooleanResultOperation;
- Protected
- Procedure TearDown; override;
- Class Function NodeClass : TFPBooleanResultOperationClass; virtual;
- Class Function ExpectedResult : Boolean; virtual;
- Class Function OperatorString : String; virtual;
- Published
- Procedure TestCreateIntegerEqual;
- procedure TestCreateIntegerUnEqual;
- Procedure TestCreateFloatEqual;
- procedure TestCreateFloatUnEqual;
- Procedure TestCreateStringEqual;
- procedure TestCreateStringUnEqual;
- Procedure TestCreateBooleanEqual;
- procedure TestCreateBooleanUnEqual;
- Procedure TestCreateDateTimeEqual;
- procedure TestCreateDateTimeUnEqual;
- Procedure TestDestroy;
- Procedure TestWrongTypes1;
- procedure TestWrongTypes2;
- procedure TestWrongTypes3;
- procedure TestWrongTypes4;
- procedure TestWrongTypes5;
- Procedure TestAsString;
- end;
- { TTestUnEqualNode }
- TTestUnEqualNode = Class(TTestEqualNode)
- Protected
- Class Function NodeClass : TFPBooleanResultOperationClass; override;
- Class Function ExpectedResult : Boolean; override;
- Class Function OperatorString : String; override;
- end;
- { TTestLessThanNode }
- TTestLessThanNode = Class(TTestBooleanNode)
- Private
- FN : TFPBooleanResultOperation;
- Protected
- Class Function NodeClass : TFPBooleanResultOperationClass; virtual;
- Class Function Larger : Boolean; virtual;
- Class Function AllowEqual : Boolean; virtual;
- Class Function OperatorString : String; virtual;
- Procedure TearDown; override;
- Published
- Procedure TestCreateIntegerEqual;
- procedure TestCreateIntegerSmaller;
- procedure TestCreateIntegerLarger;
- Procedure TestCreateFloatEqual;
- procedure TestCreateFloatSmaller;
- procedure TestCreateFloatLarger;
- Procedure TestCreateDateTimeEqual;
- procedure TestCreateDateTimeSmaller;
- procedure TestCreateDateTimeLarger;
- Procedure TestCreateStringEqual;
- procedure TestCreateStringSmaller;
- procedure TestCreateStringLarger;
- Procedure TestWrongTypes1;
- procedure TestWrongTypes2;
- procedure TestWrongTypes3;
- procedure TestWrongTypes4;
- procedure TestWrongTypes5;
- Procedure TestNoBoolean1;
- Procedure TestNoBoolean2;
- Procedure TestNoBoolean3;
- Procedure TestAsString;
- end;
- { TTestLessThanEqualNode }
- TTestLessThanEqualNode = Class(TTestLessThanNode)
- protected
- Class Function NodeClass : TFPBooleanResultOperationClass; override;
- Class Function AllowEqual : Boolean; override;
- Class Function OperatorString : String; override;
- end;
- { TTestLargerThanNode }
- TTestLargerThanNode = Class(TTestLessThanNode)
- protected
- Class Function NodeClass : TFPBooleanResultOperationClass; override;
- Class Function Larger : Boolean; override;
- Class Function OperatorString : String; override;
- end;
- { TTestLargerThanEqualNode }
- TTestLargerThanEqualNode = Class(TTestLargerThanNode)
- protected
- Class Function NodeClass : TFPBooleanResultOperationClass; override;
- Class Function AllowEqual : Boolean; override;
- Class Function OperatorString : String; override;
- end;
- { TTestAddNode }
- TTestAddNode = Class(TTestBaseParser)
- Private
- FN : TFPAddOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- Procedure TestCreateFloat;
- Procedure TestCreateDateTime;
- Procedure TestCreateString;
- Procedure TestCreateBoolean;
- Procedure TestDestroy;
- Procedure TestAsString;
- end;
- { TTestSubtractNode }
- TTestSubtractNode = Class(TTestBaseParser)
- Private
- FN : TFPSubtractOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- Procedure TestCreateFloat;
- Procedure TestCreateDateTime;
- Procedure TestCreateString;
- Procedure TestCreateBoolean;
- Procedure TestDestroy;
- Procedure TestAsString;
- end;
- { TTestMultiplyNode }
- TTestMultiplyNode = Class(TTestBaseParser)
- Private
- FN : TFPMultiplyOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- Procedure TestCreateFloat;
- Procedure TestCreateDateTime;
- Procedure TestCreateString;
- Procedure TestCreateBoolean;
- Procedure TestDestroy;
- Procedure TestAsString;
- end;
- { TTestPowerNode }
- TTestPowerNode = Class(TTestBaseParser)
- Private
- FN : TFPPowerOperation;
- FE : TFPExpressionParser;
- Protected
- Procedure Setup; override;
- Procedure TearDown; override;
- procedure Calc(AExpr: String; Expected: Double = NaN);
- Published
- Procedure TestCreateInteger;
- Procedure TestCreateFloat;
- Procedure TestCreateDateTime;
- Procedure TestCreateString;
- Procedure TestCreateBoolean;
- Procedure TestDestroy;
- Procedure TestAsString;
- Procedure TestCalc;
- end;
- { TTestDivideNode }
- TTestDivideNode = Class(TTestBaseParser)
- Private
- FN : TFPDivideOperation;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- Procedure TestCreateFloat;
- Procedure TestCreateDateTime;
- Procedure TestCreateString;
- Procedure TestCreateBoolean;
- Procedure TestDestroy;
- Procedure TestAsString;
- end;
- { TTestIntToFloatNode }
- TTestIntToFloatNode = Class(TTestBaseParser)
- Private
- FN : TIntToFloatNode;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- Procedure TestCreateFloat;
- Procedure TestDestroy;
- Procedure TestAsString;
- end;
- { TTestIntToDateTimeNode }
- TTestIntToDateTimeNode = Class(TTestBaseParser)
- Private
- FN : TIntToDateTimeNode;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- Procedure TestCreateFloat;
- Procedure TestDestroy;
- Procedure TestAsString;
- end;
- { TTestFloatToDateTimeNode }
- TTestFloatToDateTimeNode = Class(TTestBaseParser)
- Private
- FN : TFloatToDateTimeNode;
- Protected
- Procedure TearDown; override;
- Published
- Procedure TestCreateInteger;
- Procedure TestCreateFloat;
- Procedure TestDestroy;
- Procedure TestAsString;
- end;
- { TTestExpressionParser }
- TTestExpressionParser = class(TTestBaseParser)
- Private
- FP : TMyFPExpressionParser;
- FTestExpr : String;
- procedure DoAddInteger(var Result: TFPExpressionResult;
- const Args: TExprParameterArray);
- procedure DoDeleteString(var Result: TFPExpressionResult;
- const Args: TExprParameterArray);
- procedure DoEchoBoolean(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- procedure DoEchoDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- procedure DoEchoFloat(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- procedure DoEchoCurrency(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- procedure DoEchoInteger(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- procedure DoEchoString(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- procedure DoGetDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- procedure DoParse;
- procedure TestParser(AExpr: string);
- protected
- procedure SetUp; override;
- procedure TearDown; override;
- Procedure AssertLeftRight(N : TFPExprNode; LeftClass,RightClass : TClass);
- Procedure AssertOperand(N : TFPExprNode; OperandClass : TClass);
- Procedure AssertResultType(RT : TResultType);
- Procedure AssertResult(F : TExprFloat);
- Procedure AssertCurrencyResult(C : Currency);
- Procedure AssertResult(I : Int64);
- Procedure AssertResult(S : String);
- Procedure AssertResult(B : Boolean);
- Procedure AssertDateTimeResult(D : TDateTime);
- end;
- { TTestParserExpressions }
- TTestParserExpressions = Class(TTestExpressionParser)
- private
- Published
- Procedure TestCreate;
- Procedure TestNumberValues;
- Procedure TestSimpleNodeFloat;
- procedure TestSimpleNodeInteger;
- procedure TestSimpleNodeBooleanTrue;
- procedure TestSimpleNodeBooleanFalse;
- procedure TestSimpleNodeString;
- procedure TestSimpleNegativeInteger;
- procedure TestSimpleNegativeFloat;
- procedure TestSimpleAddInteger;
- procedure TestSimpleAddFloat;
- procedure TestSimpleAddIntegerFloat;
- procedure TestSimpleAddFloatInteger;
- procedure TestSimpleAddString;
- procedure TestSimpleSubtractInteger;
- procedure TestSimpleSubtractFloat;
- procedure TestSimpleSubtractIntegerFloat;
- procedure TestSimpleSubtractFloatInteger;
- procedure TestSimpleMultiplyFloat;
- procedure TestSimpleMultiplyInteger;
- procedure TestSimpleDivideFloat;
- procedure TestSimpleDivideInteger;
- procedure TestSimpleBooleanAnd;
- procedure TestSimpleIntegerAnd;
- procedure TestSimpleBooleanOr;
- procedure TestSimpleIntegerOr;
- procedure TestSimpleBooleanNot;
- procedure TestSimpleIntegerNot;
- procedure TestSimpleAddSeries;
- procedure TestSimpleMultiplySeries;
- procedure TestSimpleAddMultiplySeries;
- procedure TestSimpleAddAndSeries;
- procedure TestSimpleAddOrSeries;
- procedure TestSimpleOrNotSeries;
- procedure TestSimpleAndNotSeries;
- procedure TestDoubleAddMultiplySeries;
- procedure TestDoubleSubtractMultiplySeries;
- procedure TestSimpleIfInteger;
- procedure TestSimpleIfString;
- procedure TestSimpleIfFloat;
- procedure TestSimpleIfBoolean;
- procedure TestSimpleIfDateTime;
- procedure TestSimpleIfOperation;
- procedure TestSimpleBrackets;
- procedure TestSimpleBrackets2;
- procedure TestSimpleBracketsLeft;
- procedure TestSimpleBracketsRight;
- procedure TestSimpleBracketsDouble;
- end;
- TTestParserBooleanOperations = Class(TTestExpressionParser)
- Published
- Procedure TestEqualInteger;
- procedure TestUnEqualInteger;
- procedure TestEqualFloat;
- procedure TestEqualFloat2;
- procedure TestUnEqualFloat;
- procedure TestEqualString;
- procedure TestEqualString2;
- procedure TestUnEqualString;
- procedure TestUnEqualString2;
- Procedure TestEqualBoolean;
- procedure TestUnEqualBoolean;
- procedure TestLessThanInteger;
- procedure TestLessThanInteger2;
- procedure TestLessThanEqualInteger;
- procedure TestLessThanEqualInteger2;
- procedure TestLessThanFloat;
- procedure TestLessThanFloat2;
- procedure TestLessThanEqualFloat;
- procedure TestLessThanEqualFloat2;
- procedure TestLessThanString;
- procedure TestLessThanString2;
- procedure TestLessThanEqualString;
- procedure TestLessThanEqualString2;
- procedure TestGreaterThanInteger;
- procedure TestGreaterThanInteger2;
- procedure TestGreaterThanEqualInteger;
- procedure TestGreaterThanEqualInteger2;
- procedure TestGreaterThanFloat;
- procedure TestGreaterThanFloat2;
- procedure TestGreaterThanEqualFloat;
- procedure TestGreaterThanEqualFloat2;
- procedure TestGreaterThanString;
- procedure TestGreaterThanString2;
- procedure TestGreaterThanEqualString;
- procedure TestGreaterThanEqualString2;
- procedure EqualAndSeries;
- procedure EqualAndSeries2;
- procedure EqualOrSeries;
- procedure EqualOrSeries2;
- procedure UnEqualAndSeries;
- procedure UnEqualAndSeries2;
- procedure UnEqualOrSeries;
- procedure UnEqualOrSeries2;
- procedure LessThanAndSeries;
- procedure LessThanAndSeries2;
- procedure LessThanOrSeries;
- procedure LessThanOrSeries2;
- procedure GreaterThanAndSeries;
- procedure GreaterThanAndSeries2;
- procedure GreaterThanOrSeries;
- procedure GreaterThanOrSeries2;
- procedure LessThanEqualAndSeries;
- procedure LessThanEqualAndSeries2;
- procedure LessThanEqualOrSeries;
- procedure LessThanEqualOrSeries2;
- procedure GreaterThanEqualAndSeries;
- procedure GreaterThanEqualAndSeries2;
- procedure GreaterThanEqualOrSeries;
- procedure GreaterThanEqualOrSeries2;
- end;
- { TTestParserOperands }
- TTestParserOperands = Class(TTestExpressionParser)
- private
- Published
- Procedure MissingOperand1;
- procedure MissingOperand2;
- procedure MissingOperand3;
- procedure MissingOperand4;
- procedure MissingOperand5;
- procedure MissingOperand6;
- procedure MissingOperand7;
- procedure MissingOperand8;
- procedure MissingOperand9;
- procedure MissingOperand10;
- procedure MissingOperand11;
- procedure MissingOperand12;
- procedure MissingOperand13;
- procedure MissingOperand14;
- procedure MissingOperand15;
- procedure MissingOperand16;
- procedure MissingOperand17;
- procedure MissingOperand18;
- procedure MissingOperand19;
- procedure MissingOperand20;
- procedure MissingOperand21;
- procedure MissingBracket1;
- procedure MissingBracket2;
- procedure MissingBracket3;
- procedure MissingBracket4;
- procedure MissingBracket5;
- procedure MissingBracket6;
- procedure MissingBracket7;
- procedure MissingArgument1;
- procedure MissingArgument2;
- procedure MissingArgument3;
- procedure MissingArgument4;
- procedure MissingArgument5;
- procedure MissingArgument6;
- procedure MissingArgument7;
- end;
- { TTestParserTypeMatch }
- TTestParserTypeMatch = Class(TTestExpressionParser)
- Private
- Procedure AccessString;
- Procedure AccessInteger;
- Procedure AccessFloat;
- Procedure AccessDateTime;
- Procedure AccessBoolean;
- Published
- Procedure TestTypeMismatch1;
- procedure TestTypeMismatch2;
- procedure TestTypeMismatch3;
- procedure TestTypeMismatch4;
- procedure TestTypeMismatch5;
- procedure TestTypeMismatch6;
- procedure TestTypeMismatch7;
- procedure TestTypeMismatch8;
- procedure TestTypeMismatch9;
- procedure TestTypeMismatch10;
- procedure TestTypeMismatch11;
- procedure TestTypeMismatch12;
- procedure TestTypeMismatch13;
- procedure TestTypeMismatch14;
- procedure TestTypeMismatch15;
- procedure TestTypeMismatch16;
- procedure TestTypeMismatch17;
- procedure TestTypeMismatch18;
- procedure TestTypeMismatch19;
- procedure TestTypeMismatch20;
- procedure TestTypeMismatch21;
- procedure TestTypeMismatch22;
- procedure TestTypeMismatch23;
- procedure TestTypeMismatch24;
- end;
- { TTestParserVariables }
- TTestParserVariables = Class(TTestExpressionParser)
- private
- FAsWrongType : TResultType;
- FEventName: String;
- FBoolValue : Boolean;
- FTest33 : TFPExprIdentifierDef;
- procedure DoGetBooleanVar(var Res: TFPExpressionResult; ConstRef AName: ShortString);
- procedure DoGetBooleanVarWrong(var Res: TFPExpressionResult; ConstRef AName: ShortString);
- procedure TestAccess(Skip: TResultType);
- procedure TestAccess(Skip: TResultTypes);
- Protected
- procedure DoTestVariable33;
- procedure AddVariabletwice;
- procedure UnknownVariable;
- Procedure ReadWrongType;
- procedure WriteWrongType;
- Procedure DoDummy(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- Published
- Procedure TestVariableAssign;
- Procedure TestVariableAssignAgain;
- Procedure TestVariable1;
- procedure TestVariable2;
- procedure TestVariable3;
- procedure TestVariable4;
- procedure TestVariable5;
- procedure TestVariable6;
- procedure TestVariable7;
- procedure TestVariable8;
- procedure TestVariable9;
- procedure TestVariable10;
- procedure TestVariable11;
- procedure TestVariable12;
- procedure TestVariable13;
- procedure TestVariable14;
- procedure TestVariable15;
- procedure TestVariable16;
- procedure TestVariable17;
- procedure TestVariable18;
- procedure TestVariable19;
- procedure TestVariable20;
- procedure TestVariable21;
- procedure TestVariable22;
- procedure TestVariable23;
- procedure TestVariable24;
- procedure TestVariable25;
- procedure TestVariable26;
- procedure TestVariable27;
- procedure TestVariable28;
- procedure TestVariable29;
- procedure TestVariable30;
- procedure TestVariable31;
- procedure TestVariable32;
- procedure TestVariable33;
- procedure TestVariable34;
- procedure TestVariable35;
- procedure TestVariable36;
- end;
- { TTestParserFunctions }
- TTestParserFunctions = Class(TTestExpressionParser)
- private
- FAccessAs : TResultType;
- procedure ExprAveOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
- procedure ExprMaxOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
- procedure ExprMinOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
- procedure ExprStdDevOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
- procedure ExprSumOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
- Procedure TryRead;
- procedure TryWrite;
- Published
- Procedure TestFunction1;
- procedure TestFunction2;
- procedure TestFunction3;
- procedure TestFunction4;
- procedure TestFunction5;
- procedure TestFunction6;
- procedure TestFunction7;
- procedure TestFunction8;
- procedure TestFunction9;
- procedure TestFunction10;
- procedure TestFunction11;
- procedure TestFunction12;
- procedure TestFunction13;
- procedure TestFunction14;
- procedure TestFunction15;
- procedure TestFunction16;
- procedure TestFunction17;
- procedure TestFunction18;
- procedure TestFunction19;
- procedure TestFunction20;
- procedure TestFunction21;
- procedure TestFunction22;
- procedure TestFunction23;
- procedure TestFunction24;
- procedure TestFunction25;
- procedure TestFunction26;
- procedure TestFunction27;
- procedure TestFunction28;
- procedure TestFunction29;
- procedure TestFunction30;
- procedure TestFunction31;
- procedure TestFunction32;
- procedure TestFunction33;
- procedure TestVarArgs1;
- procedure TestVarArgs2;
- procedure TestVarArgs3;
- procedure TestVarArgs4;
- procedure TestVarArgs5;
- end;
- { TAggregateNode }
- TAggregateNode = Class(TFPExprNode)
- Public
- InitCount : Integer;
- UpdateCount : Integer;
- Class Function IsAggregate: Boolean; override;
- Function NodeType: TResultType; override;
- Procedure InitAggregate; override;
- Procedure UpdateAggregate; override;
- procedure GetNodeValue(var Result: TFPExpressionResult); override;
- end;
- { TTestParserAggregate }
- TTestParserAggregate = Class(TTestExpressionParser)
- private
- FVarValue : Integer;
- FLeft : TAggregateNode;
- FRight : TAggregateNode;
- FFunction : TFPExprIdentifierDef;
- FFunction2 : TFPExprIdentifierDef;
- Protected
- Procedure Setup; override;
- Procedure TearDown; override;
- public
- procedure GetVar(var Result: TFPExpressionResult; ConstRef AName: ShortString);
- Published
- Procedure TestIsAggregate;
- Procedure TestHasAggregate;
- Procedure TestBinaryAggregate;
- Procedure TestUnaryAggregate;
- Procedure TestCountAggregate;
- Procedure TestSumAggregate;
- Procedure TestSumAggregate2;
- Procedure TestSumAggregate3;
- Procedure TestAvgAggregate;
- Procedure TestAvgAggregate2;
- Procedure TestAvgAggregate3;
- end;
- { TTestBuiltinsManager }
- TTestBuiltinsManager = Class(TTestExpressionParser)
- private
- FM : TExprBuiltInManager;
- Protected
- procedure Setup; override;
- procedure Teardown; override;
- Published
- procedure TestCreate;
- procedure TestVariable1;
- procedure TestVariable2;
- procedure TestVariable3;
- procedure TestVariable4;
- procedure TestVariable5;
- procedure TestVariable6;
- procedure TestVariable7;
- procedure TestFunction1;
- procedure TestFunction2;
- procedure TestDelete;
- procedure TestRemove;
- end;
- TTestBuiltins = Class(TTestExpressionParser)
- private
- FValue : Integer;
- FM : TExprBuiltInManager;
- FExpr : String;
- procedure DoAverage(Var Result : TFPExpressionResult; ConstRef AName : ShortString);
- procedure DoSeries(var Result: TFPExpressionResult; ConstRef AName: ShortString);
- Protected
- procedure Setup; override;
- procedure Teardown; override;
- Procedure SetExpression(Const AExpression : String);
- Procedure AssertVariable(Const ADefinition : String; AResultType : TResultType);
- Procedure AssertFunction(Const ADefinition,AResultType,ArgumentTypes : String; ACategory : TBuiltinCategory);
- procedure AssertExpression(Const AExpression : String; AResult : Int64);
- procedure AssertExpression(Const AExpression : String; Const AResult : String);
- procedure AssertExpression(Const AExpression : String; Const AResult : TExprFloat);
- procedure AssertExpression(Const AExpression : String; Const AResult : Boolean);
- procedure AssertDateTimeExpression(Const AExpression : String; Const AResult : TDateTime);
- procedure AssertAggregateExpression(Const AExpression : String; AResult : Int64; AUpdateCount : integer);
- procedure AssertAggregateExpression(Const AExpression : String; AResult : TExprFloat; AUpdateCount : integer);
- procedure AssertAggregateCurrExpression(Const AExpression : String; AResult : Currency; AUpdateCount : integer);
- Published
- procedure TestRegister;
- Procedure TestVariablepi;
- Procedure TestFunctioncos;
- Procedure TestFunctionsin;
- Procedure TestFunctionarctan;
- Procedure TestFunctionabs;
- Procedure TestFunctionsqr;
- Procedure TestFunctionsqrt;
- Procedure TestFunctionexp;
- Procedure TestFunctionln;
- Procedure TestFunctionlog;
- Procedure TestFunctionfrac;
- Procedure TestFunctionint;
- Procedure TestFunctionround;
- Procedure TestFunctiontrunc;
- Procedure TestFunctionlength;
- Procedure TestFunctioncopy;
- Procedure TestFunctiondelete;
- Procedure TestFunctionpos;
- Procedure TestFunctionlowercase;
- Procedure TestFunctionuppercase;
- Procedure TestFunctionstringreplace;
- Procedure TestFunctioncomparetext;
- Procedure TestFunctiondate;
- Procedure TestFunctiontime;
- Procedure TestFunctionnow;
- Procedure TestFunctiondayofweek;
- Procedure TestFunctionextractyear;
- Procedure TestFunctionextractmonth;
- Procedure TestFunctionextractday;
- Procedure TestFunctionextracthour;
- Procedure TestFunctionextractmin;
- Procedure TestFunctionextractsec;
- Procedure TestFunctionextractmsec;
- Procedure TestFunctionencodedate;
- Procedure TestFunctionencodetime;
- Procedure TestFunctionencodedatetime;
- Procedure TestFunctionshortdayname;
- Procedure TestFunctionshortmonthname;
- Procedure TestFunctionlongdayname;
- Procedure TestFunctionlongmonthname;
- Procedure TestFunctionformatdatetime;
- Procedure TestFunctionshl;
- Procedure TestFunctionshr;
- Procedure TestFunctionIFS;
- Procedure TestFunctionIFF;
- Procedure TestFunctionIFD;
- Procedure TestFunctionIFI;
- Procedure TestFunctioninttostr;
- Procedure TestFunctionstrtoint;
- Procedure TestFunctionstrtointdef;
- Procedure TestFunctionfloattostr;
- Procedure TestFunctionstrtofloat;
- Procedure TestFunctionstrtofloatdef;
- Procedure TestFunctionbooltostr;
- Procedure TestFunctionstrtobool;
- Procedure TestFunctionstrtobooldef;
- Procedure TestFunctiondatetostr;
- Procedure TestFunctiontimetostr;
- Procedure TestFunctionstrtodate;
- Procedure TestFunctionstrtodatedef;
- Procedure TestFunctionstrtotime;
- Procedure TestFunctionstrtotimedef;
- Procedure TestFunctionstrtodatetime;
- Procedure TestFunctionstrtodatetimedef;
- Procedure TestFunctionAggregateSum;
- Procedure TestFunctionAggregateSumFloat;
- Procedure TestFunctionAggregateSumCurrency;
- Procedure TestFunctionAggregateCount;
- Procedure TestFunctionAggregateAvg;
- Procedure TestFunctionAggregateMin;
- Procedure TestFunctionAggregateMax;
- end;
- implementation
- uses typinfo;
- { TTestParserAggregate }
- procedure TTestParserAggregate.Setup;
- begin
- inherited Setup;
- FVarValue:=0;
- FFunction:=TFPExprIdentifierDef.Create(Nil);
- FFunction.Name:='Count';
- FFunction2:=TFPExprIdentifierDef.Create(Nil);
- FFunction2.Name:='MyVar';
- FFunction2.ResultType:=rtInteger;
- FFunction2.IdentifierType:=itVariable;
- FFunction2.OnGetVariableValue:=@GetVar;
- FLeft:=TAggregateNode.Create;
- FRight:=TAggregateNode.Create;
- end;
- procedure TTestParserAggregate.TearDown;
- begin
- FreeAndNil(FFunction);
- FreeAndNil(FLeft);
- FreeAndNil(FRight);
- inherited TearDown;
- end;
- procedure TTestParserAggregate.GetVar(var Result: TFPExpressionResult; ConstRef
- AName: ShortString);
- begin
- Result.ResultType:=FFunction2.ResultType;
- Case Result.ResultType of
- rtInteger : Result.ResInteger:=FVarValue;
- rtFloat : Result.ResFloat:=FVarValue / 2;
- rtCurrency : Result.ResCurrency:=FVarValue / 2;
- end;
- end;
- procedure TTestParserAggregate.TestIsAggregate;
- begin
- AssertEquals('ExprNode',False,TFPExprNode.IsAggregate);
- AssertEquals('TAggregateExpr',True,TAggregateExpr.IsAggregate);
- AssertEquals('TAggregateExpr',False,TFPBinaryOperation.IsAggregate);
- end;
- procedure TTestParserAggregate.TestHasAggregate;
- Var
- N : TFPExprNode;
- begin
- N:=TFPExprNode.Create;
- try
- AssertEquals('ExprNode',False,N.HasAggregate);
- finally
- N.Free;
- end;
- N:=TAggregateExpr.Create;
- try
- AssertEquals('ExprNode',True,N.HasAggregate);
- finally
- N.Free;
- end;
- end;
- procedure TTestParserAggregate.TestBinaryAggregate;
- Var
- B : TFPBinaryOperation;
- begin
- B:=TFPBinaryOperation.Create(Fleft,TFPConstExpression.CreateInteger(1));
- try
- FLeft:=Nil;
- AssertEquals('Binary',True,B.HasAggregate);
- finally
- B.Free;
- end;
- B:=TFPBinaryOperation.Create(TFPConstExpression.CreateInteger(1),FRight);
- try
- FRight:=Nil;
- AssertEquals('Binary',True,B.HasAggregate);
- finally
- B.Free;
- end;
- end;
- procedure TTestParserAggregate.TestUnaryAggregate;
- Var
- B : TFPUnaryOperator;
- begin
- B:=TFPUnaryOperator.Create(Fleft);
- try
- FLeft:=Nil;
- AssertEquals('Unary',True,B.HasAggregate);
- finally
- B.Free;
- end;
- end;
- procedure TTestParserAggregate.TestCountAggregate;
- Var
- C : TAggregateCount;
- I : Integer;
- R : TFPExpressionResult;
- begin
- FFunction.ResultType:=rtInteger;
- FFunction.ParameterTypes:='';
- C:=TAggregateCount.CreateFunction(FFunction,Nil);
- try
- C.Check;
- C.InitAggregate;
- For I:=1 to 11 do
- C.UpdateAggregate;
- C.GetNodeValue(R);
- AssertEquals('Correct type',rtInteger,R.ResultType);
- AssertEquals('Correct value',11,R.ResInteger);
- finally
- C.Free;
- end;
- end;
- procedure TTestParserAggregate.TestSumAggregate;
- Var
- C : TAggregateSum;
- V : TFPExprVariable;
- I : Integer;
- R : TFPExpressionResult;
- A : TExprArgumentArray;
- begin
- FFunction.ResultType:=rtInteger;
- FFunction.ParameterTypes:='I';
- FFunction.Name:='SUM';
- FFunction2.ResultType:=rtInteger;
- C:=Nil;
- V:=TFPExprVariable.CreateIdentifier(FFunction2);
- try
- SetLength(A,1);
- A[0]:=V;
- C:=TAggregateSum.CreateFunction(FFunction,A);
- C.Check;
- C.InitAggregate;
- For I:=1 to 10 do
- begin
- FVarValue:=I;
- C.UpdateAggregate;
- end;
- C.GetNodeValue(R);
- AssertEquals('Correct type',rtInteger,R.ResultType);
- AssertEquals('Correct value',55,R.ResInteger);
- finally
- C.Free;
- end;
- end;
- procedure TTestParserAggregate.TestSumAggregate2;
- Var
- C : TAggregateSum;
- V : TFPExprVariable;
- I : Integer;
- R : TFPExpressionResult;
- A : TExprArgumentArray;
- begin
- FFunction.ResultType:=rtFloat;
- FFunction.ParameterTypes:='F';
- FFunction.Name:='SUM';
- FFunction2.ResultType:=rtFloat;
- C:=Nil;
- V:=TFPExprVariable.CreateIdentifier(FFunction2);
- try
- SetLength(A,1);
- A[0]:=V;
- C:=TAggregateSum.CreateFunction(FFunction,A);
- C.Check;
- C.InitAggregate;
- For I:=1 to 10 do
- begin
- FVarValue:=I;
- C.UpdateAggregate;
- end;
- C.GetNodeValue(R);
- AssertEquals('Correct type',rtFloat,R.ResultType);
- AssertEquals('Correct value',55/2,R.ResFloat,0.1);
- finally
- C.Free;
- end;
- end;
- procedure TTestParserAggregate.TestSumAggregate3;
- Var
- C : TAggregateSum;
- V : TFPExprVariable;
- I : Integer;
- R : TFPExpressionResult;
- A : TExprArgumentArray;
- begin
- FFunction.ResultType:=rtCurrency;
- FFunction.ParameterTypes:='F';
- FFunction.Name:='SUM';
- FFunction2.ResultType:=rtCurrency;
- C:=Nil;
- V:=TFPExprVariable.CreateIdentifier(FFunction2);
- try
- SetLength(A,1);
- A[0]:=V;
- C:=TAggregateSum.CreateFunction(FFunction,A);
- C.Check;
- C.InitAggregate;
- For I:=1 to 10 do
- begin
- FVarValue:=I;
- C.UpdateAggregate;
- end;
- C.GetNodeValue(R);
- AssertEquals('Correct type',rtCurrency,R.ResultType);
- AssertEquals('Correct value',55/2,R.ResCurrency,0.1);
- finally
- C.Free;
- end;
- end;
- procedure TTestParserAggregate.TestAvgAggregate;
- Var
- C : TAggregateAvg;
- V : TFPExprVariable;
- I : Integer;
- R : TFPExpressionResult;
- A : TExprArgumentArray;
- begin
- FFunction.ResultType:=rtInteger;
- FFunction.ParameterTypes:='F';
- FFunction.Name:='AVG';
- FFunction2.ResultType:=rtInteger;
- C:=Nil;
- V:=TFPExprVariable.CreateIdentifier(FFunction2);
- try
- SetLength(A,1);
- A[0]:=V;
- C:=TAggregateAvg.CreateFunction(FFunction,A);
- C.Check;
- C.InitAggregate;
- For I:=1 to 10 do
- begin
- FVarValue:=I;
- C.UpdateAggregate;
- end;
- C.GetNodeValue(R);
- AssertEquals('Correct type',rtFloat,R.ResultType);
- AssertEquals('Correct value',5.5,R.ResFloat,0.1);
- finally
- C.Free;
- end;
- end;
- procedure TTestParserAggregate.TestAvgAggregate2;
- Var
- C : TAggregateAvg;
- V : TFPExprVariable;
- I : Integer;
- R : TFPExpressionResult;
- A : TExprArgumentArray;
- begin
- FFunction.ResultType:=rtInteger;
- FFunction.ParameterTypes:='F';
- FFunction.Name:='AVG';
- FFunction2.ResultType:=rtFloat;
- C:=Nil;
- V:=TFPExprVariable.CreateIdentifier(FFunction2);
- try
- SetLength(A,1);
- A[0]:=V;
- C:=TAggregateAvg.CreateFunction(FFunction,A);
- C.Check;
- C.InitAggregate;
- For I:=1 to 10 do
- begin
- FVarValue:=I;
- C.UpdateAggregate;
- end;
- C.GetNodeValue(R);
- AssertEquals('Correct type',rtFloat,R.ResultType);
- AssertEquals('Correct value',5.5/2,R.ResFloat,0.1);
- finally
- C.Free;
- end;
- end;
- procedure TTestParserAggregate.TestAvgAggregate3;
- Var
- C : TAggregateAvg;
- V : TFPExprVariable;
- R : TFPExpressionResult;
- A : TExprArgumentArray;
- begin
- FFunction.ResultType:=rtInteger;
- FFunction.ParameterTypes:='F';
- FFunction.Name:='AVG';
- FFunction2.ResultType:=rtFloat;
- C:=Nil;
- V:=TFPExprVariable.CreateIdentifier(FFunction2);
- try
- SetLength(A,1);
- A[0]:=V;
- C:=TAggregateAvg.CreateFunction(FFunction,A);
- C.Check;
- C.InitAggregate;
- C.GetNodeValue(R);
- AssertEquals('Correct type',rtFloat,R.ResultType);
- AssertEquals('Correct value',0.0,R.ResFloat,0.1);
- finally
- C.Free;
- end;
- end;
- { TAggregateNode }
- class function TAggregateNode.IsAggregate: Boolean;
- begin
- Result:=True
- end;
- function TAggregateNode.NodeType: TResultType;
- begin
- Result:=rtInteger;
- end;
- procedure TAggregateNode.InitAggregate;
- begin
- inherited InitAggregate;
- inc(InitCount)
- end;
- procedure TAggregateNode.UpdateAggregate;
- begin
- inherited UpdateAggregate;
- inc(UpdateCount);
- end;
- procedure TAggregateNode.GetNodeValue(var Result: TFPExpressionResult);
- begin
- Result.ResultType:=rtInteger;
- Result.ResInteger:=updateCount;
- end;
- procedure TTestExpressionScanner.TestCreate;
- begin
- AssertEquals('Empty source','',FP.Source);
- AssertEquals('Pos is zero',0,FP.Pos);
- AssertEquals('CurrentChar is zero',#0,FP.CurrentChar);
- AssertEquals('Current token type is EOF',ttEOF,FP.TokenType);
- AssertEquals('Current token is empty','',FP.Token);
- end;
- procedure TTestExpressionScanner.TestSetSource;
- begin
- FP.Source:='Abc';
- FP.Source:='';
- AssertEquals('Empty source','',FP.Source);
- AssertEquals('Pos is zero',0,FP.Pos);
- AssertEquals('CurrentChar is zero',#0,FP.CurrentChar);
- AssertEquals('Current token type is EOF',ttEOF,FP.TokenType);
- AssertEquals('Current token is empty','',FP.Token);
- end;
- procedure TTestExpressionScanner.TestWhiteSpace;
- begin
- TestString(' ',ttEOF);
- end;
- procedure TTestExpressionScanner.TestTokens;
- Const
- TestStrings : Array[TTokenType] of String
- (*
- TTokenType = (ttPlus, ttMinus, ttLessThan, ttLargerThan, ttEqual, ttDiv,
- ttMod, ttMul, ttLeft, ttRight, ttLessThanEqual,
- ttLargerThanEqual, ttunequal, ttNumber, ttString, ttIdentifier,
- ttComma, ttAnd, ttOr, ttXor, ttTrue, ttFalse, ttNot, ttif,
- ttCase, ttPower, ttEOF); // keep ttEOF last
- *)
- = ('+','-','<','>','=','/',
- 'mod','*','(',')','<=',
- '>=', '<>','1','''abc''','abc',
- ',','and', 'or','xor','true','false','not',
- 'if','case','^','');
- var
- t : TTokenType;
- begin
- For T:=Low(TTokenType) to High(TTokenType) do
- TestString(TestStrings[t],t);
- end;
- procedure TTestExpressionScanner.TestInvalidNumber;
- begin
- TestString(FInvalidString,ttNumber);
- end;
- procedure TTestExpressionScanner.DoInvalidNumber(AString : String);
- begin
- FInvalidString:=AString;
- AssertException('Invalid number "'+AString+'" ',EExprScanner,@TestInvalidNumber);
- end;
- procedure TTestExpressionScanner.TestNumber;
- begin
- TestString('123',ttNumber);
- TestString('$FF',ttNumber);
- TestString('&77',ttNumber);
- TestString('%11111111',ttNumber);
- TestString('123.4',ttNumber);
- TestString('123.E4',ttNumber);
- TestString('1.E4',ttNumber);
- TestString('1e-2',ttNumber);
- DoInValidNumber('$GG');
- DoInvalidNumber('&88');
- DoInvalidNumber('%22');
- DoInvalidNumber('1..1');
- DoInvalidNumber('1.E--1');
- // DoInvalidNumber('.E-1');
- end;
- procedure TTestExpressionScanner.TestInvalidCharacter;
- begin
- DoInvalidNumber('~');
- DoInvalidNumber('#');
- DoInvalidNumber('$');
- end;
- procedure TTestExpressionScanner.TestUnterminatedString;
- begin
- DoInvalidNumber('''abc');
- end;
- procedure TTestExpressionScanner.TestQuotesInString;
- begin
- TestString('''That''''s it''',ttString);
- TestString('''''''s it''',ttString);
- TestString('''s it''''''',ttString);
- end;
- procedure TTestExpressionScanner.TestIdentifier(Const ASource,ATokenName : string);
- begin
- FP.Source:=ASource;
- AssertEquals('Token type',ttIdentifier,FP.GetToken);
- AssertEquals('Token name',ATokenName,FP.Token);
- end;
- procedure TTestExpressionScanner.TestIdentifiers;
- begin
- TestIdentifier('a','a');
- TestIdentifier(' a','a');
- TestIdentifier('a ','a');
- TestIdentifier('a^b','a');
- TestIdentifier('a-b','a');
- TestIdentifier('a.b','a.b');
- TestIdentifier('"a b"','a b');
- TestIdentifier('c."a b"','c.a b');
- TestIdentifier('c."ab"','c.ab');
- end;
- procedure TTestExpressionScanner.SetUp;
- begin
- FP:=TFPExpressionScanner.Create;
- end;
- procedure TTestExpressionScanner.TearDown;
- begin
- FreeAndNil(FP);
- end;
- procedure TTestExpressionScanner.AssertEquals(Msg: string; AExpected,
- AActual: TTokenType);
- Var
- S1,S2 : String;
- begin
- S1:=TokenName(AExpected);
- S2:=GetEnumName(TypeInfo(TTokenType),Ord(AActual));
- AssertEquals(Msg,S1,S2);
- end;
- procedure TTestExpressionScanner.TestString(const AString: String;
- AToken: TTokenType);
- begin
- FP.Source:=AString;
- AssertEquals('String "'+AString+'" results in token '+TokenName(AToken),AToken,FP.GetToken);
- If Not (FP.TokenType in [ttString,ttEOF]) then
- AssertEquals('String "'+AString+'" results in token string '+TokenName(AToken),AString,FP.Token)
- else if FP.TokenType=ttString then
- AssertEquals('String "'+AString+'" results in token string '+TokenName(AToken),
- StringReplace(AString,'''''','''',[rfreplaceAll]),
- ''''+FP.Token+'''');
- end;
- { TTestBaseParser }
- procedure TTestBaseParser.DoCheck;
- begin
- FCheckNode.Check;
- end;
- procedure TTestBaseParser.AssertNodeType(Msg: String; AClass: TClass;
- ANode: TFPExprNode);
- begin
- AssertNotNull(Msg+': Not null',ANode);
- AssertEquals(Msg+': Class OK',AClass,ANode.ClassType);
- end;
- procedure TTestBaseParser.AssertEquals(Msg: String; AResultType: TResultType;
- ANode: TFPExprNode);
- begin
- AssertNotNull(Msg+': Node not null',ANode);
- AssertEquals(Msg,AResultType,Anode.NodeType);
- end;
- procedure TTestBaseParser.AssertEquals(Msg: String; AExpected,
- AActual: TResultType);
- begin
- AssertEquals(Msg,ResultTypeName(AExpected),ResultTypeName(AActual));
- end;
- function TTestBaseParser.CreateIntNode(AInteger: Integer): TFPExprNode;
- begin
- Result:=TFPConstExpression.CreateInteger(AInteger);
- end;
- function TTestBaseParser.CreateFloatNode(AFloat: TExprFloat): TFPExprNode;
- begin
- Result:=TFPConstExpression.CreateFloat(AFloat);
- end;
- function TTestBaseParser.CreateStringNode(Astring: String): TFPExprNode;
- begin
- Result:=TFPConstExpression.CreateString(AString);
- end;
- function TTestBaseParser.CreateDateTimeNode(ADateTime: TDateTime): TFPExprNode;
- begin
- Result:=TFPConstExpression.CreateDateTime(ADateTime);
- end;
- procedure TTestBaseParser.AssertNodeOK(FN: TFPExprNode);
- Var
- B : Boolean;
- Msg : String;
- begin
- AssertNotNull('Node to test OK',FN);
- B:=False;
- try
- FN.Check;
- B:=True;
- except
- On E : Exception do
- Msg:=E.Message;
- end;
- If Not B then
- Fail(Format('Node %s not OK: %s',[FN.ClassName,Msg]));
- end;
- procedure TTestBaseParser.AssertNodeNotOK(const MSg : String; FN: TFPExprNode);
- begin
- FCheckNode:=FN;
- AssertException(Msg,EExprParser,@DoCheck);
- end;
- function TTestBaseParser.CreateBoolNode(ABoolean: Boolean): TFPExprNode;
- begin
- Result:=TFPConstExpression.CreateBoolean(ABoolean);
- end;
- procedure TTestBaseParser.Setup;
- begin
- inherited Setup;
- FDestroyCalled:=0;
- end;
- { TTestConstExprNode }
- procedure TTestConstExprNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestConstExprNode.TestCreateInteger;
- begin
- FN:=TFPConstExpression.CreateInteger(1);
- AssertEquals('Correct type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',1,FN.ConstValue.ResInteger);
- AssertEquals('Correct result',1,FN.NodeValue.ResInteger);
- AssertEquals('AsString ok','1',FN.AsString);
- end;
- procedure TTestConstExprNode.TestCreateFloat;
- Var
- F : Double;
- C : Integer;
- begin
- FN:=TFPConstExpression.CreateFloat(2.34);
- AssertEquals('Correct type',rtFloat,FN.NodeType);
- AssertEquals('Correct result',2.34,FN.ConstValue.ResFloat);
- AssertEquals('Correct result',2.34,FN.NodeValue.ResFloat);
- Val(FN.AsString,F,C);
- AssertEquals('Correct conversion',0,C);
- AssertEquals('AsString ok',2.34,F,0.001);
- end;
- procedure TTestConstExprNode.TestCreateBoolean;
- begin
- FN:=TFPConstExpression.CreateBoolean(True);
- AssertEquals('Correct type',rtBoolean,FN.NodeType);
- AssertEquals('Correct result',True,FN.ConstValue.ResBoolean);
- AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
- AssertEquals('AsString ok','True',FN.AsString);
- FreeAndNil(FN);
- FN:=TFPConstExpression.CreateBoolean(False);
- AssertEquals('AsString ok','False',FN.AsString);
- end;
- procedure TTestConstExprNode.TestCreateDateTime;
- Var
- D : TDateTime;
- S : String;
- begin
- D:=Now;
- FN:=TFPConstExpression.CreateDateTime(D);
- AssertEquals('Correct type',rtDateTime,FN.NodeType);
- AssertEquals('Correct result',D,FN.ConstValue.ResDateTime);
- AssertEquals('Correct result',D,FN.NodeValue.ResDateTime);
- S:=''''+FormatDateTime('cccc',D)+'''';
- AssertEquals('AsString ok',S,FN.AsString);
- end;
- procedure TTestConstExprNode.TestCreateString;
- Var
- S : String;
- begin
- S:='Ohlala';
- FN:=TFPConstExpression.CreateString(S);
- AssertEquals('Correct type',rtString,FN.NodeType);
- AssertEquals('Correct result',S,FN.ConstValue.ResString);
- AssertEquals('Correct result',S,FN.NodeValue.ResString);
- AssertEquals('AsString ok',''''+S+'''',FN.AsString);
- end;
- { TTestNegateExprNode }
- procedure TTestNegateExprNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestNegateExprNode.TestCreateInteger;
- begin
- FN:=TFPNegateOperation.Create(CreateIntNode(23));
- AssertEquals('Negate has correct type',rtInteger,FN.NodeType);
- AssertEquals('Negate has correct result',-23,FN.NodeValue.Resinteger);
- AssertEquals('Negate has correct string','-23',FN.AsString);
- AssertNodeOK(FN);
- end;
- procedure TTestNegateExprNode.TestCreateFloat;
- Var
- S : String;
- begin
- FN:=TFPNegateOperation.Create(CreateFloatNode(1.23));
- AssertEquals('Negate has correct type',rtFloat,FN.NodeType);
- AssertEquals('Negate has correct result',-1.23,FN.NodeValue.ResFloat);
- Str(TExprFloat(-1.23),S);
- AssertEquals('Negate has correct string',S,FN.AsString);
- AssertNodeOK(FN);
- end;
- procedure TTestNegateExprNode.TestCreateOther1;
- begin
- FN:=TFPNegateOperation.Create(TFPConstExpression.CreateString('1.23'));
- AssertNodeNotOK('Negate does not accept string',FN);
- end;
- procedure TTestNegateExprNode.TestCreateOther2;
- begin
- FN:=TFPNegateOperation.Create(TFPConstExpression.CreateBoolean(True));
- AssertNodeNotOK('Negate does not accept boolean',FN)
- end;
- procedure TTestNegateExprNode.TestDestroy;
- begin
- FN:=TFPNegateOperation.Create(TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Operand Destroy called',1,self.FDestroyCalled)
- end;
- { TTestDestroyNode }
- procedure TTestDestroyNode.TestDestroy;
- Var
- FN : TMyDestroyNode;
- begin
- AssertEquals('Destroy not called yet',0,self.FDestroyCalled);
- FN:=TMyDestroyNode.CreateTest(Self);
- FN.Free;
- AssertEquals('Destroy called',1,self.FDestroyCalled)
- end;
- { TMyDestroyNode }
- constructor TMyDestroyNode.CreateTest(ATest: TTestBaseParser);
- begin
- FTest:=ATest;
- Inherited CreateInteger(1);
- end;
- destructor TMyDestroyNode.Destroy;
- begin
- Inc(FTest.FDestroyCalled);
- inherited Destroy;
- end;
- { TTestBinaryAndNode }
- procedure TTestBinaryAndNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestBinaryAndNode.TestCreateInteger;
- begin
- FN:=TFPBinaryAndOperation.Create(CreateIntNode(3),CreateIntNode(2));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',2,FN.NodeValue.ResInteger);
- end;
- procedure TTestBinaryAndNode.TestCreateBoolean;
- begin
- FN:=TFPBinaryAndOperation.Create(CreateBoolNode(True),CreateBoolNode(True));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtBoolean,FN.NodeType);
- AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
- end;
- procedure TTestBinaryAndNode.TestCreateBooleanInteger;
- begin
- FN:=TFPBinaryAndOperation.Create(CreateBoolNode(True),CreateIntNode(0));
- AssertNodeNotOK('Different node types',FN);
- end;
- procedure TTestBinaryAndNode.TestCreateString;
- begin
- FN:=TFPBinaryAndOperation.Create(CreateStringNode('True'),CreateStringNode('True'));
- AssertNodeNotOK('String node type',FN);
- end;
- procedure TTestBinaryAndNode.TestCreateFloat;
- begin
- FN:=TFPBinaryAndOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
- AssertNodeNotOK('float node type',FN);
- end;
- procedure TTestBinaryAndNode.TestCreateDateTime;
- begin
- FN:=TFPBinaryAndOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now));
- AssertNodeNotOK('DateTime node type',FN);
- end;
- procedure TTestBinaryAndNode.TestDestroy;
- begin
- FN:=TFPBinaryAndOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- { TTestBinaryOrNode }
- procedure TTestBinaryOrNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestBinaryOrNode.TestCreateInteger;
- begin
- FN:=TFPBinaryOrOperation.Create(CreateIntNode(1),CreateIntNode(2));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
- end;
- procedure TTestBinaryOrNode.TestCreateBoolean;
- begin
- FN:=TFPBinaryOrOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtBoolean,FN.NodeType);
- AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
- end;
- procedure TTestBinaryOrNode.TestCreateBooleanInteger;
- begin
- FN:=TFPBinaryOrOperation.Create(CreateBoolNode(True),CreateIntNode(0));
- AssertNodeNotOK('Different node types',FN);
- end;
- procedure TTestBinaryOrNode.TestCreateString;
- begin
- FN:=TFPBinaryOrOperation.Create(CreateStringNode('True'),CreateStringNode('True'));
- AssertNodeNotOK('String node type',FN);
- end;
- procedure TTestBinaryOrNode.TestCreateFloat;
- begin
- FN:=TFPBinaryOrOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
- AssertNodeNotOK('float node type',FN);
- end;
- procedure TTestBinaryOrNode.TestCreateDateTime;
- begin
- FN:=TFPBinaryOrOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now));
- AssertNodeNotOK('DateTime node type',FN);
- end;
- procedure TTestBinaryOrNode.TestDestroy;
- begin
- FN:=TFPBinaryOrOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- { TTestBinaryXorNode }
- procedure TTestBinaryXorNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestBinaryXorNode.TestCreateInteger;
- begin
- FN:=TFPBinaryXorOperation.Create(CreateIntNode(1),CreateIntNode(2));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
- end;
- procedure TTestBinaryXorNode.TestCreateBoolean;
- begin
- FN:=TFPBinaryXorOperation.Create(CreateBoolNode(True),CreateBoolNode(True));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtBoolean,FN.NodeType);
- AssertEquals('Correct result',False,FN.NodeValue.ResBoolean);
- end;
- procedure TTestBinaryXorNode.TestCreateBooleanInteger;
- begin
- FN:=TFPBinaryXorOperation.Create(CreateBoolNode(True),CreateIntNode(0));
- AssertNodeNotOK('Different node types',FN);
- end;
- procedure TTestBinaryXorNode.TestCreateString;
- begin
- FN:=TFPBinaryXorOperation.Create(CreateStringNode('True'),CreateStringNode('True'));
- AssertNodeNotOK('String node type',FN);
- end;
- procedure TTestBinaryXorNode.TestCreateFloat;
- begin
- FN:=TFPBinaryXorOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
- AssertNodeNotOK('float node type',FN);
- end;
- procedure TTestBinaryXorNode.TestCreateDateTime;
- begin
- FN:=TFPBinaryXorOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now));
- AssertNodeNotOK('DateTime node type',FN);
- end;
- procedure TTestBinaryXorNode.TestDestroy;
- begin
- FN:=TFPBinaryXorOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- { TTestBooleanNode }
- procedure TTestBooleanNode.TestNode(B: TFPBooleanResultOperation;
- AResult: Boolean);
- begin
- AssertEquals(Format('Test %s(%s,%s) result',[B.ClassName,B.Left.AsString,B.Right.AsString]),Aresult,B.NodeValue.resBoolean);
- end;
- { TTestEqualNode }
- procedure TTestEqualNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- class function TTestEqualNode.NodeClass: TFPBooleanResultOperationClass;
- begin
- Result:=TFPEqualOperation;
- end;
- class function TTestEqualNode.ExpectedResult: Boolean;
- begin
- Result:=True
- end;
- class function TTestEqualNode.OperatorString: String;
- begin
- Result:='=';
- end;
- procedure TTestEqualNode.TestCreateIntegerEqual;
- begin
- FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(1));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateIntegerUnEqual;
- begin
- FN:=NodeClass.Create(CreateIntNode(2),CreateIntNode(1));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateFloatEqual;
- begin
- FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateFloatUnEqual;
- begin
- FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.34));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateStringEqual;
- begin
- FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('now'));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateStringUnEqual;
- begin
- FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('then'));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateBooleanEqual;
- begin
- FN:=NodeClass.Create(CreateBoolNode(True),CreateBoolNode(True));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateBooleanUnEqual;
- begin
- FN:=NodeClass.Create(CreateBoolNode(False),CreateBoolNode(True));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateDateTimeEqual;
- Var
- D : TDateTime;
- begin
- D:=Now;
- FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,ExpectedResult);
- end;
- procedure TTestEqualNode.TestCreateDateTimeUnEqual;
- Var
- D : TDateTime;
- begin
- D:=Now;
- FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not ExpectedResult);
- end;
- procedure TTestEqualNode.TestDestroy;
- begin
- FN:=NodeClass.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- procedure TTestEqualNode.TestWrongTypes1;
- begin
- FN:=NodeClass.Create(CreateIntNode(3),CreateStringNode('1.23'));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestEqualNode.TestWrongTypes2;
- begin
- FN:=NodeClass.Create(CreateDateTimeNode(3),CreateStringNode('1.23'));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestEqualNode.TestWrongTypes3;
- begin
- FN:=NodeClass.Create(CreateFloatNode(1.3),CreateStringNode('1.23'));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestEqualNode.TestWrongTypes4;
- begin
- FN:=NodeClass.Create(CreateBoolNode(False),CreateStringNode('1.23'));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestEqualNode.TestWrongTypes5;
- begin
- FN:=NodeClass.Create(CreateFloatNode(1),CreateIntNode(1));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestEqualNode.TestAsString;
- begin
- FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2));
- AssertEquals('Asstring works ok','1 '+OPeratorString+' 2',FN.AsString);
- end;
- { TTestUnEqualNode }
- class function TTestUnEqualNode.NodeClass: TFPBooleanResultOperationClass;
- begin
- Result:=TFPUnEqualOperation;
- end;
- class function TTestUnEqualNode.ExpectedResult: Boolean;
- begin
- Result:=False;
- end;
- class function TTestUnEqualNode.OperatorString: String;
- begin
- Result:='<>';
- end;
- { TTestLessThanNode }
- class function TTestLessThanNode.NodeClass: TFPBooleanResultOperationClass;
- begin
- Result:=TFPLessThanOperation;
- end;
- class function TTestLessThanNode.Larger: Boolean;
- begin
- Result:=False;
- end;
- class function TTestLessThanNode.AllowEqual: Boolean;
- begin
- Result:=False;
- end;
- class function TTestLessThanNode.OperatorString: String;
- begin
- Result:='<';
- end;
- procedure TTestLessThanNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestLessThanNode.TestCreateIntegerEqual;
- begin
- FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(1));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,AllowEqual);
- end;
- procedure TTestLessThanNode.TestCreateIntegerSmaller;
- begin
- FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not Larger);
- end;
- procedure TTestLessThanNode.TestCreateIntegerLarger;
- begin
- FN:=NodeClass.Create(CreateIntNode(2),CreateIntNode(1));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Larger);
- end;
- procedure TTestLessThanNode.TestCreateFloatEqual;
- begin
- FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,AllowEqual);
- end;
- procedure TTestLessThanNode.TestCreateFloatSmaller;
- begin
- FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(4.56));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not Larger);
- end;
- procedure TTestLessThanNode.TestCreateFloatLarger;
- begin
- FN:=NodeClass.Create(CreateFloatNode(4.56),CreateFloatNode(1.23));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Larger);
- end;
- procedure TTestLessThanNode.TestCreateDateTimeEqual;
- Var
- D : TDateTime;
- begin
- D:=Now;
- FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,AllowEqual);
- end;
- procedure TTestLessThanNode.TestCreateDateTimeSmaller;
- Var
- D : TDateTime;
- begin
- D:=Now;
- FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D+1));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not larger);
- end;
- procedure TTestLessThanNode.TestCreateDateTimeLarger;
- Var
- D : TDateTime;
- begin
- D:=Now;
- FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,larger);
- end;
- procedure TTestLessThanNode.TestCreateStringEqual;
- begin
- FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('now'));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,AllowEqual);
- end;
- procedure TTestLessThanNode.TestCreateStringSmaller;
- begin
- FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('then'));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Not Larger);
- end;
- procedure TTestLessThanNode.TestCreateStringLarger;
- begin
- FN:=NodeClass.Create(CreateStringNode('then'),CreateStringNode('now'));
- AssertNodeOk(FN);
- AssertEquals('Boolean result',rtBoolean,FN.NodeType);
- TestNode(FN,Larger);
- end;
- procedure TTestLessThanNode.TestWrongTypes1;
- begin
- FN:=NodeClass.Create(CreateIntNode(3),CreateStringNode('1.23'));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestLessThanNode.TestWrongTypes2;
- begin
- FN:=NodeClass.Create(CreateDateTimeNode(3),CreateStringNode('1.23'));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestLessThanNode.TestWrongTypes3;
- begin
- FN:=NodeClass.Create(CreateFloatNode(1.3),CreateStringNode('1.23'));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestLessThanNode.TestWrongTypes4;
- begin
- FN:=NodeClass.Create(CreateBoolNode(False),CreateStringNode('1.23'));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestLessThanNode.TestWrongTypes5;
- begin
- FN:=NodeClass.Create(CreateFloatNode(1.23),CreateIntNode(1));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestLessThanNode.TestNoBoolean1;
- begin
- FN:=NodeClass.Create(CreateBoolNode(False),CreateIntNode(1));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestLessThanNode.TestNoBoolean2;
- begin
- FN:=NodeClass.Create(CreateIntNode(1),CreateBoolNode(False));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestLessThanNode.TestNoBoolean3;
- begin
- FN:=NodeClass.Create(CreateBoolNode(False),CreateBoolNode(False));
- AssertNodeNotOk('Wrong Types',FN);
- end;
- procedure TTestLessThanNode.TestAsString;
- begin
- FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2));
- AssertEquals('Asstring works ok','1 '+OPeratorString+' 2',FN.AsString);
- end;
- { TTestLessThanEqualNode }
- class function TTestLessThanEqualNode.NodeClass: TFPBooleanResultOperationClass;
- begin
- Result:=TFPLessThanEqualOperation;
- end;
- class function TTestLessThanEqualNode.AllowEqual: Boolean;
- begin
- Result:=True;
- end;
- class function TTestLessThanEqualNode.OperatorString: String;
- begin
- Result:='<=';
- end;
- { TTestLargerThanNode }
- class function TTestLargerThanNode.NodeClass: TFPBooleanResultOperationClass;
- begin
- Result:=TFPGreaterThanOperation;
- end;
- class function TTestLargerThanNode.Larger: Boolean;
- begin
- Result:=True;
- end;
- class function TTestLargerThanNode.OperatorString: String;
- begin
- Result:='>';
- end;
- { TTestLargerThanEqualNode }
- class function TTestLargerThanEqualNode.NodeClass: TFPBooleanResultOperationClass;
- begin
- Result:=TFPGreaterThanEqualOperation;
- end;
- class function TTestLargerThanEqualNode.AllowEqual: Boolean;
- begin
- Result:=True;
- end;
- class function TTestLargerThanEqualNode.OperatorString: String;
- begin
- Result:='>=';
- end;
- { TTestAddNode }
- procedure TTestAddNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestAddNode.TestCreateInteger;
- begin
- FN:=TFPAddOperation.Create(CreateIntNode(1),CreateIntNode(2));
- AssertEquals('Add has correct type',rtInteger,FN.NodeType);
- AssertEquals('Add has correct result',3,FN.NodeValue.ResInteger);
- end;
- procedure TTestAddNode.TestCreateFloat;
- begin
- FN:=TFPAddOperation.Create(CreateFloatNode(1.23),CreateFloatNode(4.56));
- AssertEquals('Add has correct type',rtFloat,FN.NodeType);
- AssertEquals('Add has correct result',5.79,FN.NodeValue.ResFloat);
- end;
- procedure TTestAddNode.TestCreateDateTime;
- Var
- D,T : TDateTime;
- begin
- D:=Date;
- T:=Time;
- FN:=TFPAddOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(T));
- AssertEquals('Add has correct type',rtDateTime,FN.NodeType);
- AssertEquals('Add has correct result',D+T,FN.NodeValue.ResDateTime);
- end;
- procedure TTestAddNode.TestCreateString;
- begin
- FN:=TFPAddOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
- AssertEquals('Add has correct type',rtString,FN.NodeType);
- AssertEquals('Add has correct result','aloha',FN.NodeValue.ResString);
- end;
- procedure TTestAddNode.TestCreateBoolean;
- begin
- FN:=TFPAddOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
- AssertNodeNotOK('No boolean addition',FN);
- end;
- procedure TTestAddNode.TestDestroy;
- begin
- FN:=TFPAddOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- procedure TTestAddNode.TestAsString;
- begin
- FN:=TFPAddOperation.Create(CreateIntNode(1),CreateIntNode(2));
- AssertEquals('Asstring works ok','1 + 2',FN.AsString);
- end;
- { TTestSubtractNode }
- procedure TTestSubtractNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestSubtractNode.TestCreateInteger;
- begin
- FN:=TFPSubtractOperation.Create(CreateIntNode(4),CreateIntNode(1));
- AssertEquals('Subtract has correct type',rtInteger,FN.NodeType);
- AssertEquals('Subtract has correct result',3,FN.NodeValue.ResInteger);
- end;
- procedure TTestSubtractNode.TestCreateFloat;
- begin
- FN:=TFPSubtractOperation.Create(CreateFloatNode(4.56),CreateFloatNode(1.23));
- AssertEquals('Subtract has correct type',rtFloat,FN.NodeType);
- AssertEquals('Subtract has correct result',3.33,FN.NodeValue.ResFloat);
- end;
- procedure TTestSubtractNode.TestCreateDateTime;
- Var
- D,T : TDateTime;
- begin
- D:=Date;
- T:=Time;
- FN:=TFPSubtractOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
- AssertEquals('Subtract has correct type',rtDateTime,FN.NodeType);
- AssertEquals('Subtract has correct result',D,FN.NodeValue.ResDateTime);
- end;
- procedure TTestSubtractNode.TestCreateString;
- begin
- FN:=TFPSubtractOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
- AssertNodeNotOK('No string Subtract',FN);
- end;
- procedure TTestSubtractNode.TestCreateBoolean;
- begin
- FN:=TFPSubtractOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
- AssertNodeNotOK('No boolean Subtract',FN);
- end;
- procedure TTestSubtractNode.TestDestroy;
- begin
- FN:=TFPSubtractOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- procedure TTestSubtractNode.TestAsString;
- begin
- FN:=TFPSubtractOperation.Create(CreateIntNode(1),CreateIntNode(2));
- AssertEquals('Asstring works ok','1 - 2',FN.AsString);
- end;
- { TTestMultiplyNode }
- procedure TTestMultiplyNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestMultiplyNode.TestCreateInteger;
- begin
- FN:=TFPMultiplyOperation.Create(CreateIntNode(4),CreateIntNode(2));
- AssertEquals('multiply has correct type',rtInteger,FN.NodeType);
- AssertEquals('multiply has correct result',8,FN.NodeValue.ResInteger);
- end;
- procedure TTestMultiplyNode.TestCreateFloat;
- begin
- FN:=TFPMultiplyOperation.Create(CreateFloatNode(2.0),CreateFloatNode(1.23));
- AssertEquals('multiply has correct type',rtFloat,FN.NodeType);
- AssertEquals('multiply has correct result',2.46,FN.NodeValue.ResFloat);
- end;
- procedure TTestMultiplyNode.TestCreateDateTime;
- Var
- D,T : TDateTime;
- begin
- D:=Date;
- T:=Time;
- FN:=TFPMultiplyOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
- AssertNodeNotOK('No datetime multiply',FN);
- end;
- procedure TTestMultiplyNode.TestCreateString;
- begin
- FN:=TFPMultiplyOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
- AssertNodeNotOK('No string multiply',FN);
- end;
- procedure TTestMultiplyNode.TestCreateBoolean;
- begin
- FN:=TFPMultiplyOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
- AssertNodeNotOK('No boolean multiply',FN);
- end;
- procedure TTestMultiplyNode.TestDestroy;
- begin
- FN:=TFPMultiplyOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- procedure TTestMultiplyNode.TestAsString;
- begin
- FN:=TFPMultiplyOperation.Create(CreateIntNode(1),CreateIntNode(2));
- AssertEquals('Asstring works ok','1 * 2',FN.AsString);
- end;
- { TTestPowerNode }
- procedure TTestPowerNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestPowerNode.Setup;
- begin
- inherited ;
- FE:=TFpExpressionParser.Create(Nil);
- FE.Builtins := [bcMath];
- end;
- procedure TTestPowerNode.Calc(AExpr: String; Expected: Double =NaN);
- const
- EPS = 1e-9;
- var
- res: TFpExpressionResult;
- x: Double;
- begin
- FE.Expression := AExpr;
- res:=FE.Evaluate;
- x:= ArgToFloat(res);
- if not IsNaN(Expected) then
- AssertEquals('Expression '+AExpr+' result',Expected,X,Eps);
- end;
- procedure TTestPowerNode.TestCalc;
- begin
- Calc('2^2', Power(2, 2));
- Calc('2^-2', Power(2, -2));
- Calc('2^(-2)', Power(2, -2));
- Calc('sqrt(3)^2', Power(sqrt(3), 2));
- Calc('-sqrt(3)^2', -Power(sqrt(3), 2));
- Calc('-2^2', -Power(2, 2));
- Calc('(-2.0)^2', Power(-2.0, 2));
- Calc('(-2.0)^-2', Power(-2.0, -2));
- // Odd integer exponent
- Calc('2^3', Power(2, 3));
- Calc('-2^3', -Power(2, 3));
- Calc('-2^-3', -Power(2, -3));
- Calc('-2^(-3)', -Power(2, -3));
- Calc('(-2.0)^3', Power(-2.0, 3));
- Calc('(-2.0)^-3', Power(-2.0, -3));
- // Fractional exponent
- Calc('10^2.5', power(10, 2.5));
- Calc('10^-2.5', Power(10, -2.5));
- // Expressions
- Calc('(1+1)^3', Power(1+1, 3));
- Calc('1+2^3', 1 + Power(2, 3));
- calc('2^3+1', Power(2, 3) + 1);
- Calc('2^3*2', Power(2, 3) * 2);
- Calc('2^3*-2', Power(2, 3) * -2);
- Calc('2^(1+1)', Power(2, 1+1));
- Calc('2^-(1+1)', Power(2, -(1+1)));
- WriteLn;
- // Special cases
- Calc('0^0', power(0, 0));
- calc('0^1', power(0, 1));
- Calc('0^2.5', Power(0, 2.5));
- calc('2.5^0', power(2.5, 0));
- calc('2^3^4', 2417851639229258349412352); // according to Wolfram Alpha, 2^(3^4)
- // These expressions should throw expections
- //Calc('(-10)^2.5', NaN); // base must be positive in case of fractional exponent
- //Calc('0^-2', NaN); // is 1/0^2 = 1/0
- end;
- procedure TTestPowerNode.TestCreateInteger;
- begin
- FN:=TFPPowerOperation.Create(CreateIntNode(4),CreateIntNode(2));
- AssertEquals('Power has correct type',rtfloat,FN.NodeType);
- AssertEquals('Power has correct result',16.0,FN.NodeValue.ResFloat);
- end;
- procedure TTestPowerNode.TestCreateFloat;
- begin
- FN:=TFPPowerOperation.Create(CreateFloatNode(2.0),CreateFloatNode(3.0));
- AssertEquals('Power has correct type',rtFloat,FN.NodeType);
- AssertEquals('Power has correct result',8.0,FN.NodeValue.ResFloat);
- end;
- procedure TTestPowerNode.TestCreateDateTime;
- Var
- D,T : TDateTime;
- begin
- D:=Date;
- T:=Time;
- FN:=TFPPowerOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
- AssertNodeNotOK('No datetime Power',FN);
- end;
- procedure TTestPowerNode.TestCreateString;
- begin
- FN:=TFPPowerOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
- AssertNodeNotOK('No string Power',FN);
- end;
- procedure TTestPowerNode.TestCreateBoolean;
- begin
- FN:=TFPPowerOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
- AssertNodeNotOK('No boolean Power',FN);
- end;
- procedure TTestPowerNode.TestDestroy;
- begin
- FN:=TFPPowerOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- procedure TTestPowerNode.TestAsString;
- begin
- FN:=TFPPowerOperation.Create(CreateIntNode(1),CreateIntNode(2));
- AssertEquals('Asstring works ok','1^2',FN.AsString);
- end;
- { TTestDivideNode }
- procedure TTestDivideNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestDivideNode.TestCreateInteger;
- begin
- FN:=TFPDivideOperation.Create(CreateIntNode(4),CreateIntNode(2));
- AssertEquals('Divide has correct type',rtfloat,FN.NodeType);
- AssertEquals('Divide has correct result',2.0,FN.NodeValue.ResFloat);
- end;
- procedure TTestDivideNode.TestCreateFloat;
- begin
- FN:=TFPDivideOperation.Create(CreateFloatNode(9.0),CreateFloatNode(3.0));
- AssertEquals('Divide has correct type',rtFloat,FN.NodeType);
- AssertEquals('Divide has correct result',3.0,FN.NodeValue.ResFloat);
- end;
- procedure TTestDivideNode.TestCreateDateTime;
- Var
- D,T : TDateTime;
- begin
- D:=Date;
- T:=Time;
- FN:=TFPDivideOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
- AssertNodeNotOK('No datetime division',FN);
- end;
- procedure TTestDivideNode.TestCreateString;
- begin
- FN:=TFPDivideOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
- AssertNodeNotOK('No string division',FN);
- end;
- procedure TTestDivideNode.TestCreateBoolean;
- begin
- FN:=TFPDivideOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
- AssertNodeNotOK('No boolean division',FN);
- end;
- procedure TTestDivideNode.TestDestroy;
- begin
- FN:=TFPDivideOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
- end;
- procedure TTestDivideNode.TestAsString;
- begin
- FN:=TFPDivideOperation.Create(CreateIntNode(1),CreateIntNode(2));
- AssertEquals('Asstring works ok','1 / 2',FN.AsString);
- end;
- { TTestIntToFloatNode }
- procedure TTestIntToFloatNode.TearDown;
- begin
- FreeAndNil(Fn);
- inherited TearDown;
- end;
- procedure TTestIntToFloatNode.TestCreateInteger;
- begin
- FN:=TIntToFloatNode.Create(CreateIntNode(4));
- AssertEquals('Convert has correct type',rtfloat,FN.NodeType);
- AssertEquals('Convert has correct result',4.0,FN.NodeValue.ResFloat);
- end;
- procedure TTestIntToFloatNode.TestCreateFloat;
- begin
- FN:=TIntToFloatNode.Create(CreateFloatNode(4.0));
- AssertNodeNotOK('No float allowed',FN);
- end;
- procedure TTestIntToFloatNode.TestDestroy;
- begin
- FN:=TIntToFloatNode.Create(TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled)
- end;
- procedure TTestIntToFloatNode.TestAsString;
- begin
- FN:=TIntToFloatNode.Create(CreateIntNode(4));
- AssertEquals('Convert has correct asstring','4',FN.AsString);
- end;
- { TTestIntToDateTimeNode }
- procedure TTestIntToDateTimeNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestIntToDateTimeNode.TestCreateInteger;
- begin
- FN:=TIntToDateTimeNode.Create(CreateIntNode(Round(Date)));
- AssertEquals('Convert has correct type',rtDateTime,FN.NodeType);
- AssertEquals('Convert has correct result',Date,FN.NodeValue.ResDateTime);
- end;
- procedure TTestIntToDateTimeNode.TestCreateFloat;
- begin
- FN:=TIntToDateTimeNode.Create(CreateFloatNode(4.0));
- AssertNodeNotOK('No float allowed',FN);
- end;
- procedure TTestIntToDateTimeNode.TestDestroy;
- begin
- FN:=TIntToDateTimeNode.Create(TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled)
- end;
- procedure TTestIntToDateTimeNode.TestAsString;
- begin
- FN:=TIntToDateTimeNode.Create(CreateIntNode(4));
- AssertEquals('Convert has correct asstring','4',FN.AsString);
- end;
- { TTestFloatToDateTimeNode }
- procedure TTestFloatToDateTimeNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestFloatToDateTimeNode.TestCreateInteger;
- begin
- FN:=TFloatToDateTimeNode.Create(CreateIntNode(4));
- AssertNodeNotOK('No int allowed',FN);
- end;
- procedure TTestFloatToDateTimeNode.TestCreateFloat;
- Var
- T : TExprFloat;
- begin
- T:=Time;
- FN:=TFloatToDateTimeNode.Create(CreateFloatNode(T));
- AssertEquals('Convert has correct type',rtDateTime,FN.NodeType);
- AssertEquals('Convert has correct result',T,FN.NodeValue.ResDateTime);
- end;
- procedure TTestFloatToDateTimeNode.TestDestroy;
- begin
- FN:=TFloatToDateTimeNode.Create(TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled)
- end;
- procedure TTestFloatToDateTimeNode.TestAsString;
- Var
- S : String;
- begin
- FN:=TFloatToDateTimeNode.Create(CreateFloatNode(1.2));
- Str(TExprFloat(1.2),S);
- AssertEquals('Convert has correct asstring',S,FN.AsString);
- end;
- { TMyFPExpressionParser }
- procedure TMyFPExpressionParser.BuildHashList;
- begin
- CreateHashList;
- end;
- { TTestExpressionParser }
- procedure TTestExpressionParser.SetUp;
- begin
- inherited SetUp;
- FP:=TMyFPExpressionParser.Create(Nil);
- end;
- procedure TTestExpressionParser.TearDown;
- begin
- FreeAndNil(FP);
- inherited TearDown;
- end;
- procedure TTestExpressionParser.DoParse;
- begin
- FP.Expression:=FTestExpr;
- end;
- procedure TTestExpressionParser.TestParser(AExpr : string);
- begin
- FTestExpr:=AExpr;
- AssertException(Format('Wrong expression: "%s"',[AExpr]),EExprParser,@DoParse);
- end;
- procedure TTestExpressionParser.AssertLeftRight(N: TFPExprNode; LeftClass,
- RightClass: TClass);
- begin
- AssertNotNull('Binary node not null',N);
- If Not N.InheritsFrom(TFPBinaryOperation) then
- Fail(N.ClassName+' does not descend from TFPBinaryOperation');
- AssertNotNull('Left node assigned',TFPBinaryOperation(N).Left);
- AssertNotNull('Right node assigned',TFPBinaryOperation(N).Right);
- AssertEquals('Left node correct class ',LeftClass, TFPBinaryOperation(N).Left.ClassType);
- AssertEquals('Right node correct class ',RightClass, TFPBinaryOperation(N).Right.ClassType);
- end;
- procedure TTestExpressionParser.AssertOperand(N: TFPExprNode;
- OperandClass: TClass);
- begin
- AssertNotNull('Unary node not null',N);
- If Not N.InheritsFrom(TFPUnaryOperator) then
- Fail(N.ClassName+' does not descend from TFPUnaryOperator');
- AssertNotNull('Operand assigned',TFPUnaryOperator(N).Operand);
- AssertEquals('Operand node correct class ',OperandClass, TFPUnaryOperator(N).Operand.ClassType);
- end;
- procedure TTestExpressionParser.AssertResultType(RT: TResultType);
- begin
- AssertEquals('Result type is '+ResultTypeName(rt),rt,FP.ExprNode);
- AssertEquals('Result type is '+ResultTypeName(rt),rt,FP.ResultType);
- end;
- procedure TTestExpressionParser.AssertResult(F: TExprFloat);
- begin
- AssertEquals('Correct float result',F,FP.ExprNode.NodeValue.ResFloat);
- AssertEquals('Correct float result',F,FP.Evaluate.ResFloat);
- end;
- procedure TTestExpressionParser.AssertCurrencyResult(C: Currency);
- begin
- AssertEquals('Correct currency result',C,FP.ExprNode.NodeValue.ResCurrency);
- AssertEquals('Correct currency result',C,FP.Evaluate.ResCurrency);
- end;
- procedure TTestExpressionParser.AssertResult(I: Int64);
- begin
- AssertEquals('Correct integer result',I,FP.ExprNode.NodeValue.ResInteger);
- AssertEquals('Correct integer result',I,FP.Evaluate.ResInteger);
- end;
- procedure TTestExpressionParser.AssertResult(S: String);
- begin
- AssertEquals('Correct string result',S,FP.ExprNode.NodeValue.ResString);
- AssertEquals('Correct string result',S,FP.Evaluate.ResString);
- end;
- procedure TTestExpressionParser.AssertResult(B: Boolean);
- begin
- AssertEquals('Correct boolean result',B,FP.ExprNode.NodeValue.ResBoolean);
- AssertEquals('Correct boolean result',B,FP.Evaluate.ResBoolean);
- end;
- procedure TTestExpressionParser.AssertDateTimeResult(D: TDateTime);
- begin
- AssertEquals('Correct datetime result',D,FP.ExprNode.NodeValue.ResDateTime);
- AssertEquals('Correct boolean result',D,FP.Evaluate.ResDateTime);
- end;
- //TTestParserExpressions
- procedure TTestParserExpressions.TestCreate;
- begin
- AssertEquals('Expression is empty','',FP.Expression);
- AssertNotNull('Identifiers assigned',FP.Identifiers);
- AssertEquals('No identifiers',0,FP.Identifiers.Count);
- end;
- procedure TTestParserExpressions.TestNumberValues;
- Procedure DoTest(E : String; V : integer);
- var
- res: TFPExpressionResult;
- begin
- FP.Expression:=E;
- res := FP.Evaluate;
- AssertTrue('Expression '+E+': Result is a number', Res.ResultType in [rtInteger,rtFloat]);
- AssertTrue('Expression '+E+': Correct value', ArgToFloat(res)=V);
- end;
- begin
- // Decimal numbers
- DoTest('1', 1);
- DoTest('1E2', 100);
- DoTest('1.0/1E-2', 100);
- // DoTest('200%', 2);
- WriteLn;
- // Hex numbers
- DoTest('$0001', 1);
- DoTest('-$01', -1);
- DoTest('$A', 10);
- DoTest('$FF', 255);
- DoTest('$fe', 254);
- DoTest('$FFFF', $FFFF);
- DoTest('1E2', 100);
- DoTest('$E', 14);
- DoTest('$D+1E2', 113);
- DoTest('$0A-$0B', -1);
- // Hex and variables
- FP.Identifiers.AddVariable('a', rtInteger, '1');
- FP.Identifiers.AddVariable('b', rtInteger, '$B');
- DoTest('a', 1);
- DoTest('b', $B);
- DoTest('$A+a', 11);
- DoTest('$B-b', 0);
- WriteLn;
- // Octal numbers
- DoTest('&10', 8);
- DoTest('&10+10', 18);
- // Mixed hex and octal expression
- DoTest('&10-$0008', 0);
- WriteLn;
- // Binary numbers
- DoTest('%1', 1);
- DoTest('%11', 3);
- DoTest('%1000', 8);
- end;
- procedure TTestParserExpressions.TestSimpleNodeFloat;
- begin
- FP.Expression:='123.4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
- AssertResultType(rtFloat);
- AssertResult(123.4);
- end;
- procedure TTestParserExpressions.TestSimpleNodeInteger;
- begin
- FP.Expression:='1234';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
- AssertResultType(rtInteger);
- AssertResult(1234);
- end;
- procedure TTestParserExpressions.TestSimpleNodeBooleanTrue;
- begin
- FP.Expression:='true';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserExpressions.TestSimpleNodeBooleanFalse;
- begin
- FP.Expression:='False';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserExpressions.TestSimpleNodeString;
- begin
- FP.Expression:='''A string''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
- AssertResultType(rtString);
- AssertResult('A string');
- end;
- procedure TTestParserExpressions.TestSimpleNegativeInteger;
- begin
- FP.Expression:='-1234';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPNegateOperation, FP.ExprNode);
- AssertNodeType('Constant expression',TFPConstExpression, TFPNegateOperation(FP.ExprNode).Operand);
- AssertResultType(rtInteger);
- AssertResult(-1234);
- end;
- procedure TTestParserExpressions.TestSimpleNegativeFloat;
- begin
- FP.Expression:='-1.234';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPNegateOperation, FP.ExprNode);
- AssertNodeType('Constant expression',TFPConstExpression, TFPNegateOperation(FP.ExprNode).Operand);
- AssertResultType(rtFloat);
- AssertResult(-1.234);
- end;
- procedure TTestParserExpressions.TestSimpleAddInteger;
- begin
- FP.Expression:='4+1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(5);
- end;
- procedure TTestParserExpressions.TestSimpleAddFloat;
- begin
- FP.Expression:='1.2+3.4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtFloat);
- AssertResult(4.6);
- end;
- procedure TTestParserExpressions.TestSimpleAddIntegerFloat;
- begin
- FP.Expression:='1+3.4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TIntToFLoatNode,TFPConstExpression);
- AssertResultType(rtFloat);
- AssertResult(4.4);
- end;
- procedure TTestParserExpressions.TestSimpleAddFloatInteger;
- begin
- FP.Expression:='3.4 + 1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TIntToFLoatNode);
- AssertResultType(rtFloat);
- AssertResult(4.4);
- end;
- procedure TTestParserExpressions.TestSimpleAddString;
- begin
- FP.Expression:='''alo''+''ha''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtString);
- AssertResult('aloha');
- end;
- procedure TTestParserExpressions.TestSimpleSubtractInteger;
- begin
- FP.Expression:='4-1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(3);
- end;
- procedure TTestParserExpressions.TestSimpleSubtractFloat;
- begin
- FP.Expression:='3.4-1.2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtFloat);
- AssertResult(2.2);
- end;
- procedure TTestParserExpressions.TestSimpleSubtractIntegerFloat;
- begin
- FP.Expression:='3-1.2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TIntToFloatNode,TFPConstExpression);
- AssertResultType(rtFloat);
- AssertResult(1.8);
- end;
- procedure TTestParserExpressions.TestSimpleSubtractFloatInteger;
- begin
- FP.Expression:='3.3-2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TIntToFloatNode);
- AssertResultType(rtFloat);
- AssertResult(1.3);
- end;
- procedure TTestParserExpressions.TestSimpleMultiplyInteger;
- begin
- FP.Expression:='4*2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(8);
- end;
- procedure TTestParserExpressions.TestSimpleMultiplyFloat;
- begin
- FP.Expression:='3.4*1.5';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtFloat);
- AssertResult(5.1);
- end;
- procedure TTestParserExpressions.TestSimpleDivideInteger;
- begin
- FP.Expression:='4/2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPDivideOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtFloat);
- AssertResult(2.0);
- end;
- procedure TTestParserExpressions.TestSimpleDivideFloat;
- begin
- FP.Expression:='5.1/1.5';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPDivideOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtFloat);
- AssertResult(3.4);
- end;
- procedure TTestParserExpressions.TestSimpleBooleanAnd;
- begin
- FP.Expression:='true and true';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserExpressions.TestSimpleIntegerAnd;
- begin
- FP.Expression:='3 and 1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(1);
- end;
- procedure TTestParserExpressions.TestSimpleBooleanOr;
- begin
- FP.Expression:='false or true';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserExpressions.TestSimpleIntegerOr;
- begin
- FP.Expression:='2 or 1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(3);
- end;
- procedure TTestParserExpressions.TestSimpleBooleanNot;
- begin
- FP.Expression:='not false';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Not node',TFPNotNode, FP.ExprNode);
- AssertOperand(FP.ExprNode,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(true);
- end;
- procedure TTestParserExpressions.TestSimpleIntegerNot;
- begin
- FP.Expression:='Not 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Not node',TFPNotNode, FP.ExprNode);
- AssertOperand(FP.ExprNode,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(Not Int64(3));
- end;
- procedure TTestParserExpressions.TestSimpleAddSeries;
- begin
- FP.Expression:='1 + 2 + 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(6);
- end;
- procedure TTestParserExpressions.TestSimpleMultiplySeries;
- begin
- FP.Expression:='2 * 3 * 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(24);
- end;
- procedure TTestParserExpressions.TestSimpleAddMultiplySeries;
- begin
- FP.Expression:='2 * 3 + 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(10);
- end;
- procedure TTestParserExpressions.TestSimpleAddAndSeries;
- begin
- // 2 and (3+4)
- FP.Expression:='2 and 3 + 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation);
- AssertResultType(rtInteger);
- AssertResult(2);
- end;
- procedure TTestParserExpressions.TestSimpleAddOrSeries;
- begin
- // 2 or (3+4)
- FP.Expression:='2 or 3 + 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation);
- AssertResultType(rtInteger);
- AssertResult(7);
- end;
- procedure TTestParserExpressions.TestSimpleOrNotSeries;
- begin
- FP.Expression:='Not 1 or 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPNotNode,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult((Not Int64(1)) or Int64(3));
- end;
- procedure TTestParserExpressions.TestSimpleAndNotSeries;
- begin
- FP.Expression:='Not False and False';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPNotNode,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserExpressions.TestDoubleAddMultiplySeries;
- begin
- FP.Expression:='2 * 3 + 4 * 5';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPMultiplyOperation);
- AssertResultType(rtInteger);
- AssertResult(26);
- end;
- procedure TTestParserExpressions.TestDoubleSubtractMultiplySeries;
- begin
- FP.Expression:='4 * 5 - 2 * 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPMultiplyOperation);
- AssertResultType(rtInteger);
- AssertResult(14);
- end;
- procedure TTestParserExpressions.TestSimpleIfInteger;
- begin
- FP.Expression:='If(True,1,2)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('If operation',TIfOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(1);
- end;
- procedure TTestParserExpressions.TestSimpleIfString;
- begin
- FP.Expression:='If(True,''a'',''b'')';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('If operation',TIfOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtString);
- AssertResult('a');
- end;
- procedure TTestParserExpressions.TestSimpleIfFloat;
- begin
- FP.Expression:='If(True,1.2,3.4)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('If operation',TIfOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtFloat);
- AssertResult(1.2);
- end;
- procedure TTestParserExpressions.TestSimpleIfBoolean;
- begin
- FP.Expression:='If(True,False,True)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('If operation',TIfOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserExpressions.TestSimpleIfDateTime;
- begin
- FP.Identifiers.AddDateTimeVariable('a',Date);
- FP.Identifiers.AddDateTimeVariable('b',Date-1);
- FP.Expression:='If(True,a,b)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('If operation',TIfOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPExprVariable,TFPExprVariable);
- AssertResultType(rtDateTime);
- AssertResult(Date);
- end;
- procedure TTestParserExpressions.TestSimpleIfOperation;
- begin
- FP.Expression:='If(True,''a'',''b'')+''c''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertResultType(rtString);
- AssertResult('ac');
- end;
- procedure TTestParserExpressions.TestSimpleBrackets;
- begin
- FP.Expression:='(4 + 2)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(6);
- end;
- procedure TTestParserExpressions.TestSimpleBrackets2;
- begin
- FP.Expression:='(4 * 2)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(8);
- end;
- procedure TTestParserExpressions.TestSimpleBracketsLeft;
- begin
- FP.Expression:='(4 + 2) * 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPConstExpression);
- AssertResultType(rtInteger);
- AssertResult(18);
- end;
- procedure TTestParserExpressions.TestSimpleBracketsRight;
- begin
- FP.Expression:='3 * (4 + 2)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation);
- AssertResultType(rtInteger);
- AssertResult(18);
- end;
- procedure TTestParserExpressions.TestSimpleBracketsDouble;
- begin
- FP.Expression:='(3 + 4) * (4 + 2)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPAddOperation);
- AssertResultType(rtInteger);
- AssertResult(42);
- end;
- //TTestParserBooleanOperations
- procedure TTestParserBooleanOperations.TestEqualInteger;
- begin
- FP.Expression:='1 = 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestUnEqualInteger;
- begin
- FP.Expression:='1 <> 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestEqualFloat;
- begin
- FP.Expression:='1.2 = 2.3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestEqualFloat2;
- begin
- FP.Expression:='1.2 = 1.2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestUnEqualFloat;
- begin
- FP.Expression:='1.2 <> 2.3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestEqualString;
- begin
- FP.Expression:='''1.2'' = ''2.3''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestEqualString2;
- begin
- FP.Expression:='''1.2'' = ''1.2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestUnEqualString;
- begin
- FP.Expression:='''1.2'' <> ''2.3''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestUnEqualString2;
- begin
- FP.Expression:='''aa'' <> ''AA''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestEqualBoolean;
- begin
- FP.Expression:='False = True';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestUnEqualBoolean;
- begin
- FP.Expression:='False <> True';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestLessThanInteger;
- begin
- FP.Expression:='1 < 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestLessThanInteger2;
- begin
- FP.Expression:='2 < 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestLessThanEqualInteger;
- begin
- FP.Expression:='3 <= 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestLessThanEqualInteger2;
- begin
- FP.Expression:='2 <= 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestLessThanFloat;
- begin
- FP.Expression:='1.2 < 2.3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestLessThanFloat2;
- begin
- FP.Expression:='2.2 < 2.2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestLessThanEqualFloat;
- begin
- FP.Expression:='3.1 <= 2.1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestLessThanEqualFloat2;
- begin
- FP.Expression:='2.1 <= 2.1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestLessThanString;
- begin
- FP.Expression:='''1'' < ''2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestLessThanString2;
- begin
- FP.Expression:='''2'' < ''2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestLessThanEqualString;
- begin
- FP.Expression:='''3'' <= ''2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestLessThanEqualString2;
- begin
- FP.Expression:='''2'' <= ''2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanInteger;
- begin
- FP.Expression:='1 > 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanInteger2;
- begin
- FP.Expression:='2 > 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanEqualInteger;
- begin
- FP.Expression:='3 >= 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanEqualInteger2;
- begin
- FP.Expression:='2 >= 2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanFloat;
- begin
- FP.Expression:='1.2 > 2.3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanFloat2;
- begin
- FP.Expression:='2.2 > 2.2';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanEqualFloat;
- begin
- FP.Expression:='3.1 >= 2.1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanEqualFloat2;
- begin
- FP.Expression:='2.1 >= 2.1';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanString;
- begin
- FP.Expression:='''1'' > ''2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanString2;
- begin
- FP.Expression:='''2'' > ''2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanEqualString;
- begin
- FP.Expression:='''3'' >= ''2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.TestGreaterThanEqualString2;
- begin
- FP.Expression:='''2'' >= ''2''';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.EqualAndSeries;
- begin
- // (1=2) and (3=4)
- FP.Expression:='1 = 2 and 3 = 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.EqualAndSeries2;
- begin
- // (1=2) and (3=4)
- FP.Expression:='1 = 1 and 3 = 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.EqualOrSeries;
- begin
- // (1=2) or (3=4)
- FP.Expression:='1 = 2 or 3 = 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.EqualOrSeries2;
- begin
- // (1=1) or (3=4)
- FP.Expression:='1 = 1 or 3 = 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.UnEqualAndSeries;
- begin
- // (1<>2) and (3<>4)
- FP.Expression:='1 <> 2 and 3 <> 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.UnEqualAndSeries2;
- begin
- // (1<>2) and (3<>4)
- FP.Expression:='1 <> 1 and 3 <> 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.UnEqualOrSeries;
- begin
- // (1<>2) or (3<>4)
- FP.Expression:='1 <> 2 or 3 <> 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.UnEqualOrSeries2;
- begin
- // (1<>1) or (3<>4)
- FP.Expression:='1 <> 1 or 3 <> 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.LessThanAndSeries;
- begin
- // (1<2) and (3<4)
- FP.Expression:='1 < 2 and 3 < 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.LessThanAndSeries2;
- begin
- // (1<2) and (3<4)
- FP.Expression:='1 < 1 and 3 < 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.LessThanOrSeries;
- begin
- // (1<2) or (3<4)
- FP.Expression:='1 < 2 or 3 < 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.LessThanOrSeries2;
- begin
- // (1<1) or (3<4)
- FP.Expression:='1 < 1 or 3 < 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.GreaterThanAndSeries;
- begin
- // (1>2) and (3>4)
- FP.Expression:='1 > 2 and 3 > 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.GreaterThanAndSeries2;
- begin
- // (1>2) and (3>4)
- FP.Expression:='1 > 1 and 3 > 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.GreaterThanOrSeries;
- begin
- // (1>2) or (3>4)
- FP.Expression:='1 > 2 or 3 > 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.GreaterThanOrSeries2;
- begin
- // (1>1) or (3>4)
- FP.Expression:='1 > 1 or 3 > 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.LessThanEqualAndSeries;
- begin
- // (1<=2) and (3<=4)
- FP.Expression:='1 <= 2 and 3 <= 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.LessThanEqualAndSeries2;
- begin
- // (1<=2) and (3<=4)
- FP.Expression:='1 <= 1 and 3 <= 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.LessThanEqualOrSeries;
- begin
- // (1<=2) or (3<=4)
- FP.Expression:='1 <= 2 or 3 <= 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.LessThanEqualOrSeries2;
- begin
- // (1<=1) or (3<=4)
- FP.Expression:='1 <= 1 or 3 <= 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.GreaterThanEqualAndSeries;
- begin
- // (1>=2) and (3>=4)
- FP.Expression:='1 >= 2 and 3 >= 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.GreaterThanEqualAndSeries2;
- begin
- // (1>=2) and (3>=4)
- FP.Expression:='1 >= 1 and 3 >= 3';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserBooleanOperations.GreaterThanEqualOrSeries;
- begin
- // (1>=2) or (3>=4)
- FP.Expression:='1 >= 2 or 3 >= 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(False);
- end;
- procedure TTestParserBooleanOperations.GreaterThanEqualOrSeries2;
- begin
- // (1>=1) or (3>=4)
- FP.Expression:='1 >= 1 or 3 >= 4';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
- AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- //TTestParserOperands
- procedure TTestParserOperands.MissingOperand1;
- begin
- TestParser('1+');
- end;
- procedure TTestParserOperands.MissingOperand2;
- begin
- TestParser('*1');
- end;
- procedure TTestParserOperands.MissingOperand3;
- begin
- TestParser('1*');
- end;
- procedure TTestParserOperands.MissingOperand4;
- begin
- TestParser('1+');
- end;
- procedure TTestParserOperands.MissingOperand5;
- begin
- TestParser('1 and');
- end;
- procedure TTestParserOperands.MissingOperand6;
- begin
- TestParser('1 or');
- end;
- procedure TTestParserOperands.MissingOperand7;
- begin
- TestParser('and 1');
- end;
- procedure TTestParserOperands.MissingOperand8;
- begin
- TestParser('or 1');
- end;
- procedure TTestParserOperands.MissingOperand9;
- begin
- TestParser('1-');
- end;
- procedure TTestParserOperands.MissingOperand10;
- begin
- TestParser('1 = ');
- end;
- procedure TTestParserOperands.MissingOperand11;
- begin
- TestParser('= 1');
- end;
- procedure TTestParserOperands.MissingOperand12;
- begin
- TestParser('1 <> ');
- end;
- procedure TTestParserOperands.MissingOperand13;
- begin
- TestParser('<> 1');
- end;
- procedure TTestParserOperands.MissingOperand14;
- begin
- TestParser('1 >= ');
- end;
- procedure TTestParserOperands.MissingOperand15;
- begin
- TestParser('>= 1');
- end;
- procedure TTestParserOperands.MissingOperand16;
- begin
- TestParser('1 <= ');
- end;
- procedure TTestParserOperands.MissingOperand17;
- begin
- TestParser('<= 1');
- end;
- procedure TTestParserOperands.MissingOperand18;
- begin
- TestParser('1 < ');
- end;
- procedure TTestParserOperands.MissingOperand19;
- begin
- TestParser('< 1');
- end;
- procedure TTestParserOperands.MissingOperand20;
- begin
- TestParser('1 > ');
- end;
- procedure TTestParserOperands.MissingOperand21;
- begin
- TestParser('> 1');
- end;
- procedure TTestParserOperands.MissingBracket1;
- begin
- TestParser('(1+3');
- end;
- procedure TTestParserOperands.MissingBracket2;
- begin
- TestParser('1+3)');
- end;
- procedure TTestParserOperands.MissingBracket3;
- begin
- TestParser('(1+3))');
- end;
- procedure TTestParserOperands.MissingBracket4;
- begin
- TestParser('((1+3)');
- end;
- procedure TTestParserOperands.MissingBracket5;
- begin
- TestParser('((1+3) 4');
- end;
- procedure TTestParserOperands.MissingBracket6;
- begin
- TestParser('IF(true,1,2');
- end;
- procedure TTestParserOperands.MissingBracket7;
- begin
- TestParser('case(1,1,2,4');
- end;
- procedure TTestParserOperands.MissingArgument1;
- begin
- TestParser('IF(true,1)');
- end;
- procedure TTestParserOperands.MissingArgument2;
- begin
- TestParser('IF(True)');
- end;
- procedure TTestParserOperands.MissingArgument3;
- begin
- TestParser('case(1)');
- end;
- procedure TTestParserOperands.MissingArgument4;
- begin
- TestParser('case(1,2)');
- end;
- procedure TTestParserOperands.MissingArgument5;
- begin
- TestParser('case(1,2,3)');
- end;
- procedure TTestParserOperands.MissingArgument6;
- begin
- TestParser('IF(true,1,2,3)');
- end;
- procedure TTestParserOperands.MissingArgument7;
- begin
- TestParser('case(0,1,2,3,4,5,6)');
- end;
- procedure TTestParserTypeMatch.AccessString;
- begin
- FP.AsString;
- end;
- procedure TTestParserTypeMatch.AccessInteger;
- begin
- FP.AsInteger;
- end;
- procedure TTestParserTypeMatch.AccessFloat;
- begin
- FP.AsFloat;
- end;
- procedure TTestParserTypeMatch.AccessDateTime;
- begin
- FP.AsDateTime;
- end;
- procedure TTestParserTypeMatch.AccessBoolean;
- begin
- FP.AsBoolean;
- end;
- //TTestParserTypeMatch
- procedure TTestParserTypeMatch.TestTypeMismatch1;
- begin
- TestParser('1+''string''');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch2;
- begin
- TestParser('1+True');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch3;
- begin
- TestParser('True+''string''');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch4;
- begin
- TestParser('1.23+''string''');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch5;
- begin
- TestParser('1.23+true');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch6;
- begin
- TestParser('1.23 and true');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch7;
- begin
- TestParser('1.23 or true');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch8;
- begin
- TestParser('''string'' or true');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch9;
- begin
- TestParser('''string'' and true');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch10;
- begin
- TestParser('1.23 or 1');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch11;
- begin
- TestParser('1.23 and 1');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch12;
- begin
- TestParser('''astring'' = 1');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch13;
- begin
- TestParser('true = 1');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch14;
- begin
- TestParser('true * 1');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch15;
- begin
- TestParser('''astring'' * 1');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch16;
- begin
- TestParser('If(1,1,1)');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch17;
- begin
- TestParser('If(True,1,''3'')');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch18;
- begin
- TestParser('case(1,1,''3'',1)');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch19;
- begin
- TestParser('case(1,1,1,''3'')');
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch20;
- begin
- FP.Expression:='1';
- AssertException('Accessing integer as string',EExprParser,@AccessString);
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch21;
- begin
- FP.Expression:='''a''';
- AssertException('Accessing string as integer',EExprParser,@AccessInteger);
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch22;
- begin
- FP.Expression:='''a''';
- AssertException('Accessing string as float',EExprParser,@AccessFloat);
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch23;
- begin
- FP.Expression:='''a''';
- AssertException('Accessing string as boolean',EExprParser,@AccessBoolean);
- end;
- procedure TTestParserTypeMatch.TestTypeMismatch24;
- begin
- FP.Expression:='''a''';
- AssertException('Accessing string as datetime',EExprParser,@AccessDateTime);
- end;
- //TTestParserVariables
- Procedure GetDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resDateTime:=Date;
- end;
- procedure TTestParserVariables.TestVariable1;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddVariable('a',rtBoolean,'True');
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
- AssertEquals('Variable has correct value','True',I.Value);
- end;
- procedure TTestParserVariables.TestVariable2;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddBooleanVariable('a',False);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
- AssertEquals('Variable has correct value','False',I.Value);
- end;
- procedure TTestParserVariables.TestVariable3;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',123);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Variable has correct resulttype',rtInteger,I.ResultType);
- AssertEquals('Variable has correct value','123',I.Value);
- end;
- procedure TTestParserVariables.TestVariable4;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFloatVariable('a',1.23);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Variable has correct resulttype',rtFloat,I.ResultType);
- AssertEquals('Variable has correct value',FloatToStr(1.23),I.Value);
- end;
- procedure TTestParserVariables.TestVariable5;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddStringVariable('a','1.23');
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Variable has correct resulttype',rtString,I.ResultType);
- AssertEquals('Variable has correct value','1.23',I.Value);
- end;
- procedure TTestParserVariables.TestVariable6;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Now;
- I:=FP.Identifiers.AddDateTimeVariable('a',D);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Variable has correct resulttype',rtDateTime,I.ResultType);
- AssertEquals('Variable has correct value',FormatDateTime('yyyy-mm-dd hh:nn:ss',D),I.Value);
- end;
- procedure TTestParserVariables.AddVariabletwice;
- begin
- FP.Identifiers.AddDateTimeVariable('a',Now);
- end;
- procedure TTestParserVariables.UnknownVariable;
- begin
- FP.Identifiers.IdentifierByName('unknown');
- end;
- procedure TTestParserVariables.ReadWrongType;
- Var
- Res : TFPExpressioNResult;
- begin
- AssertEquals('Only one identifier',1,FP.Identifiers.Count);
- Case FAsWrongType of
- rtBoolean : res.ResBoolean:=FP.Identifiers[0].AsBoolean;
- rtString : res.ResString:=FP.Identifiers[0].AsString;
- rtInteger : Res.ResInteger:=FP.Identifiers[0].AsInteger;
- rtFloat : Res.ResFloat:=FP.Identifiers[0].AsFloat;
- rtCurrency : Res.ResCurrency:=FP.Identifiers[0].AsCurrency;
- rtDateTime : Res.ResDateTime:=FP.Identifiers[0].AsDateTime;
- end;
- end;
- procedure TTestParserVariables.WriteWrongType;
- Var
- Res : TFPExpressioNResult;
- begin
- AssertEquals('Only one identifier',1,FP.Identifiers.Count);
- Case FAsWrongType of
- rtBoolean : FP.Identifiers[0].AsBoolean:=res.ResBoolean;
- rtString : FP.Identifiers[0].AsString:=res.ResString;
- rtInteger : FP.Identifiers[0].AsInteger:=Res.ResInteger;
- rtFloat : FP.Identifiers[0].AsFloat:=Res.ResFloat;
- rtCurrency : FP.Identifiers[0].AsCurrency:=Res.ResCurrency;
- rtDateTime : FP.Identifiers[0].AsDateTime:=Res.ResDateTime;
- end;
- end;
- procedure TTestParserVariables.DoDummy(var Result: TFPExpressionResult;
- const Args: TExprParameterArray);
- begin
- // Do nothing;
- end;
- procedure TTestParserVariables.TestVariableAssign;
- Var
- I,J : TFPExprIdentifierDef;
- begin
- I:=TFPExprIdentifierDef.Create(Nil);
- try
- J:=TFPExprIdentifierDef.Create(Nil);
- try
- I.Name:='Aname';
- I.ParameterTypes:='ISDBF';
- I.ResultType:=rtFloat;
- I.Value:='1.23';
- I.OnGetFunctionValue:=@DoDummy;
- I.OnGetFunctionValueCallBack:=@GetDate;
- J.Assign(I);
- AssertEquals('Names match',I.Name,J.Name);
- AssertEquals('Parametertypes match',I.ParameterTypes,J.ParameterTypes);
- AssertEquals('Values match',I.Value,J.Value);
- AssertEquals('Result types match',Ord(I.ResultType),Ord(J.ResultType));
- AssertSame('Callbacks match',Pointer(I.OnGetFunctionValueCallBack),Pointer(J.OnGetFunctionValueCallback));
- If (I.OnGetFunctionValue)<>(J.OnGetFunctionValue) then
- Fail('OnGetFUnctionValue as Method does not match');
- finally
- J.Free;
- end;
- finally
- I.Free;
- end;
- end;
- procedure TTestParserVariables.TestVariableAssignAgain;
- Var
- I,J : TFPBuiltinExprIdentifierDef;
- begin
- I:=TFPBuiltinExprIdentifierDef.Create(Nil);
- try
- J:=TFPBuiltinExprIdentifierDef.Create(Nil);
- try
- I.Name:='Aname';
- I.ParameterTypes:='ISDBF';
- I.ResultType:=rtFloat;
- I.Value:='1.23';
- I.OnGetFunctionValue:=@DoDummy;
- I.OnGetFunctionValueCallBack:=@GetDate;
- I.Category:=bcUser;
- J.Assign(I);
- AssertEquals('Names match',I.Name,J.Name);
- AssertEquals('Parametertypes match',I.ParameterTypes,J.ParameterTypes);
- AssertEquals('Values match',I.Value,J.Value);
- AssertEquals('Result types match',Ord(I.ResultType),Ord(J.ResultType));
- AssertEquals('Categories match',Ord(I.Category),Ord(J.Category));
- AssertSame('Callbacks match',Pointer(I.OnGetFunctionValueCallBack),Pointer(J.OnGetFunctionValueCallback));
- If (I.OnGetFunctionValue)<>(J.OnGetFunctionValue) then
- Fail('OnGetFUnctionValue as Method does not match');
- finally
- J.Free;
- end;
- finally
- I.Free;
- end;
- end;
- procedure TTestParserVariables.TestVariable7;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Now;
- I:=FP.Identifiers.AddDateTimeVariable('a',D);
- AssertNotNull('Addvariable returns result',I);
- AssertException('Cannot add same name twice',EExprParser,@AddVariabletwice);
- end;
- procedure TTestParserVariables.TestVariable8;
- begin
- FP.Identifiers.AddIntegerVariable('a',123);
- FP.Identifiers.AddIntegerVariable('b',123);
- AssertEquals('List is dirty',True,FP.Dirty);
- FP.BuildHashList;
- FP.Identifiers.Delete(0);
- AssertEquals('List is dirty',True,FP.Dirty);
- end;
- procedure TTestParserVariables.TestVariable9;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',123);
- AssertNotNull('Addvariable returns result',I);
- FP.Expression:='a';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
- AssertResultType(rtInteger);
- AssertResult(123);
- end;
- procedure TTestParserVariables.TestVariable10;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddStringVariable('a','a123');
- AssertNotNull('Addvariable returns result',I);
- FP.Expression:='a';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
- AssertResultType(rtString);
- AssertResult('a123');
- end;
- procedure TTestParserVariables.TestVariable11;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFloatVariable('a',1.23);
- AssertNotNull('Addvariable returns result',I);
- FP.Expression:='a';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
- AssertResultType(rtFloat);
- AssertResult(1.23);
- end;
- procedure TTestParserVariables.TestVariable36;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddCurrencyVariable('a',1.23);
- AssertNotNull('Addvariable returns result',I);
- FP.Expression:='a';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
- AssertResultType(rtCurrency);
- AssertCurrencyResult(1.23);
- end;
- procedure TTestParserVariables.TestVariable12;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddBooleanVariable('a',True);
- AssertNotNull('Addvariable returns result',I);
- FP.Expression:='a';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserVariables.TestVariable13;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddDateTimeVariable('a',D);
- AssertNotNull('Addvariable returns result',I);
- FP.Expression:='a';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
- AssertResultType(rtDateTime);
- AssertDateTimeResult(D);
- end;
- procedure TTestParserVariables.TestVariable14;
- Var
- I,S : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',1);
- FP.BuildHashList;
- S:=FP.IdentifierByName('a');
- AssertSame('Identifier found',I,S);
- end;
- procedure TTestParserVariables.TestVariable15;
- Var
- I,S : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',1);
- AssertNotNull('Addvariable returns result',I);
- FP.BuildHashList;
- S:=FP.IdentifierByName('A');
- AssertSame('Identifier found',I,S);
- end;
- procedure TTestParserVariables.TestVariable16;
- Var
- I,S : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',1);
- AssertNotNull('Addvariable returns result',I);
- FP.BuildHashList;
- S:=FP.IdentifierByName('B');
- AssertNull('Identifier not found',S);
- end;
- procedure TTestParserVariables.TestVariable17;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',1);
- AssertNotNull('Addvariable returns result',I);
- FP.BuildHashList;
- AssertException('Identifier not found',EExprParser,@unknownvariable);
- end;
- procedure TTestParserVariables.TestVariable18;
- Var
- I,S : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',1);
- AssertNotNull('Addvariable returns result',I);
- S:=FP.Identifiers.FindIdentifier('B');
- AssertNull('Identifier not found',S);
- end;
- procedure TTestParserVariables.TestVariable19;
- Var
- I,S : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',1);
- S:=FP.Identifiers.FindIdentifier('a');
- AssertSame('Identifier found',I,S);
- end;
- procedure TTestParserVariables.TestVariable20;
- Var
- I,S : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddIntegerVariable('a',1);
- S:=FP.Identifiers.FindIdentifier('A');
- AssertSame('Identifier found',I,S);
- end;
- procedure TTestParserVariables.TestAccess(Skip : TResultType);
- begin
- TestAccess([Skip]);
- end;
- procedure TTestParserVariables.TestAccess(Skip : TResultTypes);
- Var
- rt : TResultType;
- begin
- For rt:=Low(TResultType) to High(TResultType) do
- if Not (rt in skip) then
- begin
- FasWrongType:=rt;
- AssertException('Acces as '+ResultTypeName(rt),EExprParser,@ReadWrongtype);
- end;
- For rt:=Low(TResultType) to High(TResultType) do
- if Not (rt in skip) then
- begin
- FasWrongType:=rt;
- AssertException('Acces as '+ResultTypeName(rt),EExprParser,@WriteWrongtype);
- end;
- end;
- procedure TTestParserVariables.TestVariable21;
- begin
- FP.IDentifiers.AddIntegerVariable('a',1);
- TestAccess([rtInteger]);
- end;
- procedure TTestParserVariables.TestVariable22;
- begin
- FP.IDentifiers.AddFloatVariable('a',1.0);
- TestAccess([rtFloat]);
- end;
- procedure TTestParserVariables.TestVariable35;
- begin
- FP.IDentifiers.AddCurrencyVariable('a',1.0);
- TestAccess([rtCurrency]);
- end;
- procedure TTestParserVariables.TestVariable23;
- begin
- FP.IDentifiers.AddStringVariable('a','1.0');
- TestAccess(rtString);
- end;
- procedure TTestParserVariables.TestVariable24;
- begin
- FP.IDentifiers.AddBooleanVariable('a',True);
- TestAccess(rtBoolean);
- end;
- procedure TTestParserVariables.TestVariable25;
- begin
- FP.IDentifiers.AddDateTimeVariable('a',Date);
- TestAccess(rtDateTime);
- end;
- procedure TTestParserVariables.TestVariable26;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.IDentifiers.AddStringVariable('a','1.0');
- I.AsString:='12';
- AssertEquals('Correct value','12',I.AsString);
- end;
- procedure TTestParserVariables.TestVariable27;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.IDentifiers.AddIntegerVariable('a',10);
- I.Asinteger:=12;
- AssertEquals('Correct value',12,I.AsInteger);
- end;
- procedure TTestParserVariables.TestVariable28;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.IDentifiers.AddFloatVariable('a',1.0);
- I.AsFloat:=1.2;
- AssertEquals('Correct value',1.2,I.AsFloat);
- end;
- procedure TTestParserVariables.TestVariable29;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.IDentifiers.AddDateTimeVariable('a',Now);
- I.AsDateTime:=Date-1;
- AssertEquals('Correct value',Date-1,I.AsDateTime);
- end;
- procedure TTestParserVariables.TestVariable30;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddBooleanVariable('a',True);
- I.AsBoolean:=False;
- AssertEquals('Correct value',False,I.AsBoolean);
- end;
- procedure TTestParserVariables.DoGetBooleanVar(var Res: TFPExpressionResult;
- ConstRef AName: ShortString);
- begin
- FEventName:=AName;
- Res.ResBoolean:=FBoolValue;
- end;
- procedure TTestParserVariables.TestVariable31;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddVariable('a',rtBoolean,@DoGetBooleanVar);
- AssertEquals('Correct name','a',i.Name);
- AssertEquals('Correct type',Ord(rtBoolean),Ord(i.ResultType));
- AssertSame(TMethod(I.OnGetVariableValue).Code,TMethod(@DoGetBooleanVar).Code);
- FBoolValue:=True;
- FEventName:='';
- AssertEquals('Correct value 1',True,I.AsBoolean);
- AssertEquals('Correct name passed','a',FEventName);
- FBoolValue:=False;
- FEventName:='';
- AssertEquals('Correct value 2',False,I.AsBoolean);
- AssertEquals('Correct name passed','a',FEventName);
- end;
- Var
- FVarCallBackName:String;
- FVarBoolValue : Boolean;
- procedure DoGetBooleanVar2(var Res: TFPExpressionResult; ConstRef AName: ShortString);
- begin
- FVarCallBackName:=AName;
- Res.ResBoolean:=FVarBoolValue;
- end;
- procedure TTestParserVariables.DoGetBooleanVarWrong(var Res: TFPExpressionResult; ConstRef AName: ShortString);
- begin
- FEventName:=AName;
- Res.ResultType:=rtInteger;
- Res.ResInteger:=33;
- end;
- procedure TTestParserVariables.TestVariable32;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddVariable('a',rtBoolean,@DoGetBooleanVar2);
- AssertEquals('Correct name','a',i.Name);
- AssertEquals('Correct type',Ord(rtBoolean),Ord(i.ResultType));
- AssertSame(I.OnGetVariableValueCallBack,@DoGetBooleanVar2);
- FVarBoolValue:=True;
- FVarCallBackName:='';
- AssertEquals('Correct value 1',True,I.AsBoolean);
- AssertEquals('Correct name passed','a',FVarCallBackName);
- FVarBoolValue:=False;
- FVarCallBackName:='';
- AssertEquals('Correct value 2',False,I.AsBoolean);
- AssertEquals('Correct name passed','a',FVarCallBackName);
- end;
- procedure TTestParserVariables.DoTestVariable33;
- Var
- B : Boolean;
- begin
- B:=FTest33.AsBoolean;
- AssertTrue(B in [true,False])
- end;
- procedure TTestParserVariables.TestVariable33;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddVariable('a',rtBoolean,@DoGetBooleanVarWrong);
- FTest33:=I;
- AssertException('Changing type results in exception',EExprParser,@DoTestVariable33);
- AssertEquals('Type is unchanged',Ord(rtBoolean),Ord(i.ResultType));
- end;
- procedure DoGetBooleanVar2Wrong(var Res: TFPExpressionResult; ConstRef AName: ShortString);
- begin
- FVarCallBackName:=AName;
- Res.ResultType:=rtInteger;
- Res.ResInteger:=34;
- end;
- procedure TTestParserVariables.TestVariable34;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddVariable('a',rtBoolean,@DoGetBooleanVar2Wrong);
- FTest33:=I;
- AssertException('Changing type results in exception',EExprParser,@DoTestVariable33);
- AssertEquals('Type is unchanged',Ord(rtBoolean),Ord(i.ResultType));
- end;
- Procedure EchoDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resDateTime:=Args[0].resDateTime;
- end;
- Procedure EchoInteger(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resInteger:=Args[0].resInteger;
- end;
- Procedure EchoBoolean(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resBoolean:=Args[0].resBoolean;
- end;
- Procedure EchoFloat(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resFloat:=Args[0].resFloat;
- end;
- Procedure EchoCurrency(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resCurrency:=Args[0].resCurrency;
- end;
- Procedure EchoString(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resString:=Args[0].resString;
- end;
- Procedure TTestExpressionParser.DoEchoDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resDateTime:=Args[0].resDateTime;
- end;
- Procedure TTestExpressionParser.DoEchoInteger(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resInteger:=Args[0].resInteger;
- end;
- Procedure TTestExpressionParser.DoEchoBoolean(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resBoolean:=Args[0].resBoolean;
- end;
- Procedure TTestExpressionParser.DoEchoFloat(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resFloat:=Args[0].resFloat;
- end;
- Procedure TTestExpressionParser.DoEchoCurrency(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resCurrency:=Args[0].resCurrency;
- end;
- Procedure TTestExpressionParser.DoEchoString(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
- begin
- Result.resString:=Args[0].resString;
- end;
- procedure TTestExpressionParser.DoGetDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- begin
- Result.ResDatetime:=Date;
- end;
- procedure TTestExpressionParser.DoAddInteger(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- begin
- Result.Resinteger:=Args[0].ResInteger+Args[1].ResInteger;
- end;
- procedure TTestExpressionParser.DoDeleteString(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- begin
- Result.ResString:=Args[0].ResString;
- Delete(Result.ResString,Args[1].ResInteger,Args[2].ResInteger);
- end;
- procedure TTestParserFunctions.TryRead;
- Var
- Res : TFPExpressioNResult;
- begin
- AssertEquals('Only one identifier',1,FP.Identifiers.Count);
- Case FAccessAs of
- rtBoolean : res.ResBoolean:=FP.Identifiers[0].AsBoolean;
- rtString : res.ResString:=FP.Identifiers[0].AsString;
- rtInteger : Res.ResInteger:=FP.Identifiers[0].AsInteger;
- rtFloat : Res.ResFloat:=FP.Identifiers[0].AsFloat;
- rtCurrency : Res.ResCurrency:=FP.Identifiers[0].AsCurrency;
- rtDateTime : Res.ResDateTime:=FP.Identifiers[0].AsDateTime;
- end;
- end;
- procedure TTestParserFunctions.TryWrite;
- Var
- Res : TFPExpressioNResult;
- begin
- Res:=Default(TFPExpressioNResult);
- AssertEquals('Only one identifier',1,FP.Identifiers.Count);
- Case FAccessAs of
- rtBoolean : FP.Identifiers[0].AsBoolean:=res.ResBoolean;
- rtString : FP.Identifiers[0].AsString:=res.ResString;
- rtInteger : FP.Identifiers[0].AsInteger:=Res.ResInteger;
- rtFloat : FP.Identifiers[0].AsFloat:=Res.ResFloat;
- rtCurrency : FP.Identifiers[0].AsCurrency:=Res.ResCurrency;
- rtDateTime : FP.Identifiers[0].AsDateTime:=Res.ResDateTime;
- end;
- end;
- // TTestParserFunctions
- procedure TTestParserFunctions.TestFunction1;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('Date','D','',@GetDate);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
- AssertSame('Function has correct address',Pointer(@GetDate),Pointer(I.OnGetFunctionValueCallBack));
- FaccessAs:=rtDateTime;
- AssertException('No read access',EExprParser,@TryRead);
- AssertException('No write access',EExprParser,@TryWrite);
- end;
- procedure TTestParserFunctions.TestFunction2;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoDate','D','D',@EchoDate);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
- AssertSame('Function has correct address',Pointer(@EchoDate),Pointer(I.OnGetFunctionValueCallBack));
- end;
- procedure TTestParserFunctions.TestFunction3;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@EchoInteger);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
- AssertSame('Function has correct address',Pointer(@EchoInteger),Pointer(I.OnGetFunctionValueCallBack));
- FaccessAs:=rtInteger;
- AssertException('No read access',EExprParser,@TryRead);
- AssertException('No write access',EExprParser,@TryWrite);
- end;
- procedure TTestParserFunctions.TestFunction4;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@EchoBoolean);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtBoolean,I.ResultType);
- AssertSame('Function has correct address',Pointer(@EchoBoolean),Pointer(I.OnGetFunctionValueCallBack));
- FaccessAs:=rtBoolean;
- AssertException('No read access',EExprParser,@TryRead);
- AssertException('No write access',EExprParser,@TryWrite);
- end;
- procedure TTestParserFunctions.TestFunction5;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@EchoFloat);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtFloat,I.ResultType);
- AssertSame('Function has correct address',Pointer(@EchoFloat),Pointer(I.OnGetFunctionValueCallBack));
- FaccessAs:=rtfloat;
- AssertException('No read access',EExprParser,@TryRead);
- AssertException('No write access',EExprParser,@TryWrite);
- end;
- procedure TTestParserFunctions.TestFunction30;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoCurrency','C','C',@EchoCurrency);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtCurrency,I.ResultType);
- AssertSame('Function has correct address',Pointer(@EchoCurrency),Pointer(I.OnGetFunctionValueCallBack));
- FaccessAs:=rtCurrency;
- AssertException('No read access',EExprParser,@TryRead);
- AssertException('No write access',EExprParser,@TryWrite);
- end;
- procedure TTestParserFunctions.TestFunction6;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoString','S','S',@EchoString);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtString,I.ResultType);
- AssertSame('Function has correct address',Pointer(@EchoString),Pointer(I.OnGetFunctionValueCallBack));
- FaccessAs:=rtString;
- AssertException('No read access',EExprParser,@TryRead);
- AssertException('No write access',EExprParser,@TryWrite);
- end;
- procedure TTestParserFunctions.TestFunction7;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoDate','D','D',@DoEchoDate);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
- // AssertSame('Function has correct address',TMethod(@Self.DoEchoDate),TMethod(I.OnGetFunctionValue));
- end;
- procedure TTestParserFunctions.TestFunction8;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@DOEchoInteger);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
- // AssertSame('Function has correct address',Pointer(@EchoInteger),Pointer(I.OnGetFunctionValueCallBack));
- end;
- procedure TTestParserFunctions.TestFunction9;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@DoEchoBoolean);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtBoolean,I.ResultType);
- // AssertSame('Function has correct address',Pointer(@EchoBoolean),Pointer(I.OnGetFunctionValueCallBack));
- end;
- procedure TTestParserFunctions.TestFunction10;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@DoEchoFloat);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtFloat,I.ResultType);
- // AssertSame('Function has correct address',Pointer(@EchoFloat),Pointer(I.OnGetFunctionValueCallBack));
- end;
- procedure TTestParserFunctions.TestFunction31;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoCurrency','C','C',@DoEchoCurrency);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtCurrency,I.ResultType);
- // AssertSame('Function has correct address',Pointer(@EchoFloat),Pointer(I.OnGetFunctionValueCallBack));
- end;
- procedure TTestParserFunctions.TestFunction11;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoString','S','S',@DoEchoString);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtString,I.ResultType);
- // AssertSame('Function has correct address',Pointer(@EchoString),Pointer(I.OnGetFunctionValueCallBack));
- end;
- procedure TTestParserFunctions.TestFunction12;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddFunction('Date','D','',@GetDate);
- AssertNotNull('Addvariable returns result',I);
- FP.Expression:='Date';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
- AssertResultType(rtDateTime);
- AssertDateTimeResult(D);
- end;
- procedure TTestParserFunctions.TestFunction13;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddDateTimeVariable('a',D);
- AssertNotNull('Addvariable returns result',I);
- I:=FP.Identifiers.AddFunction('EchoDate','D','D',@EchoDate);
- AssertNotNull('Addvariable returns result',I);
- FP.Expression:='EchoDate(a)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
- AssertResultType(rtDateTime);
- AssertDateTimeResult(D);
- end;
- procedure TTestParserFunctions.TestFunction14;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@EchoInteger);
- AssertNotNull('Addvariable returns result',I);
- FP.Expression:='EchoInteger(13)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
- AssertResultType(rtInteger);
- AssertResult(13);
- end;
- procedure TTestParserFunctions.TestFunction15;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@EchoBoolean);
- AssertNotNull('Addvariable returns result',I);
- FP.Expression:='EchoBoolean(True)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserFunctions.TestFunction16;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@EchoFloat);
- AssertNotNull('Have identifier',I);
- FP.Expression:='EchoFloat(1.234)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
- AssertResultType(rtFloat);
- AssertResult(1.234);
- end;
- procedure TTestParserFunctions.TestFunction32;
- Var
- I : TFPExprIdentifierDef;
- begin
- // Note there will be an implicit conversion float-> currency as the const will be a float
- I:=FP.Identifiers.AddFunction('EchoCurrency','C','C',@EchoCurrency);
- AssertNotNull('Have identifier',I);
- FP.Expression:='EchoCurrency(1.234)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
- AssertResultType(rtCurrency);
- AssertCurrencyResult(1.234);
- end;
- procedure TTestParserFunctions.TestFunction33;
- Var
- I : TFPExprIdentifierDef;
- begin
- // Note there will be no conversion
- I:=FP.Identifiers.AddCurrencyVariable('a',1.234);
- AssertNotNull('Have identifier',I);
- I:=FP.Identifiers.AddFunction('EchoCurrency','C','C',@EchoCurrency);
- AssertNotNull('Have identifier',I);
- FP.Expression:='EchoCurrency(a)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
- AssertResultType(rtCurrency);
- AssertCurrencyResult(1.234);
- end;
- procedure TTestParserFunctions.ExprMaxOf(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- var
- mx: Double;
- arg: TFPExpressionResult;
- begin
- mx := -MaxDouble;
- for arg in Args do
- mx := math.Max(mx, ArgToFloat(arg));
- result.ResFloat:= mx;
- end;
- procedure TTestParserFunctions.ExprMinOf(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- var
- mn: Double;
- arg: TFPExpressionResult;
- begin
- mn := MaxDouble;
- for arg in Args do
- mn := math.Min(mn, ArgToFloat(arg));
- result.ResFloat:= mn;
- end;
- procedure TTestParserFunctions.ExprSumOf(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
- var
- sum: Double;
- arg: TFPExpressionResult;
- begin
- sum := 0;
- for arg in Args do
- sum := sum + ArgToFloat(arg);
- Result.ResFloat := sum;
- end;
- procedure TTestParserFunctions.ExprAveOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
- var
- sum: Double;
- arg: TFPExpressionResult;
- begin
- if Length(Args) = 0 then
- raise EExprParser.Create('At least 1 value needed for calculation of average');
- sum := 0;
- for arg in Args do
- sum := sum + ArgToFloat(arg);
- Result.ResFloat := sum / Length(Args);
- end;
- procedure TTestParserFunctions.ExprStdDevOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
- var
- sum, ave: Double;
- arg: TFPExpressionResult;
- begin
- if Length(Args) < 2 then
- raise EExprParser.Create('At least 2 values needed for calculation of standard deviation');
- sum := 0;
- for arg in Args do
- sum := sum + ArgToFloat(arg);
- ave := sum / Length(Args);
- sum := 0;
- for arg in Args do
- sum := sum + sqr(ArgToFloat(arg) - ave);
- Result.ResFloat := sqrt(sum / (Length(Args) - 1));
- end;
- procedure TTestParserFunctions.TestVarArgs1;
- begin
- // FP.BuiltIns := [bcMath];
- FP.Identifiers.AddFunction('MaxOf', 'F', 'F+', @ExprMaxOf);
- FP.Expression := 'MaxOf(-1,2,3,4.1)';
- AssertEquals('Result',4.1,FP.Evaluate.ResFloat,0.1);
- end;
- procedure TTestParserFunctions.TestVarArgs2;
- begin
- FP.Identifiers.AddFunction('MinOf', 'F', 'F+', @ExprMinOf);
- FP.Expression := 'MinOf(-1,2,3,4.1)';
- AssertEquals('Result',-1,FP.Evaluate.ResFloat,0.1);
- end;
- procedure TTestParserFunctions.TestVarArgs3;
- begin
- FP.Identifiers.AddFunction('SumOf', 'F', 'F+', @ExprSumOf);
- FP.Expression := 'SumOf(-1,2,3,4.1)';
- AssertEquals('Result',8.1,FP.Evaluate.ResFloat,0.1);
- end;
- procedure TTestParserFunctions.TestVarArgs4;
- begin
- FP.Identifiers.AddFunction('AveOf', 'F', 'F+', @ExprAveOf);
- FP.Expression := 'AveOf(-1,2,3,4.1)';
- AssertEquals('Result',2.025,FP.Evaluate.ResFloat,0.001);
- end;
- procedure TTestParserFunctions.TestVarArgs5;
- begin
- FP.Identifiers.AddFunction('StdDevOf', 'F', 'F+', @ExprStdDevOf);
- FP.Expression := 'StdDevOf(-1,2,3,4.1)';
- AssertEquals('Result',2.191,FP.Evaluate.ResFloat,0.001);
- end;
- procedure TTestParserFunctions.TestFunction17;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoString','S','S',@EchoString);
- AssertNotNull('Have identifier',I);
- FP.Expression:='EchoString(''Aloha'')';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
- AssertResultType(rtString);
- AssertResult('Aloha');
- end;
- procedure TTestParserFunctions.TestFunction18;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddDateTimeVariable('a',D);
- AssertNotNull('Have identifier',I);
- I:=FP.Identifiers.AddFunction('EchoDate','D','D',@DoEchoDate);
- AssertNotNull('Have identifier',I);
- FP.Expression:='EchoDate(a)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtDateTime);
- AssertDateTimeResult(D);
- end;
- procedure TTestParserFunctions.TestFunction19;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@DoEchoInteger);
- AssertNotNull('Have identifier',I);
- FP.Expression:='EchoInteger(13)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtInteger);
- AssertResult(13);
- end;
- procedure TTestParserFunctions.TestFunction20;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@DoEchoBoolean);
- AssertNotNull('Have identifier',I);
- FP.Expression:='EchoBoolean(True)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtBoolean);
- AssertResult(True);
- end;
- procedure TTestParserFunctions.TestFunction21;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@DoEchoFloat);
- AssertNotNull('Have identifier',I);
- FP.Expression:='EchoFloat(1.234)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtFloat);
- AssertResult(1.234);
- end;
- procedure TTestParserFunctions.TestFunction22;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('EchoString','S','S',@DoEchoString);
- AssertNotNull('Have identifier',I);
- FP.Expression:='EchoString(''Aloha'')';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtString);
- AssertResult('Aloha');
- end;
- procedure TTestParserFunctions.TestFunction23;
- Var
- I : TFPExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Date;
- I:=FP.Identifiers.AddFunction('Date','D','',@DoGetDate);
- AssertNotNull('Have identifier',I);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
- FP.Expression:='Date';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtDateTime);
- AssertDateTimeResult(D);
- end;
- procedure TTestParserFunctions.TestFunction24;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
- AssertNotNull('Have identifier',I);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
- FP.Expression:='AddInteger(1,2)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtInteger);
- AssertResult(3);
- end;
- procedure TTestParserFunctions.TestFunction25;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('Delete','S','SII',@DoDeleteString);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Have identifier',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtString,I.ResultType);
- FP.Expression:='Delete(''ABCDEFGHIJ'',3,2)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtString);
- AssertResult('ABEFGHIJ');
- end;
- procedure TTestParserFunctions.TestFunction26;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
- FP.Expression:='AddInteger(1,2+3)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtInteger);
- AssertResult(6);
- end;
- procedure TTestParserFunctions.TestFunction27;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
- FP.Expression:='AddInteger(1+2,3*4)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtInteger);
- AssertResult(15);
- end;
- procedure TTestParserFunctions.TestFunction28;
- Var
- I : TFPExprIdentifierDef;
- begin
- I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
- AssertEquals('List is dirty',True,FP.Dirty);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FP.Identifiers.Count);
- AssertSame('Result equals variable added',I,FP.Identifiers[0]);
- AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
- FP.Expression:='AddInteger(3 and 2,3*4)';
- AssertNotNull('Have result node',FP.ExprNode);
- AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
- AssertResultType(rtInteger);
- AssertResult(14);
- end;
- procedure TTestParserFunctions.TestFunction29;
- Var
- I : TFPExprIdentifierDef;
- begin
- // Test type mismatch
- I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
- AssertNotNull('Addvariable returns result',I);
- TestParser('AddInteger(3 and 2,''s'')');
- end;
- { TTestBuiltinsManager }
- procedure TTestBuiltinsManager.Setup;
- begin
- inherited Setup;
- FM:=TExprBuiltInManager.Create(Nil);
- end;
- procedure TTestBuiltinsManager.Teardown;
- begin
- FreeAndNil(FM);
- inherited Teardown;
- end;
- procedure TTestBuiltinsManager.TestCreate;
- begin
- AssertEquals('Have no builtin expressions',0,FM.IdentifierCount);
- end;
- procedure TTestBuiltinsManager.TestVariable1;
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.AddVariable(bcuser,'a',rtBoolean,'True');
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FM.IdentifierCount);
- AssertSame('Result equals variable added',I,FM.Identifiers[0]);
- AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
- AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
- AssertEquals('Variable has correct value','True',I.Value);
- end;
- procedure TTestBuiltinsManager.TestVariable2;
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.AddBooleanVariable(bcUser,'a',False);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FM.IdentifierCount);
- AssertSame('Result equals variable added',I,FM.Identifiers[0]);
- AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
- AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
- AssertEquals('Variable has correct value','False',I.Value);
- end;
- procedure TTestBuiltinsManager.TestVariable3;
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.AddIntegerVariable(bcUser,'a',123);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FM.IdentifierCount);
- AssertSame('Result equals variable added',I,FM.Identifiers[0]);
- AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
- AssertEquals('Variable has correct resulttype',rtInteger,I.ResultType);
- AssertEquals('Variable has correct value','123',I.Value);
- end;
- procedure TTestBuiltinsManager.TestVariable4;
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.AddFloatVariable(bcUser,'a',1.23);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FM.IdentifierCount);
- AssertSame('Result equals variable added',I,FM.Identifiers[0]);
- AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
- AssertEquals('Variable has correct resulttype',rtFloat,I.ResultType);
- AssertEquals('Variable has correct value',FloatToStr(1.23),I.Value);
- end;
- procedure TTestBuiltinsManager.TestVariable7;
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.AddCurrencyVariable(bcUser,'a',1.23);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FM.IdentifierCount);
- AssertSame('Result equals variable added',I,FM.Identifiers[0]);
- AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
- AssertEquals('Variable has correct resulttype',rtCurrency,I.ResultType);
- AssertEquals('Variable has correct value',CurrToStr(1.23),I.Value);
- end;
- procedure TTestBuiltinsManager.TestVariable5;
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.AddStringVariable(bcUser,'a','1.23');
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FM.IdentifierCount);
- AssertSame('Result equals variable added',I,FM.Identifiers[0]);
- AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
- AssertEquals('Variable has correct resulttype',rtString,I.ResultType);
- AssertEquals('Variable has correct value','1.23',I.Value);
- end;
- procedure TTestBuiltinsManager.TestVariable6;
- Var
- I : TFPBuiltinExprIdentifierDef;
- D : TDateTime;
- begin
- D:=Now;
- I:=FM.AddDateTimeVariable(bcUser,'a',D);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FM.IdentifierCount);
- AssertSame('Result equals variable added',I,FM.Identifiers[0]);
- AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
- AssertEquals('Variable has correct resulttype',rtDateTime,I.ResultType);
- AssertEquals('Variable has correct value',FormatDateTime('yyyy-mm-dd hh:nn:ss',D),I.Value);
- end;
- procedure TTestBuiltinsManager.TestFunction1;
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.AddFunction(bcUser,'Date','D','',@GetDate);
- AssertNotNull('Addvariable returns result',I);
- AssertEquals('One variable added',1,FM.IdentifierCount);
- AssertSame('Result equals variable added',I,FM.Identifiers[0]);
- AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
- AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
- AssertSame('Function has correct address',Pointer(@GetDate),Pointer(I.OnGetFunctionValueCallBack));
- end;
- procedure TTestBuiltinsManager.TestFunction2;
- Var
- I,I2 : TFPBuiltinExprIdentifierDef;
- ind : Integer;
- begin
- FM.AddFunction(bcUser,'EchoDate','D','D',@EchoDate);
- I:=FM.AddFunction(bcUser,'Echo','D','D',@EchoDate);
- FM.AddFunction(bcUser,'DoEcho','D','D',@EchoDate);
- ind:=FM.IndexOfIdentifier('Echo');
- AssertEquals('Found identifier',1,ind);
- I2:=FM.FindIdentifier('Echo');
- AssertNotNull('FindIdentifier returns result',I2);
- AssertSame('Findidentifier returns correct result',I,I2);
- ind:=FM.IndexOfIdentifier('NoNoNo');
- AssertEquals('Found no such identifier',-1,ind);
- I2:=FM.FindIdentifier('NoNoNo');
- AssertNull('FindIdentifier returns no result',I2);
- end;
- procedure TTestBuiltinsManager.TestDelete;
- begin
- FM.AddFunction(bcUser,'EchoDate','D','D',@EchoDate);
- FM.AddFunction(bcUser,'EchoDate2','D','D',@EchoDate);
- FM.AddFunction(bcUser,'EchoDate3','D','D',@EchoDate);
- AssertEquals('Count before',3,FM.IdentifierCount);
- FM.Delete(2);
- AssertEquals('Count after',2,FM.IdentifierCount);
- AssertEquals('No more',-1,FM.IndexOfIdentifier('EchoDate3'));
- AssertEquals('Left 1',0,FM.IndexOfIdentifier('EchoDate'));
- AssertEquals('Left 2',1,FM.IndexOfIdentifier('EchoDate2'));
- end;
- procedure TTestBuiltinsManager.TestRemove;
- begin
- FM.AddFunction(bcUser,'EchoDate','D','D',@EchoDate);
- FM.AddFunction(bcUser,'EchoDate2','D','D',@EchoDate);
- FM.AddFunction(bcUser,'EchoDate3','D','D',@EchoDate);
- AssertEquals('Count before',3,FM.IdentifierCount);
- AssertEquals('Result ',1,FM.Remove('EchoDate2'));
- AssertEquals('Count after',2,FM.IdentifierCount);
- AssertEquals('No more',-1,FM.IndexOfIdentifier('EchoDate2'));
- AssertEquals('Left 1',0,FM.IndexOfIdentifier('EchoDate'));
- AssertEquals('Left 2',1,FM.IndexOfIdentifier('EchoDate3'));
- AssertEquals('Result ',-1,FM.Remove('Nono'));
- end;
- { TTestBuiltins }
- procedure TTestBuiltins.Setup;
- begin
- inherited Setup;
- FM:=TExprBuiltInManager.Create(Nil);
- FValue:=0;
- end;
- procedure TTestBuiltins.Teardown;
- begin
- FreeAndNil(FM);
- inherited Teardown;
- end;
- procedure TTestBuiltins.SetExpression(const AExpression: String);
- Var
- Msg : String;
- begin
- Msg:='';
- try
- FP.Expression:=AExpression;
- except
- On E : Exception do
- Msg:=E.message;
- end;
- If (Msg<>'') then
- Fail('Parsing of expression "'+AExpression+'" failed :'+Msg);
- end;
- procedure TTestBuiltins.AssertVariable(const ADefinition: String;
- AResultType: TResultType);
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.FindIdentifier(ADefinition);
- AssertNotNull('Definition '+ADefinition+' is present.',I);
- AssertEquals('Correct result type',AResultType,I.ResultType);
- end;
- procedure TTestBuiltins.AssertFunction(const ADefinition, AResultType,
- ArgumentTypes: String; ACategory : TBuiltinCategory);
- Var
- I : TFPBuiltinExprIdentifierDef;
- begin
- I:=FM.FindIdentifier(ADefinition);
- AssertEquals('Correct result type for test',1,Length(AResultType));
- AssertNotNull('Definition '+ADefinition+' is present.',I);
- AssertEquals(ADefinition+' has correct parameter types',ArgumentTypes,I.ParameterTypes);
- AssertEquals(ADefinition+' has correct result type',CharToResultType(AResultType[1]),I.ResultType);
- AssertEquals(ADefinition+' has correct category',Ord(ACategory),Ord(I.Category));
- end;
- procedure TTestBuiltins.AssertExpression(const AExpression: String;
- AResult: Int64);
- begin
- FP.BuiltIns:=AllBuiltIns;
- SetExpression(AExpression);
- AssertResult(AResult);
- end;
- procedure TTestBuiltins.AssertExpression(const AExpression: String;
- const AResult: String);
- begin
- FP.BuiltIns:=AllBuiltIns;
- SetExpression(AExpression);
- AssertResult(AResult);
- end;
- procedure TTestBuiltins.AssertExpression(const AExpression: String;
- const AResult: TExprFloat);
- begin
- FP.BuiltIns:=AllBuiltIns;
- SetExpression(AExpression);
- AssertResult(AResult);
- end;
- procedure TTestBuiltins.AssertExpression(const AExpression: String;
- const AResult: Boolean);
- begin
- FP.BuiltIns:=AllBuiltIns;
- SetExpression(AExpression);
- AssertResult(AResult);
- end;
- procedure TTestBuiltins.AssertDateTimeExpression(const AExpression: String;
- const AResult: TDateTime);
- begin
- FP.BuiltIns:=AllBuiltIns;
- SetExpression(AExpression);
- AssertDatetimeResult(AResult);
- end;
- procedure TTestBuiltins.AssertAggregateExpression(const AExpression: String;
- AResult: Int64; AUpdateCount: integer);
- begin
- FP.BuiltIns:=AllBuiltIns;
- SetExpression(AExpression);
- AssertEquals('Has aggregate',True,FP.ExprNode.HasAggregate);
- FP.InitAggregate;
- While AUpdateCount>0 do
- begin
- FP.UpdateAggregate;
- Dec(AUpdateCount);
- end;
- AssertResult(AResult);
- end;
- procedure TTestBuiltins.AssertAggregateExpression(const AExpression: String;
- AResult: TExprFloat; AUpdateCount: integer);
- begin
- FP.BuiltIns:=AllBuiltIns;
- SetExpression(AExpression);
- AssertEquals('Has aggregate',True,FP.ExprNode.HasAggregate);
- FP.InitAggregate;
- While AUpdateCount>0 do
- begin
- FP.UpdateAggregate;
- Dec(AUpdateCount);
- end;
- AssertResult(AResult);
- end;
- procedure TTestBuiltins.AssertAggregateCurrExpression(Const AExpression : String; AResult : Currency; AUpdateCount : integer);
- begin
- FP.BuiltIns:=AllBuiltIns;
- SetExpression(AExpression);
- AssertEquals('Has aggregate',True,FP.ExprNode.HasAggregate);
- FP.InitAggregate;
- While AUpdateCount>0 do
- begin
- FP.UpdateAggregate;
- Dec(AUpdateCount);
- end;
- AssertCurrencyResult(AResult);
- end;
- procedure TTestBuiltins.TestRegister;
- begin
- RegisterStdBuiltins(FM);
- Assertvariable('pi',rtFloat);
- AssertFunction('cos','F','F',bcMath);
- AssertFunction('sin','F','F',bcMath);
- AssertFunction('arctan','F','F',bcMath);
- AssertFunction('abs','F','F',bcMath);
- AssertFunction('sqr','F','F',bcMath);
- AssertFunction('sqrt','F','F',bcMath);
- AssertFunction('exp','F','F',bcMath);
- AssertFunction('ln','F','F',bcMath);
- AssertFunction('log','F','F',bcMath);
- AssertFunction('frac','F','F',bcMath);
- AssertFunction('int','F','F',bcMath);
- AssertFunction('round','I','F',bcMath);
- AssertFunction('trunc','I','F',bcMath);
- AssertFunction('length','I','S',bcStrings);
- AssertFunction('copy','S','SII',bcStrings);
- AssertFunction('delete','S','SII',bcStrings);
- AssertFunction('pos','I','SS',bcStrings);
- AssertFunction('lowercase','S','S',bcStrings);
- AssertFunction('uppercase','S','S',bcStrings);
- AssertFunction('stringreplace','S','SSSBB',bcStrings);
- AssertFunction('comparetext','I','SS',bcStrings);
- AssertFunction('date','D','',bcDateTime);
- AssertFunction('time','D','',bcDateTime);
- AssertFunction('now','D','',bcDateTime);
- AssertFunction('dayofweek','I','D',bcDateTime);
- AssertFunction('extractyear','I','D',bcDateTime);
- AssertFunction('extractmonth','I','D',bcDateTime);
- AssertFunction('extractday','I','D',bcDateTime);
- AssertFunction('extracthour','I','D',bcDateTime);
- AssertFunction('extractmin','I','D',bcDateTime);
- AssertFunction('extractsec','I','D',bcDateTime);
- AssertFunction('extractmsec','I','D',bcDateTime);
- AssertFunction('encodedate','D','III',bcDateTime);
- AssertFunction('encodetime','D','IIII',bcDateTime);
- AssertFunction('encodedatetime','D','IIIIIII',bcDateTime);
- AssertFunction('shortdayname','S','I',bcDateTime);
- AssertFunction('shortmonthname','S','I',bcDateTime);
- AssertFunction('longdayname','S','I',bcDateTime);
- AssertFunction('longmonthname','S','I',bcDateTime);
- AssertFunction('shl','I','II',bcBoolean);
- AssertFunction('shr','I','II',bcBoolean);
- AssertFunction('IFS','S','BSS',bcBoolean);
- AssertFunction('IFF','F','BFF',bcBoolean);
- AssertFunction('IFD','D','BDD',bcBoolean);
- AssertFunction('IFI','I','BII',bcBoolean);
- AssertFunction('inttostr','S','I',bcConversion);
- AssertFunction('strtoint','I','S',bcConversion);
- AssertFunction('strtointdef','I','SI',bcConversion);
- AssertFunction('floattostr','S','F',bcConversion);
- AssertFunction('strtofloat','F','S',bcConversion);
- AssertFunction('strtofloatdef','F','SF',bcConversion);
- AssertFunction('booltostr','S','B',bcConversion);
- AssertFunction('strtobool','B','S',bcConversion);
- AssertFunction('strtobooldef','B','SB',bcConversion);
- AssertFunction('datetostr','S','D',bcConversion);
- AssertFunction('timetostr','S','D',bcConversion);
- AssertFunction('strtodate','D','S',bcConversion);
- AssertFunction('strtodatedef','D','SD',bcConversion);
- AssertFunction('strtotime','D','S',bcConversion);
- AssertFunction('strtotimedef','D','SD',bcConversion);
- AssertFunction('strtodatetime','D','S',bcConversion);
- AssertFunction('strtodatetimedef','D','SD',bcConversion);
- AssertFunction('formatfloat','S','SF',bcConversion);
- AssertFunction('formatdatetime','S','SD',bcConversion);
- AssertFunction('sum','F','F',bcAggregate);
- AssertFunction('count','I','',bcAggregate);
- AssertFunction('avg','F','F',bcAggregate);
- AssertFunction('min','F','F',bcAggregate);
- AssertFunction('max','F','F',bcAggregate);
- AssertEquals('Correct number of identifiers',70,FM.IdentifierCount);
- end;
- procedure TTestBuiltins.TestVariablepi;
- begin
- AssertExpression('pi',Pi);
- end;
- procedure TTestBuiltins.TestFunctioncos;
- begin
- AssertExpression('cos(0.5)',Cos(0.5));
- AssertExpression('cos(0.75)',Cos(0.75));
- end;
- procedure TTestBuiltins.TestFunctionsin;
- begin
- AssertExpression('sin(0.5)',sin(0.5));
- AssertExpression('sin(0.75)',sin(0.75));
- end;
- procedure TTestBuiltins.TestFunctionarctan;
- begin
- AssertExpression('arctan(0.5)',arctan(0.5));
- AssertExpression('arctan(0.75)',arctan(0.75));
- end;
- procedure TTestBuiltins.TestFunctionabs;
- begin
- AssertExpression('abs(0.5)',0.5);
- AssertExpression('abs(-0.75)',0.75);
- end;
- procedure TTestBuiltins.TestFunctionsqr;
- begin
- AssertExpression('sqr(0.5)',sqr(0.5));
- AssertExpression('sqr(-0.75)',sqr(0.75));
- end;
- procedure TTestBuiltins.TestFunctionsqrt;
- begin
- AssertExpression('sqrt(0.5)',sqrt(0.5));
- AssertExpression('sqrt(0.75)',sqrt(0.75));
- end;
- procedure TTestBuiltins.TestFunctionexp;
- begin
- AssertExpression('exp(1.0)',exp(1));
- AssertExpression('exp(0.0)',1.0);
- end;
- procedure TTestBuiltins.TestFunctionln;
- begin
- AssertExpression('ln(0.5)',ln(0.5));
- AssertExpression('ln(1.5)',ln(1.5));
- end;
- procedure TTestBuiltins.TestFunctionlog;
- begin
- AssertExpression('log(0.5)',ln(0.5)/ln(10.0));
- AssertExpression('log(1.5)',ln(1.5)/ln(10.0));
- AssertExpression('log(10.0)',1.0);
- end;
- procedure TTestBuiltins.TestFunctionfrac;
- begin
- AssertExpression('frac(0.5)',frac(0.5));
- AssertExpression('frac(1.5)',frac(1.5));
- end;
- procedure TTestBuiltins.TestFunctionint;
- begin
- AssertExpression('int(0.5)',int(0.5));
- AssertExpression('int(1.5)',int(1.5));
- end;
- procedure TTestBuiltins.TestFunctionround;
- begin
- AssertExpression('round(0.5)',round(0.5));
- AssertExpression('round(1.55)',round(1.55));
- end;
- procedure TTestBuiltins.TestFunctiontrunc;
- begin
- AssertExpression('trunc(0.5)',trunc(0.5));
- AssertExpression('trunc(1.55)',trunc(1.55));
- end;
- procedure TTestBuiltins.TestFunctionlength;
- begin
- AssertExpression('length(''123'')',3);
- end;
- procedure TTestBuiltins.TestFunctioncopy;
- begin
- AssertExpression('copy(''123456'',2,4)','2345');
- end;
- procedure TTestBuiltins.TestFunctiondelete;
- begin
- AssertExpression('delete(''123456'',2,4)','16');
- end;
- procedure TTestBuiltins.TestFunctionpos;
- begin
- AssertExpression('pos(''234'',''123456'')',2);
- end;
- procedure TTestBuiltins.TestFunctionlowercase;
- begin
- AssertExpression('lowercase(''AbCdEf'')','abcdef');
- end;
- procedure TTestBuiltins.TestFunctionuppercase;
- begin
- AssertExpression('uppercase(''AbCdEf'')','ABCDEF');
- end;
- procedure TTestBuiltins.TestFunctionstringreplace;
- begin
- // last options are replaceall, ignorecase
- AssertExpression('stringreplace(''AbCdEf'',''C'',''Z'',false,false)','AbZdEf');
- AssertExpression('stringreplace(''AbCdEf'',''c'',''Z'',false,false)','AbCdEf');
- AssertExpression('stringreplace(''AbCdEf'',''c'',''Z'',false,true)','AbZdEf');
- AssertExpression('stringreplace(''AbCdEfC'',''C'',''Z'',false,false)','AbZdEfC');
- AssertExpression('stringreplace(''AbCdEfC'',''C'',''Z'',True,false)','AbZdEfZ');
- end;
- procedure TTestBuiltins.TestFunctioncomparetext;
- begin
- AssertExpression('comparetext(''AbCdEf'',''AbCdEf'')',0);
- AssertExpression('comparetext(''AbCdEf'',''ABCDEF'')',0);
- AssertExpression('comparetext(''AbCdEf'',''FEDCBA'')',comparetext('AbCdEf','FEDCBA'));
- end;
- procedure TTestBuiltins.TestFunctiondate;
- begin
- AssertExpression('date',date);
- end;
- procedure TTestBuiltins.TestFunctiontime;
- begin
- AssertExpression('time',time);
- end;
- procedure TTestBuiltins.TestFunctionnow;
- begin
- AssertExpression('now',now);
- end;
- procedure TTestBuiltins.TestFunctiondayofweek;
- begin
- FP.Identifiers.AddDateTimeVariable('D',Date);
- AssertExpression('dayofweek(d)',DayOfWeek(date));
- end;
- procedure TTestBuiltins.TestFunctionextractyear;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(Date,Y,M,D);
- FP.Identifiers.AddDateTimeVariable('D',Date);
- AssertExpression('extractyear(d)',Y);
- end;
- procedure TTestBuiltins.TestFunctionextractmonth;
- Var
- Y,M,D : Word;
- begin
- FP.Identifiers.AddDateTimeVariable('D',Date);
- DecodeDate(Date,Y,M,D);
- AssertExpression('extractmonth(d)',M);
- end;
- procedure TTestBuiltins.TestFunctionextractday;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(Date,Y,M,D);
- FP.Identifiers.AddDateTimeVariable('D',Date);
- AssertExpression('extractday(d)',D);
- end;
- procedure TTestBuiltins.TestFunctionextracthour;
- Var
- T : TDateTime;
- H,m,s,ms : Word;
- begin
- T:=Time;
- DecodeTime(T,h,m,s,ms);
- FP.Identifiers.AddDateTimeVariable('T',T);
- AssertExpression('extracthour(t)',h);
- end;
- procedure TTestBuiltins.TestFunctionextractmin;
- Var
- T : TDateTime;
- H,m,s,ms : Word;
- begin
- T:=Time;
- DecodeTime(T,h,m,s,ms);
- FP.Identifiers.AddDateTimeVariable('T',T);
- AssertExpression('extractmin(t)',m);
- end;
- procedure TTestBuiltins.TestFunctionextractsec;
- Var
- T : TDateTime;
- H,m,s,ms : Word;
- begin
- T:=Time;
- DecodeTime(T,h,m,s,ms);
- FP.Identifiers.AddDateTimeVariable('T',T);
- AssertExpression('extractsec(t)',s);
- end;
- procedure TTestBuiltins.TestFunctionextractmsec;
- Var
- T : TDateTime;
- H,m,s,ms : Word;
- begin
- T:=Time;
- DecodeTime(T,h,m,s,ms);
- FP.Identifiers.AddDateTimeVariable('T',T);
- AssertExpression('extractmsec(t)',ms);
- end;
- procedure TTestBuiltins.TestFunctionencodedate;
- begin
- AssertExpression('encodedate(2008,10,11)',EncodeDate(2008,10,11));
- end;
- procedure TTestBuiltins.TestFunctionencodetime;
- begin
- AssertExpression('encodetime(14,10,11,0)',EncodeTime(14,10,11,0));
- end;
- procedure TTestBuiltins.TestFunctionencodedatetime;
- begin
- AssertExpression('encodedatetime(2008,12,13,14,10,11,0)',EncodeDate(2008,12,13)+EncodeTime(14,10,11,0));
- end;
- procedure TTestBuiltins.TestFunctionshortdayname;
- begin
- AssertExpression('shortdayname(1)',ShortDayNames[1]);
- AssertExpression('shortdayname(7)',ShortDayNames[7]);
- end;
- procedure TTestBuiltins.TestFunctionshortmonthname;
- begin
- AssertExpression('shortmonthname(1)',ShortMonthNames[1]);
- AssertExpression('shortmonthname(12)',ShortMonthNames[12]);
- end;
- procedure TTestBuiltins.TestFunctionlongdayname;
- begin
- AssertExpression('longdayname(1)',longDayNames[1]);
- AssertExpression('longdayname(7)',longDayNames[7]);
- end;
- procedure TTestBuiltins.TestFunctionlongmonthname;
- begin
- AssertExpression('longmonthname(1)',longMonthNames[1]);
- AssertExpression('longmonthname(12)',longMonthNames[12]);
- end;
- procedure TTestBuiltins.TestFunctionformatdatetime;
- begin
- AssertExpression('FormatDateTime(''cccc'',Date)',FormatDateTime('cccc',Date));
- end;
- procedure TTestBuiltins.TestFunctionshl;
- Var
- I : Int64;
- begin
- AssertExpression('shl(12,3)',12 shl 3);
- I:=12 shl 30;
- AssertExpression('shl(12,30)',I);
- end;
- procedure TTestBuiltins.TestFunctionshr;
- begin
- AssertExpression('shr(12,2)',12 shr 2);
- end;
- procedure TTestBuiltins.TestFunctionIFS;
- begin
- AssertExpression('ifs(true,''string1'',''string2'')','string1');
- AssertExpression('ifs(false,''string1'',''string2'')','string2');
- end;
- procedure TTestBuiltins.TestFunctionIFF;
- begin
- AssertExpression('iff(true,1.0,2.0)',1.0);
- AssertExpression('iff(false,1.0,2.0)',2.0);
- end;
- procedure TTestBuiltins.TestFunctionIFD;
- begin
- FP.Identifiers.AddDateTimeVariable('A',Date);
- FP.Identifiers.AddDateTimeVariable('B',Date-1);
- AssertExpression('ifd(true,A,B)',Date);
- AssertExpression('ifd(false,A,B)',Date-1);
- end;
- procedure TTestBuiltins.TestFunctionIFI;
- begin
- AssertExpression('ifi(true,1,2)',1);
- AssertExpression('ifi(false,1,2)',2);
- end;
- procedure TTestBuiltins.TestFunctioninttostr;
- begin
- AssertExpression('inttostr(2)','2');
- end;
- procedure TTestBuiltins.TestFunctionstrtoint;
- begin
- AssertExpression('strtoint(''2'')',2);
- end;
- procedure TTestBuiltins.TestFunctionstrtointdef;
- begin
- AssertExpression('strtointdef(''abc'',2)',2);
- end;
- procedure TTestBuiltins.TestFunctionfloattostr;
- begin
- AssertExpression('floattostr(1.23)',Floattostr(1.23));
- end;
- procedure TTestBuiltins.TestFunctionstrtofloat;
- Var
- S : String;
- begin
- S:='1.23';
- S[2]:=DecimalSeparator;
- AssertExpression('strtofloat('''+S+''')',1.23);
- end;
- procedure TTestBuiltins.TestFunctionstrtofloatdef;
- begin
- AssertExpression('strtofloatdef(''abc'',1.23)',1.23);
- end;
- procedure TTestBuiltins.TestFunctionbooltostr;
- begin
- AssertExpression('strtofloatdef(''abc'',1.23)',1.23);
- end;
- procedure TTestBuiltins.TestFunctionstrtobool;
- begin
- AssertExpression('strtobool(''0'')',false);
- end;
- procedure TTestBuiltins.TestFunctionstrtobooldef;
- begin
- AssertExpression('strtobooldef(''XYZ'',True)',True);
- end;
- procedure TTestBuiltins.TestFunctiondatetostr;
- begin
- FP.Identifiers.AddDateTimeVariable('A',Date);
- AssertExpression('DateToStr(A)',DateToStr(Date));
- end;
- procedure TTestBuiltins.TestFunctiontimetostr;
- Var
- T : TDateTime;
- begin
- T:=Time;
- FP.Identifiers.AddDateTimeVariable('A',T);
- AssertExpression('TimeToStr(A)',TimeToStr(T));
- end;
- procedure TTestBuiltins.TestFunctionstrtodate;
- begin
- FP.Identifiers.AddStringVariable('S',DateToStr(Date));
- AssertExpression('StrToDate(S)',Date);
- end;
- procedure TTestBuiltins.TestFunctionstrtodatedef;
- begin
- FP.Identifiers.AddDateTimeVariable('A',Date);
- AssertExpression('StrToDateDef(''S'',A)',Date);
- end;
- procedure TTestBuiltins.TestFunctionstrtotime;
- Var
- T : TDateTime;
- begin
- T:=Time;
- FP.Identifiers.AddStringVariable('S',TimeToStr(T));
- AssertExpression('StrToTime(S)',T);
- end;
- procedure TTestBuiltins.TestFunctionstrtotimedef;
- Var
- T : TDateTime;
- begin
- T:=Time;
- FP.Identifiers.AddDateTimeVariable('S',T);
- AssertExpression('StrToTimeDef(''q'',S)',T);
- end;
- procedure TTestBuiltins.TestFunctionstrtodatetime;
- Var
- T : TDateTime;
- S : String;
- begin
- T:=Now;
- S:=DateTimetostr(T);
- AssertExpression('StrToDateTime('''+S+''')',T);
- end;
- procedure TTestBuiltins.TestFunctionstrtodatetimedef;
- Var
- T : TDateTime;
- S : String;
- begin
- T:=Now;
- S:=DateTimetostr(T);
- FP.Identifiers.AddDateTimeVariable('S',T);
- AssertExpression('StrToDateTimeDef('''+S+''',S)',T);
- end;
- procedure TTestBuiltins.TestFunctionAggregateSum;
- begin
- FP.Identifiers.AddIntegerVariable('S',2);
- AssertAggregateExpression('sum(S)',10,5);
- end;
- procedure TTestBuiltins.TestFunctionAggregateSumFloat;
- begin
- FP.Identifiers.AddFloatVariable('S',2.0);
- AssertAggregateExpression('sum(S)',10.0,5);
- end;
- procedure TTestBuiltins.TestFunctionAggregateSumCurrency;
- begin
- FP.Identifiers.AddCurrencyVariable('S',2.0);
- AssertAggregateCurrExpression('sum(S)',Currency(10.0),5);
- end;
- procedure TTestBuiltins.TestFunctionAggregateCount;
- begin
- AssertAggregateExpression('count',5,5);
- end;
- procedure TTestBuiltins.DoAverage(var Result: TFPExpressionResult; ConstRef
- AName: ShortString);
- begin
- Inc(FValue);
- Result.ResInteger:=FValue;
- Result.ResultType:=rtInteger;
- end;
- procedure TTestBuiltins.DoSeries(var Result: TFPExpressionResult; ConstRef
- AName: ShortString);
- Const
- Values : Array[1..10] of double =
- (1.3,1.8,1.1,9.9,1.4,2.4,5.8,6.5,7.8,8.1);
- begin
- Inc(FValue);
- Result.ResFloat:=Values[FValue];
- Result.ResultType:=rtFloat;
- end;
- procedure TTestBuiltins.TestFunctionAggregateAvg;
- begin
- FP.Identifiers.AddVariable('S',rtInteger,@DoAverage);
- AssertAggregateExpression('avg(S)',5.5,10);
- end;
- procedure TTestBuiltins.TestFunctionAggregateMin;
- begin
- FP.Identifiers.AddVariable('S',rtFloat,@DoSeries);
- AssertAggregateExpression('Min(S)',1.1,10);
- end;
- procedure TTestBuiltins.TestFunctionAggregateMax;
- begin
- FP.Identifiers.AddVariable('S',rtFloat,@DoSeries);
- AssertAggregateExpression('Max(S)',9.9,10);
- end;
- { TTestNotNode }
- procedure TTestNotNode.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestNotNode.TestCreateInteger;
- begin
- FN:=TFPNotNode.Create(CreateIntNode(3));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',Not(Int64(3)),FN.NodeValue.ResInteger);
- end;
- procedure TTestNotNode.TestCreateBoolean;
- begin
- FN:=TFPNotNode.Create(CreateBoolNode(True));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtBoolean,FN.NodeType);
- AssertEquals('Correct result',False,FN.NodeValue.ResBoolean);
- end;
- procedure TTestNotNode.TestCreateString;
- begin
- FN:=TFPNotNode.Create(CreateStringNode('True'));
- AssertNodeNotOK('String node type',FN);
- end;
- procedure TTestNotNode.TestCreateFloat;
- begin
- FN:=TFPNotNode.Create(CreateFloatNode(1.23));
- AssertNodeNotOK('String node type',FN);
- end;
- procedure TTestNotNode.TestCreateDateTime;
- begin
- FN:=TFPNotNode.Create(CreateDateTimeNode(Now));
- AssertNodeNotOK('String node type',FN);
- end;
- procedure TTestNotNode.TestDestroy;
- begin
- FN:=TFPNotNode.Create(TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for operand',1,self.FDestroyCalled)
- end;
- { TTestIfOperation }
- procedure TTestIfOperation.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestIfOperation.TestCreateInteger;
- begin
- FN:=TIfOperation.Create(CreateIntNode(1),CreateIntNode(2),CreateIntNode(3));
- AssertNodeNotOK('First argument wrong',FN);
- end;
- procedure TTestIfOperation.TestCreateBoolean;
- begin
- FN:=TIfOperation.Create(CreateBoolNode(True),CreateIntNode(2),CreateIntNode(3));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',2,FN.NodeValue.ResInteger);
- end;
- procedure TTestIfOperation.TestCreateBoolean2;
- begin
- FN:=TIfOperation.Create(CreateBoolNode(False),CreateIntNode(2),CreateIntNode(3));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
- end;
- procedure TTestIfOperation.TestCreateBooleanInteger;
- begin
- FN:=TIfOperation.Create(CreateBoolNode(False),CreateIntNode(2),CreateBoolNode(False));
- AssertNodeNotOK('Arguments differ in type',FN);
- end;
- procedure TTestIfOperation.TestCreateBooleanInteger2;
- begin
- FN:=TIfOperation.Create(CreateBoolNode(True),CreateIntNode(2),CreateIntNode(3));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',2,FN.NodeValue.ResInteger);
- end;
- procedure TTestIfOperation.TestCreateBooleanString;
- begin
- FN:=TIfOperation.Create(CreateBoolNode(True),CreateStringNode('2'),CreateStringNode('3'));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','2',FN.NodeValue.ResString);
- end;
- procedure TTestIfOperation.TestCreateBooleanString2;
- begin
- FN:=TIfOperation.Create(CreateBoolNode(False),CreateStringNode('2'),CreateStringNode('3'));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','3',FN.NodeValue.ResString);
- end;
- procedure TTestIfOperation.TestCreateBooleanDateTime;
- begin
- FN:=TIfOperation.Create(CreateBoolNode(True),CreateDateTimeNode(Date),CreateDateTimeNode(Date-1));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtDateTime,FN.NodeType);
- AssertEquals('Correct result',Date,FN.NodeValue.ResDateTime);
- end;
- procedure TTestIfOperation.TestCreateBooleanDateTime2;
- begin
- FN:=TIfOperation.Create(CreateBoolNode(False),CreateDateTimeNode(Date),CreateDateTimeNode(Date-1));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtDateTime,FN.NodeType);
- AssertEquals('Correct result',Date-1,FN.NodeValue.ResDateTime);
- end;
- procedure TTestIfOperation.TestCreateString;
- begin
- FN:=TIfOperation.Create(CreateStringNode('1'),CreateIntNode(2),CreateIntNode(3));
- AssertNodeNotOK('First argument wrong',FN);
- end;
- procedure TTestIfOperation.TestCreateFloat;
- begin
- FN:=TIfOperation.Create(CreateFloatNode(2.0),CreateIntNode(2),CreateIntNode(3));
- AssertNodeNotOK('First argument wrong',FN);
- end;
- procedure TTestIfOperation.TestCreateDateTime;
- begin
- FN:=TIfOperation.Create(CreateDateTimeNode(Date),CreateIntNode(2),CreateIntNode(3));
- AssertNodeNotOK('First argument wrong',FN);
- end;
- procedure TTestIfOperation.TestDestroy;
- begin
- FN:=TIfOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
- FreeAndNil(FN);
- AssertEquals('Destroy called for operand',3,self.FDestroyCalled)
- end;
- { TTestCaseOperation }
- function TTestCaseOperation.CreateArgs(
- Args: array of const): TExprArgumentArray;
- Var
- I : Integer;
- begin
- Result:=Default(TExprArgumentArray);
- SetLength(Result,High(Args)-Low(Args)+1);
- For I:=Low(Args) to High(Args) do
- Result[I]:=Args[i].VObject as TFPExprNode;
- end;
- procedure TTestCaseOperation.TearDown;
- begin
- FreeAndNil(FN);
- inherited TearDown;
- end;
- procedure TTestCaseOperation.TestCreateOne;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False)]));
- AssertNodeNotOK('Too little arguments',FN);
- end;
- procedure TTestCaseOperation.TestCreateTwo;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False)]));
- AssertNodeNotOK('Too little arguments',FN);
- end;
- procedure TTestCaseOperation.TestCreateThree;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False),CreateBoolNode(False)]));
- AssertNodeNotOK('Too little arguments',FN);
- end;
- procedure TTestCaseOperation.TestCreateOdd;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False),
- CreateBoolNode(False),CreateBoolNode(False),
- CreateBoolNode(False)]));
- AssertNodeNotOK('Odd number of arguments',FN);
- end;
- procedure TTestCaseOperation.TestCreateNoExpression;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),
- CreateBoolNode(False),
- TFPBinaryOrOperation.Create(CreateBoolNode(False),CreateBoolNode(False)),
- CreateBoolNode(False)]));
- AssertNodeNotOK('Label is not a constant expression',FN);
- end;
- procedure TTestCaseOperation.TestCreateWrongLabel;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False),
- CreateIntNode(1),CreateBoolNode(False),
- CreateBoolNode(True),CreateBoolNode(False)]));
- AssertNodeNotOK('Wrong label',FN);
- end;
- procedure TTestCaseOperation.TestCreateWrongValue;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False),
- CreateIntNode(1),CreateBoolNode(False),
- CreateIntNode(2),CreateIntNode(1)]));
- AssertNodeNotOK('Wrong value',FN);
- end;
- procedure TTestCaseOperation.TestIntegerTag;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateStringNode('many'),
- CreateIntNode(1),CreateStringNode('one'),
- CreateIntNode(2),CreateStringNode('two')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','one',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestIntegerTagDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateStringNode('many'),
- CreateIntNode(1),CreateStringNode('one'),
- CreateIntNode(2),CreateStringNode('two')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','many',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestStringTag;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateStringNode('one'),CreateIntNode(3),
- CreateStringNode('one'),CreateIntNode(1),
- CreateStringNode('two'),CreateIntNode(2)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',1,FN.NodeValue.ResInteger);
- end;
- procedure TTestCaseOperation.TestStringTagDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateStringNode('many'),CreateIntNode(3),
- CreateStringNode('one'),CreateIntNode(1),
- CreateStringNode('two'),CreateIntNode(2)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
- end;
- procedure TTestCaseOperation.TestFloatTag;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateFloatNode(1.0),CreateStringNode('many'),
- CreateFloatNode(1.0),CreateStringNode('one'),
- CreateFloatNode(2.0),CreateStringNode('two')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','one',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestFloatTagDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateFloatNode(3.0),CreateStringNode('many'),
- CreateFloatNode(1.0),CreateStringNode('one'),
- CreateFloatNode(2.0),CreateStringNode('two')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','many',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestBooleanTag;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(True),CreateStringNode('unknown'),
- CreateBoolNode(True),CreateStringNode('one'),
- CreateBoolNode(False),CreateStringNode('two')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','one',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestBooleanTagDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(True),CreateStringNode('unknown'),
- CreateBoolNode(False),CreateStringNode('two')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','unknown',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestDateTimeTag;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateDateTimeNode(Date),CreateStringNode('later'),
- CreateDateTimeNode(Date),CreateStringNode('today'),
- CreateDateTimeNode(Date+1),CreateStringNode('tomorrow')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','today',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestDateTimeTagDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateDateTimeNode(Date+2),CreateStringNode('later'),
- CreateDateTimeNode(Date),CreateStringNode('today'),
- CreateDateTimeNode(Date+1),CreateStringNode('tomorrow')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','later',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestIntegerValue;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateIntNode(0),
- CreateIntNode(1),CreateIntNode(-1),
- CreateIntNode(2),CreateIntNode(-2)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',-1,FN.NodeValue.ResInteger);
- end;
- procedure TTestCaseOperation.TestIntegerValueDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateIntNode(0),
- CreateIntNode(1),CreateIntNode(-1),
- CreateIntNode(2),CreateIntNode(-2)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtInteger,FN.NodeType);
- AssertEquals('Correct result',0,FN.NodeValue.ResInteger);
- end;
- procedure TTestCaseOperation.TestStringValue;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateStringNode('many'),
- CreateIntNode(1),CreateStringNode('one'),
- CreateIntNode(2),CreateStringNode('two')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','one',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestStringValueDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateStringNode('many'),
- CreateIntNode(1),CreateStringNode('one'),
- CreateIntNode(2),CreateStringNode('two')]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtString,FN.NodeType);
- AssertEquals('Correct result','many',FN.NodeValue.ResString);
- end;
- procedure TTestCaseOperation.TestFloatValue;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateFloatNode(0.0),
- CreateIntNode(1),CreateFloatNode(2.0),
- CreateIntNode(2),CreateFloatNode(1.0)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtFloat,FN.NodeType);
- AssertEquals('Correct result',2.0,FN.NodeValue.ResFloat);
- end;
- procedure TTestCaseOperation.TestFloatValueDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateFloatNode(0.0),
- CreateIntNode(1),CreateFloatNode(2.0),
- CreateIntNode(2),CreateFloatNode(1.0)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtFloat,FN.NodeType);
- AssertEquals('Correct result',0.0,FN.NodeValue.ResFloat);
- end;
- procedure TTestCaseOperation.TestBooleanValue;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False),
- CreateIntNode(1),CreateBoolNode(True),
- CreateIntNode(2),CreateBoolNode(False)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtBoolean,FN.NodeType);
- AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
- end;
- procedure TTestCaseOperation.TestBooleanValueDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateBoolNode(False),
- CreateIntNode(1),CreateBoolNode(True),
- CreateIntNode(2),CreateBoolNode(False)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtBoolean,FN.NodeType);
- AssertEquals('Correct result',False,FN.NodeValue.ResBoolean);
- end;
- procedure TTestCaseOperation.TestDateTimeValue;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateDateTimeNode(Date+1),
- CreateIntNode(1),CreateDateTimeNode(Date),
- CreateIntNode(2),CreateDateTimeNode(Date-1)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtDateTime,FN.NodeType);
- AssertEquals('Correct result',Date,FN.NodeValue.ResDateTime);
- end;
- procedure TTestCaseOperation.TestDateTimeValueDefault;
- begin
- FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateDateTimeNode(Date+1),
- CreateIntNode(1),CreateDateTimeNode(Date),
- CreateIntNode(2),CreateDateTimeNode(Date-1)]));
- AssertNodeOK(FN);
- AssertEquals('Correct node type',rtDateTime,FN.NodeType);
- AssertEquals('Correct result',Date+1,FN.NodeValue.ResDateTime);
- end;
- procedure TTestCaseOperation.TestDestroy;
- begin
- FN:=TCaseOperation.Create(CreateArgs([TMyDestroyNode.CreateTest(Self),
- TMyDestroyNode.CreateTest(Self),
- TMyDestroyNode.CreateTest(Self),
- TMyDestroyNode.CreateTest(Self)]));
- FreeAndNil(FN);
- AssertEquals('Destroy called for operand',4,self.FDestroyCalled)
- end;
- initialization
- RegisterTests('ExprPars',[TTestExpressionScanner, TTestDestroyNode,
- TTestConstExprNode,TTestNegateExprNode,
- TTestBinaryAndNode,TTestBinaryOrNode,TTestBinaryXOrNode,
- TTestNotNode,TTestEqualNode,TTestUnEqualNode,
- TTestIfOperation,TTestCaseOperation,
- TTestLessThanNode,TTestLessThanEqualNode,
- TTestLargerThanNode,TTestLargerThanEqualNode,
- TTestAddNode,TTestSubtractNode,
- TTestMultiplyNode,TTestDivideNode,TTestPowerNode,
- TTestIntToFloatNode,TTestIntToDateTimeNode,
- TTestFloatToDateTimeNode,
- TTestParserExpressions, TTestParserBooleanOperations,
- TTestParserOperands, TTestParserTypeMatch,
- TTestParserVariables,TTestParserFunctions,
- TTestParserAggregate,
- TTestBuiltinsManager,TTestBuiltins]);
- end.
|