testexprpars.pp 200 KB

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