2
0

testexprpars.pp 176 KB

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