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