testexprpars.pp 172 KB

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