tcparser.pas 301 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626662766286629663066316632663366346635663666376638663966406641664266436644664566466647664866496650665166526653665466556656665766586659666066616662666366646665666666676668666966706671667266736674667566766677667866796680668166826683668466856686668766886689669066916692669366946695669666976698669967006701670267036704670567066707670867096710671167126713671467156716671767186719672067216722672367246725672667276728672967306731673267336734673567366737673867396740674167426743674467456746674767486749675067516752675367546755675667576758675967606761676267636764676567666767676867696770677167726773677467756776677767786779678067816782678367846785678667876788678967906791679267936794679567966797679867996800680168026803680468056806680768086809681068116812681368146815681668176818681968206821682268236824682568266827682868296830683168326833683468356836683768386839684068416842684368446845684668476848684968506851685268536854685568566857685868596860686168626863686468656866686768686869687068716872687368746875687668776878687968806881688268836884688568866887688868896890689168926893689468956896689768986899690069016902690369046905690669076908690969106911691269136914691569166917691869196920692169226923692469256926692769286929693069316932693369346935693669376938693969406941694269436944694569466947694869496950695169526953695469556956695769586959696069616962696369646965696669676968696969706971697269736974697569766977697869796980698169826983698469856986698769886989699069916992699369946995699669976998699970007001700270037004700570067007700870097010701170127013701470157016701770187019702070217022702370247025702670277028702970307031703270337034703570367037703870397040704170427043704470457046704770487049705070517052705370547055705670577058705970607061706270637064706570667067706870697070707170727073707470757076707770787079708070817082708370847085708670877088708970907091709270937094709570967097709870997100710171027103710471057106710771087109711071117112711371147115711671177118711971207121712271237124712571267127712871297130713171327133713471357136713771387139714071417142714371447145714671477148714971507151715271537154715571567157715871597160716171627163716471657166716771687169717071717172717371747175717671777178717971807181718271837184718571867187718871897190719171927193719471957196719771987199720072017202720372047205720672077208720972107211721272137214721572167217721872197220722172227223722472257226722772287229723072317232723372347235723672377238723972407241724272437244724572467247724872497250725172527253725472557256725772587259726072617262726372647265726672677268726972707271727272737274727572767277727872797280728172827283728472857286728772887289729072917292729372947295729672977298729973007301730273037304730573067307730873097310731173127313731473157316731773187319732073217322732373247325732673277328732973307331733273337334733573367337733873397340734173427343734473457346734773487349735073517352735373547355735673577358735973607361736273637364736573667367736873697370737173727373737473757376737773787379738073817382738373847385738673877388738973907391739273937394739573967397739873997400740174027403740474057406740774087409741074117412741374147415741674177418741974207421742274237424742574267427742874297430743174327433743474357436743774387439744074417442744374447445744674477448744974507451745274537454745574567457745874597460746174627463746474657466746774687469747074717472747374747475747674777478747974807481748274837484748574867487748874897490749174927493749474957496749774987499750075017502750375047505750675077508750975107511751275137514751575167517751875197520752175227523752475257526752775287529753075317532753375347535753675377538753975407541754275437544754575467547754875497550755175527553755475557556755775587559756075617562756375647565756675677568756975707571757275737574757575767577757875797580758175827583758475857586758775887589759075917592759375947595759675977598759976007601760276037604760576067607760876097610761176127613761476157616761776187619762076217622762376247625762676277628762976307631763276337634763576367637763876397640764176427643764476457646764776487649765076517652765376547655765676577658765976607661766276637664766576667667766876697670767176727673767476757676767776787679768076817682768376847685768676877688768976907691769276937694769576967697769876997700770177027703770477057706770777087709771077117712771377147715771677177718771977207721772277237724772577267727772877297730773177327733773477357736773777387739774077417742774377447745774677477748774977507751775277537754775577567757775877597760776177627763776477657766776777687769777077717772777377747775777677777778777977807781778277837784778577867787778877897790779177927793779477957796779777987799780078017802780378047805780678077808780978107811781278137814781578167817781878197820782178227823782478257826782778287829783078317832783378347835783678377838783978407841784278437844784578467847784878497850785178527853785478557856785778587859786078617862786378647865786678677868786978707871787278737874787578767877787878797880788178827883788478857886788778887889789078917892789378947895789678977898789979007901790279037904790579067907790879097910791179127913791479157916791779187919792079217922792379247925792679277928792979307931793279337934793579367937793879397940794179427943794479457946794779487949795079517952795379547955795679577958795979607961796279637964796579667967796879697970797179727973797479757976797779787979798079817982798379847985798679877988798979907991799279937994799579967997799879998000800180028003800480058006800780088009801080118012801380148015801680178018801980208021802280238024802580268027802880298030803180328033803480358036803780388039804080418042804380448045804680478048804980508051805280538054805580568057805880598060806180628063806480658066806780688069807080718072807380748075807680778078807980808081808280838084808580868087808880898090809180928093809480958096809780988099810081018102810381048105810681078108810981108111811281138114811581168117811881198120812181228123812481258126812781288129813081318132813381348135813681378138813981408141814281438144814581468147814881498150815181528153815481558156815781588159816081618162816381648165816681678168816981708171817281738174817581768177817881798180818181828183818481858186818781888189819081918192819381948195819681978198819982008201820282038204820582068207820882098210821182128213821482158216821782188219822082218222822382248225822682278228822982308231823282338234823582368237823882398240824182428243824482458246824782488249825082518252825382548255825682578258825982608261826282638264826582668267826882698270827182728273827482758276827782788279828082818282828382848285828682878288828982908291829282938294829582968297829882998300830183028303830483058306830783088309831083118312831383148315831683178318831983208321832283238324832583268327832883298330833183328333833483358336833783388339834083418342834383448345834683478348834983508351835283538354835583568357835883598360836183628363836483658366836783688369837083718372837383748375837683778378837983808381838283838384838583868387838883898390839183928393839483958396839783988399840084018402840384048405840684078408840984108411841284138414841584168417841884198420842184228423842484258426842784288429843084318432843384348435843684378438843984408441844284438444844584468447844884498450845184528453845484558456845784588459846084618462846384648465846684678468846984708471847284738474847584768477847884798480848184828483848484858486848784888489849084918492849384948495849684978498849985008501850285038504850585068507850885098510851185128513851485158516851785188519852085218522852385248525852685278528852985308531853285338534853585368537853885398540854185428543854485458546854785488549855085518552855385548555855685578558855985608561856285638564856585668567856885698570857185728573857485758576857785788579858085818582858385848585858685878588858985908591859285938594859585968597859885998600
  1. {
  2. This file is part of the Free Component Library
  3. Copyright (c) 2010-2014 by the Free Pascal development team
  4. SQL source syntax parser test suite
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit tcparser;
  12. {$mode objfpc}{$H+}
  13. interface
  14. uses
  15. Classes, SysUtils, fpcunit, fpsqltree, fpsqlscanner, fpsqlparser, testregistry;
  16. type
  17. { TTestParser }
  18. TTestParser = Class(TSQLParser)
  19. public
  20. Procedure ParseStringDef(Out DT : TSQLDataType; Out Len : Integer; Out ACharset : TSQLStringtype);
  21. Function ParseType(Flags : TParseTypeFlags) : TSQLTypeDefinition;
  22. Function ParseConstraint : TSQLExpression;
  23. Function ParseProcedureStatements : TSQLStatement;
  24. end;
  25. { TTestSQLParser }
  26. TTestSQLParser = class(TTestCase)
  27. Private
  28. FParserOptions: TParserOptions;
  29. FSource : TStringStream;
  30. FParser : TTestParser;
  31. FToFree : TSQLElement; //will be freed by test teardown
  32. FErrSource : string;
  33. function GetParserOptions: TParserOptions;
  34. protected
  35. procedure AssertTypeDefaults(TD: TSQLTypeDefinition; Len: Integer=0);
  36. procedure TestStringDef(ASource: String; ExpectDT: TSQLDataType; ExpectLen: Integer; ExpectCharset : TSQLStringType='');
  37. function TestType(ASource : string; AFlags : TParseTypeFlags; AExpectedType : TSQLDataType) : TSQLTypeDefinition;
  38. function TestCheck(ASource : string; AExpectedConstraint : TSQLElementClass) : TSQLExpression;
  39. procedure CreateParser(Const ASource : string; aOptions : TParserOptions = []);
  40. function CheckClass(E : TSQLElement; C : TSQLElementClass) : TSQLElement;
  41. procedure TestDropStatement(Const ASource : string;C : TSQLElementClass);
  42. function TestCreateStatement(Const ASource,AName : string;C: TSQLElementClass) : TSQLCreateOrAlterStatement;
  43. procedure AssertEquals(const AMessage: String; Expected, Actual: TSQLToken); overload;
  44. procedure AssertEquals(const AMessage: String; Expected, Actual: TSQLBinaryoperation); overload;
  45. procedure AssertEquals(const AMessage: String; Expected, Actual: TSQLUnaryoperation); overload;
  46. procedure AssertEquals(const AMessage: String; Expected, Actual: TSQLternaryoperation); overload;
  47. procedure AssertEquals(const AMessage: String; Expected, Actual: TSQLDataType); overload;
  48. procedure AssertEquals(const AMessage: String; Expected, Actual: TForeignKeyAction); overload;
  49. procedure AssertEquals(const AMessage: String; Expected, Actual: TSQLJoinType); overload;
  50. procedure AssertEquals(const AMessage: String; Expected, Actual: TSQLAggregateFunction); overload;
  51. procedure AssertEquals(const AMessage: String; Expected, Actual: TSQLAggregateOption); overload;
  52. procedure AssertEquals(const AMessage: String; Expected, Actual: TSQLOrderDirection); overload;
  53. procedure AssertEquals(const AMessage: String; Expected, Actual: TPlanJoinType); overload;
  54. procedure AssertEquals(const AMessage: String; Expected, Actual: TTriggerMoment); overload;
  55. procedure AssertEquals(const AMessage: String; Expected, Actual: TTriggerState); overload;
  56. procedure AssertEquals(const AMessage: String; Expected, Actual: TTriggerOperations); overload;
  57. function AssertLiteralExpr(Const AMessage : String; Element : TSQLExpression; ALiteralClass : TSQLElementClass) : TSQLLiteral;
  58. procedure AssertIdentifierName(Const AMessage : String; Const AExpected : String; Element : TSQLElement);
  59. procedure AssertField(AField : TSQLElement; Const AName : String; Const AAlias : String = '');
  60. procedure AssertAggregate(AField : TSQLElement; AAgregate : TSQLAggregateFunction; Const AFieldName : String; AOption : TSQLAggregateOption; Const AAlias : String = '');
  61. procedure AssertAggregateExpression(E : TSQLElement; AAgregate : TSQLAggregateFunction; Const AFieldName : String; AOption : TSQLAggregateOption);
  62. procedure AssertTable(ATable : TSQLElement; Const AName : String; Const AAlias : String = '');
  63. function AssertJoin(AJoin : TSQLElement; Const AFirst,ASecond : String; Const aJoinType : TSQLJoinType) : TSQLJoinTableReference;
  64. function AssertJoinOn(AJoin : TSQLExpression; Const AFirst,ASecond : String; Const AOperation : TSQLBinaryOperation) : TSQLBinaryExpression;
  65. function AssertOrderBy(AOrderBy : TSQLElement; Const AField : String; Const ANumber : Integer; Const AOrdering : TSQLOrderDirection) : TSQLOrderByElement;
  66. function AssertSecondaryFile(ASecondaryFile : TSQLElement; Const AFile : String; Const ALength,AStart : Integer) : TSQLDatabaseFileInfo;
  67. procedure TestTypeError;
  68. procedure TestStringError;
  69. procedure TestCheckError;
  70. procedure TestParseError;
  71. procedure SetUp; override;
  72. procedure TearDown; override;
  73. property Parser : TTestParser Read FParser;
  74. property ParserOptions : TParserOptions Read GetParserOptions Write FParserOptions;
  75. property ToFree : TSQLElement Read FToFree Write FTofree;
  76. end;
  77. { TTestDropParser }
  78. TTestDropParser = Class(TTestSQLParser)
  79. published
  80. procedure TestDropDatabase;
  81. procedure TestDropDomain;
  82. procedure TestDropException;
  83. procedure TestDropGenerator;
  84. procedure TestDropIndex;
  85. procedure TestDropProcedure;
  86. procedure TestDropRole;
  87. procedure TestDropTable;
  88. procedure TestDropTrigger;
  89. procedure TestDropView;
  90. procedure TestDropShadow;
  91. procedure TestDropExternalFunction;
  92. end;
  93. { TTestGeneratorParser }
  94. TTestGeneratorParser = Class(TTestSQLParser)
  95. Published
  96. procedure TestCreateGenerator;
  97. procedure TestCreateSequence;
  98. procedure TestAlterSequence;
  99. procedure TestSetGenerator;
  100. end;
  101. { TTestSetTermParser }
  102. TTestSetTermParser = Class(TTestSQLParser)
  103. Published
  104. procedure TestSetTermNoOption;
  105. procedure TestSetTermOption;
  106. end;
  107. { TTestRoleParser }
  108. TTestRoleParser = Class(TTestSQLParser)
  109. Published
  110. procedure TestCreateRole;
  111. procedure TestAlterRole;
  112. end;
  113. { TTestTypeParser }
  114. TTestTypeParser = Class(TTestSQLParser)
  115. private
  116. Published
  117. procedure TestStringType1;
  118. procedure TestStringType2;
  119. procedure TestStringType3;
  120. procedure TestStringType4;
  121. procedure TestStringType5;
  122. procedure TestStringType6;
  123. procedure TestStringType7;
  124. procedure TestStringType8;
  125. procedure TestStringType9;
  126. procedure TestStringType10;
  127. procedure TestStringType11;
  128. procedure TestStringType12;
  129. procedure TestStringType13;
  130. procedure TestStringType14;
  131. procedure TestStringType15;
  132. procedure TestStringType16;
  133. procedure TestStringType17;
  134. procedure TestStringType18;
  135. procedure TestStringType19;
  136. procedure TestStringTypeErrors1;
  137. procedure TestStringTypeErrors2;
  138. procedure TestStringTypeErrors3;
  139. procedure TestTypeInt1;
  140. procedure TestTypeInt2;
  141. procedure TestTypeInt3;
  142. procedure TestTypeInt4;
  143. procedure TestTypeInt5;
  144. procedure TestNumerical1;
  145. procedure TestNumerical2;
  146. procedure TestNumerical3;
  147. procedure TestNumericalError1;
  148. procedure TestNumericalError2;
  149. procedure TestNumericalError3;
  150. procedure TestNumericalError4;
  151. procedure TestNumericalError5;
  152. procedure TestNumericalError6;
  153. procedure TestNumericalError7;
  154. procedure TestBlob1;
  155. procedure TestBlob2;
  156. procedure TestBlob3;
  157. procedure TestBlob4;
  158. procedure TestBlob5;
  159. procedure TestBlob6;
  160. procedure TestBlob7;
  161. procedure TestBlob8;
  162. procedure TestBlobError1;
  163. procedure TestBlobError2;
  164. procedure TestBlobError3;
  165. procedure TestBlobError4;
  166. procedure TestBlobError5;
  167. procedure TestBlobError6;
  168. procedure TestBlobError7;
  169. procedure TestSmallInt;
  170. procedure TestFloat;
  171. procedure TestDoublePrecision;
  172. procedure TestDoublePrecisionDefault;
  173. end;
  174. { TTestCheckParser }
  175. TTestCheckParser = Class (TTestSQLParser)
  176. private
  177. published
  178. procedure TestCheckNull;
  179. procedure TestCheckNotNull;
  180. procedure TestCheckBraces;
  181. procedure TestCheckBracesError;
  182. procedure TestCheckParamError;
  183. procedure TestCheckIdentifierError;
  184. procedure TestIsEqual;
  185. procedure TestIsNotEqual1;
  186. procedure TestIsNotEqual2;
  187. procedure TestGreaterThan;
  188. procedure TestGreaterThanEqual1;
  189. procedure TestGreaterThanEqual2;
  190. procedure TestLessThan;
  191. procedure TestLessThanEqual1;
  192. procedure TestLessThanEqual2;
  193. procedure TestLike;
  194. procedure TestNotLike;
  195. procedure TestContaining;
  196. procedure TestNotContaining;
  197. procedure TestStarting;
  198. procedure TestNotStarting;
  199. procedure TestStartingWith;
  200. procedure TestNotStartingWith;
  201. procedure TestBetween;
  202. procedure TestNotBetween;
  203. procedure TestLikeEscape;
  204. procedure TestNotLikeEscape;
  205. procedure TestAnd;
  206. procedure TestOr;
  207. procedure TestNotOr;
  208. procedure TestCase;
  209. procedure TestCaseWithSelector;
  210. procedure TestAdd;
  211. procedure TestSubtract;
  212. procedure TestMultiply;
  213. procedure TestDivide;
  214. end;
  215. { TTestDomainParser }
  216. // Most relevant tests are in type definition testing.
  217. TTestDomainParser = Class(TTestSQLParser)
  218. private
  219. Published
  220. procedure TestSimpleDomain;
  221. procedure TestSimpleDomainAs;
  222. procedure TestNotNullDomain;
  223. procedure TestDefaultNotNullDomain;
  224. procedure TestCheckDomain;
  225. procedure TestDefaultCheckNotNullDomain;
  226. procedure TestAlterDomainDropDefault;
  227. procedure TestAlterDomainDropCheck;
  228. procedure TestAlterDomainDropCheckError;
  229. procedure TestAlterDomainAddCheck;
  230. procedure TestAlterDomainAddConstraintCheck;
  231. procedure TestAlterDomainAddConstraintError;
  232. procedure TestAlterDomainSetDefault;
  233. procedure TestAlterDomainRename;
  234. procedure TestAlterDomainNewType;
  235. procedure TestAlterDomainNewTypeError1;
  236. procedure TestAlterDomainNewTypeError2;
  237. end;
  238. { TTestExceptionParser }
  239. TTestExceptionParser = Class(TTestSQLParser)
  240. Published
  241. procedure TestException;
  242. procedure TestAlterException;
  243. procedure TestExceptionError1;
  244. procedure TestExceptionError2;
  245. end;
  246. { TTestIndexParser }
  247. TTestIndexParser = Class(TTestSQLParser)
  248. private
  249. Published
  250. procedure TestAlterindexActive;
  251. procedure TestAlterindexInactive;
  252. procedure TestCreateIndexSimple;
  253. procedure TestIndexIndexDouble;
  254. procedure TestCreateIndexAscending;
  255. procedure TestCreateIndexDescending;
  256. procedure TestCreateIndexUnique;
  257. procedure TestCreateIndexUniqueAscending;
  258. procedure TestCreateIndexUniqueDescending;
  259. procedure TestIndexError1;
  260. procedure TestIndexError2;
  261. procedure TestIndexError3;
  262. procedure TestIndexError4;
  263. procedure TestIndexError5;
  264. procedure TestIndexError6;
  265. end;
  266. { TTestTableParser }
  267. TTestTableParser = Class(TTestSQLParser)
  268. private
  269. procedure DoTestCreateReferencesField(Const ASource : String; AOnUpdate,AOnDelete : TForeignKeyAction);
  270. Published
  271. procedure TestCreateOneSimpleField;
  272. procedure TestCreateTwoSimpleFields;
  273. procedure TestCreateOnePrimaryField;
  274. procedure TestCreateOneNamedPrimaryField;
  275. procedure TestCreateOneUniqueField;
  276. procedure TestCreateOneNamedUniqueField;
  277. procedure TestCreateNotNullPrimaryField;
  278. procedure TestCreateNotNullDefaultPrimaryField;
  279. procedure TestCreateComputedByField;
  280. procedure TestCreateCheckField;
  281. procedure TestCreateNamedCheckField;
  282. procedure TestCreateReferencesField;
  283. procedure TestCreateReferencesOnUpdateCascadeField;
  284. procedure TestCreateReferencesOnUpdateNoActionField;
  285. procedure TestCreateReferencesOnUpdateSetDefaultField;
  286. procedure TestCreateReferencesOnUpdateSetNullField;
  287. procedure TestCreateReferencesOnDeleteCascadeField;
  288. procedure TestCreateReferencesOnDeleteNoActionField;
  289. procedure TestCreateReferencesOnDeleteSetDefaultField;
  290. procedure TestCreateReferencesOnDeleteSetNullField;
  291. procedure TestCreateReferencesOnUpdateAndDeleteSetNullField;
  292. procedure TestCreateNamedReferencesField;
  293. procedure TestCreatePrimaryKeyConstraint;
  294. procedure TestCreateNamedPrimaryKeyConstraint;
  295. procedure TestCreateForeignKeyConstraint;
  296. procedure TestCreateNamedForeignKeyConstraint;
  297. procedure TestCreateUniqueConstraint;
  298. procedure TestCreateNamedUniqueConstraint;
  299. procedure TestCreateCheckConstraint;
  300. procedure TestCreateNamedCheckConstraint;
  301. procedure TestAlterDropField;
  302. procedure TestAlterDropFields;
  303. procedure TestAlterDropConstraint;
  304. procedure TestAlterDropConstraints;
  305. procedure TestAlterRenameField;
  306. procedure TestAlterRenameColumnField;
  307. procedure TestAlterFieldType;
  308. procedure TestAlterFieldPosition;
  309. procedure TestAlterAddField;
  310. procedure TestAlterAddFields;
  311. procedure TestAlterAddPrimarykey;
  312. procedure TestAlterAddNamedPrimarykey;
  313. procedure TestAlterAddCheckConstraint;
  314. procedure TestAlterAddNamedCheckConstraint;
  315. procedure TestAlterAddForeignkey;
  316. procedure TestAlterAddNamedForeignkey;
  317. end;
  318. { TTestDeleteParser }
  319. TTestDeleteParser = Class(TTestSQLParser)
  320. Private
  321. function TestDelete(Const ASource , ATable: String) : TSQLDeleteStatement;
  322. Published
  323. procedure TestSimpleDelete;
  324. procedure TestSimpleDeleteAlias;
  325. procedure TestDeleteWhereNull;
  326. end;
  327. { TTestUpdateParser }
  328. TTestUpdateParser = Class(TTestSQLParser)
  329. Private
  330. function TestUpdate(Const ASource , ATable: String) : TSQLUpdateStatement;
  331. Published
  332. procedure TestUpdateOneField;
  333. procedure TestUpdateOneFieldFull;
  334. procedure TestUpdateTwoFields;
  335. procedure TestUpdateOneFieldWhereIsNull;
  336. end;
  337. { TTestInsertParser }
  338. TTestInsertParser = Class(TTestSQLParser)
  339. Private
  340. function TestInsert(Const ASource , ATable: String) : TSQLInsertStatement;
  341. Published
  342. procedure TestInsertOneField;
  343. procedure TestInsertTwoFields;
  344. procedure TestInsertOneValue;
  345. procedure TestInsertTwoValues;
  346. end;
  347. { TTestSelectParser }
  348. TTestSelectParser = Class(TTestSQLParser)
  349. Private
  350. FSelect : TSQLSelectStatement;
  351. function TestSelect(Const ASource : String; AOptions : TParserOptions = []; AScannerOptions : TSQLScannerOptions = []) : TSQLSelectStatement;
  352. procedure TestSelectError(Const ASource : String);
  353. procedure DoExtractSimple(Expected : TSQLExtractElement);
  354. property Select : TSQLSelectStatement Read FSelect;
  355. Published
  356. procedure TestSelectOneFieldOneTable;
  357. procedure TestSelectOneFieldOneTableTransaction;
  358. procedure TestSelectOneArrayFieldOneTable;
  359. procedure TestSelectTwoFieldsOneTable;
  360. procedure TestSelectOneFieldAliasOneTable;
  361. procedure TestSelectTwoFieldAliasesOneTable;
  362. procedure TestSelectOneTableFieldOneTable;
  363. procedure TestSelectOneDistinctFieldOneTable;
  364. procedure TestSelectOneAllFieldOneTable;
  365. procedure TestSelectAsteriskOneTable;
  366. procedure TestSelectDistinctAsteriskOneTable;
  367. procedure TestSelectAsteriskWithPath;
  368. procedure TestSelectOneFieldOneTableAlias;
  369. procedure TestSelectOneFieldOneTableAsAlias;
  370. procedure TestSelectTwoFieldsTwoTables;
  371. procedure TestSelectTwoFieldsTwoTablesJoin;
  372. procedure TestSelectTwoFieldsTwoInnerTablesJoin;
  373. procedure TestSelectTwoFieldsTwoLeftTablesJoin;
  374. procedure TestSelectTwoFieldsTwoFullOuterTablesJoin;
  375. procedure TestSelectTwoFieldsTwoFullTablesJoin;
  376. procedure TestSelectTwoFieldsTwoRightTablesJoin;
  377. procedure TestSelectTwoFieldsThreeTablesJoin;
  378. procedure TestSelectTwoFieldsBracketThreeTablesJoin;
  379. procedure TestSelectTwoFieldsThreeBracketTablesJoin;
  380. procedure TestSelectTableWithSchema;
  381. procedure TestSelectFieldWithSchema;
  382. procedure TestSelectFieldAsStringLiteral;
  383. procedure TestSelectFirst;
  384. procedure TestSelectFirstSkip;
  385. procedure TestSelectTop;
  386. procedure TestSelectLimit;
  387. procedure TestSelectLimitAll;
  388. procedure TestSelectLimitAllOffset;
  389. procedure TestSelectLimitOffset1;
  390. procedure TestSelectLimitOffset2;
  391. procedure TestSelectOffset;
  392. procedure TestAggregateCount;
  393. procedure TestAggregateCountAsterisk;
  394. procedure TestAggregateCountAll;
  395. procedure TestAggregateCountDistinct;
  396. procedure TestAggregateMax;
  397. procedure TestAggregateMaxAll;
  398. procedure TestAggregateMaxAsterisk;
  399. procedure TestAggregateMaxDistinct;
  400. procedure TestAggregateMin;
  401. procedure TestAggregateMinAll;
  402. procedure TestAggregateMinAsterisk;
  403. procedure TestAggregateMinDistinct;
  404. procedure TestAggregateSum;
  405. procedure TestAggregateSumAll;
  406. procedure TestAggregateSumAsterisk;
  407. procedure TestAggregateSumDistinct;
  408. procedure TestAggregateAvg;
  409. procedure TestAggregateAvgAll;
  410. procedure TestAggregateAvgAsterisk;
  411. procedure TestAggregateAvgDistinct;
  412. procedure TestUpperConst;
  413. procedure TestUpperError;
  414. procedure TestLeft;
  415. procedure TestFunctionWithPath;
  416. procedure TestGenID;
  417. procedure TestGenIDError1;
  418. procedure TestGenIDError2;
  419. procedure TestCastSimple;
  420. procedure TestExtractSimple;
  421. procedure TestOrderByOneField;
  422. procedure TestOrderByTwoFields;
  423. procedure TestOrderByThreeFields;
  424. procedure TestOrderByOneDescField;
  425. procedure TestOrderByTwoDescFields;
  426. procedure TestOrderByThreeDescFields;
  427. procedure TestOrderByOneTableField;
  428. procedure TestOrderByOneColumn;
  429. procedure TestOrderByTwoColumns;
  430. procedure TestOrderByTwoColumnsDesc;
  431. procedure TestOrderByCollate;
  432. procedure TestOrderByCollateDesc;
  433. procedure TestOrderByCollateDescTwoFields;
  434. procedure TestGroupByOne;
  435. procedure TestGroupByTwo;
  436. procedure TestHavingOne;
  437. procedure TestUnionSimple;
  438. procedure TestUnionSimpleAll;
  439. procedure TestUnionSimpleOrderBy;
  440. procedure TestUnionDouble;
  441. procedure TestUnionError1;
  442. procedure TestUnionError2;
  443. procedure TestPlanOrderNatural;
  444. procedure TestPlanOrderOrder;
  445. procedure TestPlanOrderIndex1;
  446. procedure TestPlanOrderIndex2;
  447. procedure TestPlanJoinNatural;
  448. procedure TestPlanDefaultNatural;
  449. procedure TestPlanMergeNatural;
  450. procedure TestPlanMergeNested;
  451. procedure TestSubSelect;
  452. procedure TestWhereExists;
  453. procedure TestWhereSingular;
  454. procedure TestWhereAll;
  455. procedure TestWhereAny;
  456. procedure TestWhereSome;
  457. procedure TestParam;
  458. procedure TestParamExpr;
  459. procedure TestNoTable;
  460. procedure TestSourcePosition;
  461. end;
  462. { TTestRollBackParser }
  463. TTestRollBackParser = Class(TTestSQLParser)
  464. Private
  465. FRollback : TSQLRollbackStatement;
  466. function TestRollback(Const ASource : String) : TSQLRollbackStatement;
  467. procedure TestRollbackError(Const ASource : String);
  468. property Rollback : TSQLRollbackStatement Read FRollback;
  469. Published
  470. procedure TestRollback;
  471. procedure TestRollbackWork;
  472. procedure TestRollbackRelease;
  473. procedure TestRollbackWorkRelease;
  474. procedure TestRollbackTransaction;
  475. procedure TestRollbackTransactionWork;
  476. procedure TestRollbackTransactionRelease;
  477. procedure TestRollbackTransactionWorkRelease;
  478. end;
  479. { TTestCommitParser }
  480. TTestCommitParser = Class(TTestSQLParser)
  481. Private
  482. FCommit : TSQLCommitStatement;
  483. function TestCommit(Const ASource : String) : TSQLCommitStatement;
  484. procedure TestCommitError(Const ASource : String);
  485. property Commit : TSQLCommitStatement Read FCommit;
  486. Published
  487. procedure TestCommit;
  488. procedure TestCommitWork;
  489. procedure TestCommitRelease;
  490. procedure TestCommitWorkRelease;
  491. procedure TestCommitTransaction;
  492. procedure TestCommitTransactionWork;
  493. procedure TestCommitTransactionRelease;
  494. procedure TestCommitTransactionWorkRelease;
  495. procedure TestCommitRetain;
  496. procedure TestCommitWorkRetain;
  497. procedure TestCommitReleaseRetain;
  498. procedure TestCommitWorkReleaseRetain;
  499. procedure TestCommitTransactionRetain;
  500. procedure TestCommitTransactionWorkRetain;
  501. procedure TestCommitTransactionReleaseRetain;
  502. procedure TestCommitTransactionWorkReleaseRetain;
  503. procedure TestCommitRetainSnapShot;
  504. end;
  505. { TTestExecuteProcedureParser }
  506. TTestExecuteProcedureParser = Class(TTestSQLParser)
  507. Private
  508. FExecute : TSQLExecuteProcedureStatement;
  509. function TestExecute(Const ASource : String) : TSQLExecuteProcedureStatement;
  510. procedure TestExecuteError(Const ASource : String);
  511. property Execute: TSQLExecuteProcedureStatement Read FExecute;
  512. Published
  513. procedure TestExecuteSimple;
  514. procedure TestExecuteSimpleTransaction;
  515. procedure TestExecuteSimpleReturningValues;
  516. procedure TestExecuteSimpleReturning2Values;
  517. procedure TestExecuteOneArg;
  518. procedure TestExecuteOneArgNB;
  519. procedure TestExecuteTwoArgs;
  520. procedure TestExecuteTwoArgsNB;
  521. procedure TestExecuteOneArgSelect;
  522. procedure TestExecuteOneArgSelectNB;
  523. procedure TestExecuteTwoArgsSelect;
  524. procedure TestExecuteTwoArgsSelectNB;
  525. procedure TestExecuteOneArgSelectErr;
  526. procedure TestExecuteOneArgSelectErr2;
  527. procedure TestExecuteOneArgSelectErr3;
  528. procedure TestExecuteOneArgSelectErr4;
  529. end;
  530. { TTestConnectParser }
  531. TTestConnectParser = Class(TTestSQLParser)
  532. Private
  533. FConnect : TSQLConnectStatement;
  534. function TestConnect(Const ASource : String) : TSQLConnectStatement;
  535. procedure TestConnectError(Const ASource : String);
  536. property Connect: TSQLConnectStatement Read FConnect;
  537. Published
  538. procedure TestConnectSimple;
  539. procedure TestConnectUser;
  540. procedure TestConnectPassword;
  541. procedure TestConnectUserPassword;
  542. procedure TestConnectUserPasswordRole;
  543. procedure TestConnectUserPasswordRoleCache;
  544. procedure TestConnectSimpleCache;
  545. end;
  546. { TTestCreateDatabaseParser }
  547. TTestCreateDatabaseParser = Class(TTestSQLParser)
  548. Private
  549. FCreateDB : TSQLCreateDatabaseStatement;
  550. function TestCreate(Const ASource : String) : TSQLCreateDatabaseStatement;
  551. procedure TestCreateError(Const ASource : String);
  552. property CreateDB : TSQLCreateDatabaseStatement Read FCreateDB;
  553. published
  554. procedure TestSimple;
  555. procedure TestSimpleSchema;
  556. procedure TestSimpleUSer;
  557. procedure TestSimpleUSerPassword;
  558. procedure TestSimplePassword;
  559. procedure TestPageSize;
  560. procedure TestPageSize2;
  561. procedure TestPageSizeLength;
  562. procedure TestPageSizeLength2;
  563. procedure TestPageSizeLength3;
  564. procedure TestPageSizeLength4;
  565. procedure TestCharset;
  566. procedure TestSecondaryFile1;
  567. procedure TestSecondaryFile2;
  568. procedure TestSecondaryFile3;
  569. procedure TestSecondaryFile4;
  570. procedure TestSecondaryFile5;
  571. procedure TestSecondaryFile6;
  572. procedure TestSecondaryFile7;
  573. procedure TestSecondaryFile8;
  574. procedure TestSecondaryFile9;
  575. procedure TestSecondaryFile10;
  576. procedure TestSecondaryFileS;
  577. procedure TestSecondaryFileError1;
  578. procedure TestSecondaryFileError2;
  579. procedure TestSecondaryFileError3;
  580. end;
  581. { TTestAlterDatabaseParser }
  582. TTestAlterDatabaseParser = Class(TTestSQLParser)
  583. Private
  584. FAlterDB : TSQLAlterDatabaseStatement;
  585. function TestAlter(Const ASource : String) : TSQLAlterDatabaseStatement;
  586. procedure TestAlterError(Const ASource : String);
  587. property AlterDB : TSQLAlterDatabaseStatement Read FAlterDB;
  588. published
  589. procedure TestSimple;
  590. procedure TestLength;
  591. procedure TestStarting;
  592. procedure TestStartingLength;
  593. procedure TestFiles;
  594. procedure TestFiles2;
  595. procedure TestError;
  596. procedure TestFilesError;
  597. end;
  598. { TTestCreateViewParser }
  599. TTestCreateViewParser = Class(TTestSQLParser)
  600. Private
  601. FView : TSQLCreateViewStatement;
  602. function TestCreate(Const ASource : String) : TSQLCreateViewStatement;
  603. procedure TestCreateError(Const ASource : String);
  604. property View : TSQLCreateViewStatement Read FView;
  605. Published
  606. procedure TestSimple;
  607. procedure TestFieldList;
  608. procedure TestFieldList2;
  609. procedure TestSimpleWithCheckoption;
  610. end;
  611. { TTestCreateShadowParser }
  612. TTestCreateShadowParser = Class(TTestSQLParser)
  613. Private
  614. FShadow : TSQLCreateShadowStatement;
  615. function TestCreate(Const ASource : String) : TSQLCreateShadowStatement;
  616. procedure TestCreateError(Const ASource : String);
  617. property Shadow : TSQLCreateShadowStatement Read FShadow;
  618. published
  619. procedure TestSimple;
  620. procedure TestLength;
  621. procedure TestLength2;
  622. procedure TestLength3;
  623. procedure TestLength4;
  624. procedure TestSecondaryFile1;
  625. procedure TestSecondaryFile2;
  626. procedure TestSecondaryFile3;
  627. procedure TestSecondaryFile4;
  628. procedure TestSecondaryFile5;
  629. procedure TestSecondaryFile6;
  630. procedure TestSecondaryFile7;
  631. procedure TestSecondaryFile8;
  632. procedure TestSecondaryFileS;
  633. end;
  634. { TTestProcedureStatement }
  635. TTestProcedureStatement = Class(TTestSQLParser)
  636. Private
  637. FStatement : TSQLStatement;
  638. procedure TestParseStatementError;
  639. function TestStatement(Const ASource : String) : TSQLStatement;
  640. procedure TestStatementError(Const ASource : String);
  641. Public
  642. property Statement : TSQLStatement Read FStatement;
  643. Published
  644. procedure TestException;
  645. procedure TestExceptionError;
  646. procedure TestExit;
  647. procedure TestSuspend;
  648. procedure TestEmptyBlock;
  649. procedure TestExitBlock;
  650. procedure TestExitBlockError;
  651. procedure TestPostEvent;
  652. procedure TestPostEventColName;
  653. procedure TestPostError;
  654. procedure TestAssignSimple;
  655. procedure TestAssignSimpleNew;
  656. procedure TestAssignSelect;
  657. procedure TestBlockAssignSimple;
  658. procedure TestIf;
  659. procedure TestIfBlock;
  660. procedure TestIfElse;
  661. procedure TestIfBlockElse;
  662. procedure TestIfElseError;
  663. procedure TestIfBlockElseBlock;
  664. procedure TestIfErrorBracketLeft;
  665. procedure TestIfErrorBracketRight;
  666. procedure TestIfErrorNoThen;
  667. procedure TestIfErrorSemicolonElse;
  668. procedure TestWhile;
  669. procedure TestWhileBlock;
  670. procedure TestWhileErrorBracketLeft;
  671. procedure TestWhileErrorBracketRight;
  672. procedure TestWhileErrorNoDo;
  673. procedure TestWhenAny;
  674. procedure TestWhenSQLCode;
  675. procedure TestWhenGDSCode;
  676. procedure TestWhenException;
  677. procedure TestWhenExceptionGDS;
  678. procedure TestWhenAnyBlock;
  679. procedure TestWhenErrorAny;
  680. procedure TestWhenErrorNoDo;
  681. procedure TestWhenErrorExceptionInt;
  682. procedure TestWhenErrorExceptionString;
  683. procedure TestWhenErrorSqlCode;
  684. procedure TestWhenErrorGDSCode;
  685. procedure TestExecuteStatement;
  686. procedure TestExecuteStatementReturningValues;
  687. procedure TestExecuteStatementReturningValuesColon;
  688. procedure TestExecuteStatementReturningValuesBrackets;
  689. procedure TestForSimple;
  690. procedure TestForSimpleNoColon;
  691. procedure TestForSimple2fields;
  692. procedure TestForBlock;
  693. end;
  694. { TTestCreateProcedureParser }
  695. TTestCreateProcedureParser = Class(TTestSQLParser)
  696. Private
  697. FStatement : TSQLCreateProcedureStatement;
  698. function TestCreate(Const ASource : String) : TSQLCreateProcedureStatement;
  699. procedure TestCreateError(Const ASource : String);
  700. property Statement : TSQLCreateProcedureStatement Read FStatement;
  701. Published
  702. procedure TestEmptyProcedure;
  703. procedure TestExitProcedure;
  704. procedure TestProcedureOneArgument;
  705. procedure TestProcedureTwoArguments;
  706. procedure TestProcedureOneReturnValue;
  707. procedure TestProcedureTwoReturnValues;
  708. procedure TestProcedureOneLocalVariable;
  709. procedure TestProcedureTwoLocalVariable;
  710. procedure TestProcedureInputOutputLocal;
  711. end;
  712. { TTestCreateTriggerParser }
  713. TTestCreateTriggerParser = Class(TTestSQLParser)
  714. Private
  715. FStatement : TSQLAlterCreateTriggerStatement;
  716. function TestCreate(Const ASource : String) : TSQLCreateTriggerStatement;
  717. function TestAlter(Const ASource : String) : TSQLAlterTriggerStatement;
  718. procedure TestCreateError(Const ASource : String);
  719. property Statement : TSQLAlterCreateTriggerStatement Read FStatement;
  720. Published
  721. procedure TestEmptyTrigger;
  722. procedure TestExitTrigger;
  723. procedure TestEmptyTriggerAfterUpdate;
  724. procedure TestEmptyTriggerBeforeDelete;
  725. procedure TestEmptyTriggerBeforeInsert;
  726. procedure TestEmptyTriggerBeforeInsertPosition1;
  727. procedure TestEmptyTriggerBeforeInsertPosition1inActive;
  728. procedure TestEmptyTriggerBeforeInsertPosition1Active;
  729. procedure TestTriggerOneLocalVariable;
  730. procedure TestTriggerTwoLocalVariables;
  731. procedure TestAlterTrigger;
  732. end;
  733. { TTestDeclareExternalFunctionParser }
  734. TTestDeclareExternalFunctionParser = Class(TTestSQLParser)
  735. Private
  736. FStatement : TSQLDeclareExternalFunctionStatement;
  737. function TestCreate(Const ASource : String) : TSQLDeclareExternalFunctionStatement;
  738. procedure TestCreateError(Const ASource : String);
  739. property Statement : TSQLDeclareExternalFunctionStatement Read FStatement;
  740. Published
  741. procedure TestEmptyfunction;
  742. procedure TestEmptyfunctionByValue;
  743. procedure TestCStringfunction;
  744. procedure TestCStringFreeItfunction;
  745. procedure TestOneArgumentFunction;
  746. procedure TestTwoArgumentsFunction;
  747. end;
  748. { TTestGrantParser }
  749. TTestGrantParser = Class(TTestSQLParser)
  750. Private
  751. FStatement : TSQLGrantStatement;
  752. function TestGrant(Const ASource : String) : TSQLGrantStatement;
  753. procedure TestGrantError(Const ASource : String);
  754. property Statement : TSQLGrantStatement Read FStatement;
  755. Published
  756. procedure TestSimple;
  757. procedure Test2Operations;
  758. procedure TestDeletePrivilege;
  759. procedure TestUpdatePrivilege;
  760. procedure TestInsertPrivilege;
  761. procedure TestReferencePrivilege;
  762. procedure TestAllPrivileges;
  763. procedure TestAllPrivileges2;
  764. procedure TestUpdateColPrivilege;
  765. procedure TestUpdate2ColsPrivilege;
  766. procedure TestReferenceColPrivilege;
  767. procedure TestReference2ColsPrivilege;
  768. procedure TestUserPrivilege;
  769. procedure TestUserPrivilegeWithGrant;
  770. procedure TestGroupPrivilege;
  771. procedure TestProcedurePrivilege;
  772. procedure TestViewPrivilege;
  773. procedure TestTriggerPrivilege;
  774. procedure TestPublicPrivilege;
  775. procedure TestExecuteToUser;
  776. procedure TestExecuteToProcedure;
  777. procedure TestRoleToUser;
  778. procedure TestRoleToUserWithAdmin;
  779. procedure TestRoleToPublic;
  780. procedure Test2RolesToUser;
  781. end;
  782. { TTestRevokeParser }
  783. TTestRevokeParser = Class(TTestSQLParser)
  784. Private
  785. FStatement : TSQLRevokeStatement;
  786. function TestRevoke(Const ASource : String) : TSQLRevokeStatement;
  787. procedure TestRevokeError(Const ASource : String);
  788. property Statement : TSQLRevokeStatement Read FStatement;
  789. Published
  790. procedure TestSimple;
  791. procedure Test2Operations;
  792. procedure TestDeletePrivilege;
  793. procedure TestUpdatePrivilege;
  794. procedure TestInsertPrivilege;
  795. procedure TestReferencePrivilege;
  796. procedure TestAllPrivileges;
  797. procedure TestAllPrivileges2;
  798. procedure TestUpdateColPrivilege;
  799. procedure TestUpdate2ColsPrivilege;
  800. procedure TestReferenceColPrivilege;
  801. procedure TestReference2ColsPrivilege;
  802. procedure TestUserPrivilege;
  803. procedure TestUserPrivilegeWithRevoke;
  804. procedure TestGroupPrivilege;
  805. procedure TestProcedurePrivilege;
  806. procedure TestViewPrivilege;
  807. procedure TestTriggerPrivilege;
  808. procedure TestPublicPrivilege;
  809. procedure TestExecuteToUser;
  810. procedure TestExecuteToProcedure;
  811. procedure TestRoleToUser;
  812. procedure TestRoleToPublic;
  813. procedure Test2RolesToUser;
  814. end;
  815. { TTestGlobalParser }
  816. TTestGlobalParser = Class(TTestSQLParser)
  817. published
  818. procedure TestEmpty;
  819. end;
  820. implementation
  821. uses typinfo;
  822. { TTestSetTermParser }
  823. procedure TTestSetTermParser.TestSetTermNoOption;
  824. begin
  825. FErrSource:='SET TERM ^ ;';
  826. AssertException(ESQLParser,@TestParseError);
  827. end;
  828. procedure TTestSetTermParser.TestSetTermOption;
  829. begin
  830. CreateParser('SET TERM ^ ;');
  831. FToFree:=Parser.Parse([poAllowSetTerm]);
  832. AssertEquals('Terminator set','^',Parser.Scanner.AlternateTerminator);
  833. end;
  834. { TTestGlobalParser }
  835. procedure TTestGlobalParser.TestEmpty;
  836. begin
  837. CreateParser('');
  838. AssertNull('Empty statement returns nil',Parser.Parse);
  839. end;
  840. { --------------------------------------------------------------------
  841. TTestParser
  842. --------------------------------------------------------------------}
  843. procedure TTestParser.ParseStringDef(Out DT: TSQLDataType; Out Len: Integer; Out ACharset : TSQLStringtype);
  844. begin
  845. ParseCharTypeDefinition(DT,Len,ACharset);
  846. end;
  847. function TTestParser.ParseType(Flags: TParseTypeFlags): TSQLTypeDefinition;
  848. begin
  849. Result:=ParseTypeDefinition(Nil,Flags);
  850. end;
  851. function TTestParser.ParseConstraint: TSQLExpression;
  852. begin
  853. // GetNextToken;
  854. Result:=ParseCheckConstraint(Nil);
  855. end;
  856. function TTestParser.ParseProcedureStatements: TSQLStatement;
  857. begin
  858. Result:=Self.ParseProcedureStatement(Nil);
  859. end;
  860. { --------------------------------------------------------------------
  861. TTestSQLParser
  862. --------------------------------------------------------------------}
  863. procedure TTestSQLParser.SetUp;
  864. begin
  865. // nothing yet
  866. end;
  867. procedure TTestSQLParser.TearDown;
  868. begin
  869. FreeAndNil(FParser);
  870. FreeAndNil(FSource);
  871. FreeAndNil(FToFree);
  872. end;
  873. procedure TTestSQLParser.CreateParser(const ASource: string; aOptions: TParserOptions = []);
  874. begin
  875. FSource:=TStringStream.Create(ASource);
  876. FParserOptions:=aOptions;
  877. FParser:=TTestParser.Create(FSource);
  878. end;
  879. Function TTestSQLParser.CheckClass(E: TSQLElement; C: TSQLElementClass) : TSQLElement;
  880. begin
  881. AssertEquals(C,E.ClassType);
  882. Result:=E;
  883. end;
  884. procedure TTestSQLParser.AssertEquals(const AMessage: String; Expected, Actual: TSQLToken);
  885. Var
  886. NE,NA : String;
  887. begin
  888. NE:=GetEnumName(TypeInfo(TSQLToken),Ord(Expected));
  889. NA:=GetEnumName(TypeInfo(TSQLToken),Ord(Actual));
  890. AssertEquals(AMessage,NE,NA);
  891. end;
  892. procedure TTestSQLParser.AssertEquals(const AMessage: String; Expected,
  893. Actual: TSQLBinaryOperation);
  894. Var
  895. NE,NA : String;
  896. begin
  897. NE:=GetEnumName(TypeInfo(TSQLBinaryOperation),Ord(Expected));
  898. NA:=GetEnumName(TypeInfo(TSQLBinaryOperation),Ord(Actual));
  899. AssertEquals(AMessage,NE,NA);
  900. end;
  901. procedure TTestSQLParser.AssertEquals(const AMessage: String; Expected,
  902. Actual: TSQLUnaryoperation);
  903. Var
  904. NE,NA : String;
  905. begin
  906. NE:=GetEnumName(TypeInfo(TSQLUnaryOperation),Ord(Expected));
  907. NA:=GetEnumName(TypeInfo(TSQLUnaryOperation),Ord(Actual));
  908. AssertEquals(AMessage,NE,NA);
  909. end;
  910. procedure TTestSQLParser.AssertEquals(const AMessage: String; Expected,
  911. Actual: TSQLternaryoperation);
  912. Var
  913. NE,NA : String;
  914. begin
  915. NE:=GetEnumName(TypeInfo(TSQLTernaryOperation),Ord(Expected));
  916. NA:=GetEnumName(TypeInfo(TSQLTernaryOperation),Ord(Actual));
  917. AssertEquals(AMessage,NE,NA);
  918. end;
  919. procedure TTestSQLParser.AssertEquals(const AMessage: String; Expected, Actual: TSQLDataType);
  920. Var
  921. NE,NA : String;
  922. begin
  923. NE:=GetEnumName(TypeInfo(TSQLDataType),Ord(Expected));
  924. NA:=GetEnumName(TypeInfo(TSQLDataType),Ord(Actual));
  925. AssertEquals(AMessage,NE,NA);
  926. end;
  927. procedure TTestSQLParser.AssertEquals(const AMessage: String; Expected,
  928. Actual: TForeignKeyAction);
  929. Var
  930. NE,NA : String;
  931. begin
  932. NE:=GetEnumName(TypeInfo(TForeignKeyAction),Ord(Expected));
  933. NA:=GetEnumName(TypeInfo(TForeignKeyAction),Ord(Actual));
  934. AssertEquals(AMessage,NE,NA);
  935. end;
  936. procedure TTestSQLParser.AssertEquals(const AMessage: String; Expected,
  937. Actual: TSQLJoinType);
  938. Var
  939. NE,NA : String;
  940. begin
  941. NE:=GetEnumName(TypeInfo(TSQLJoinType),Ord(Expected));
  942. NA:=GetEnumName(TypeInfo(TSQLJoinType),Ord(Actual));
  943. AssertEquals(AMessage,NE,NA);
  944. end;
  945. procedure TTestSQLParser.AssertEquals(const AMessage: String; Expected,
  946. Actual: TSQLAggregateFunction);
  947. Var
  948. NE,NA : String;
  949. begin
  950. NE:=GetEnumName(TypeInfo(TSQLAggregateFunction),Ord(Expected));
  951. NA:=GetEnumName(TypeInfo(TSQLAggregateFunction),Ord(Actual));
  952. AssertEquals(AMessage,NE,NA);
  953. end;
  954. procedure TTestSQLParser.AssertEquals(const AMessage: String; Expected,
  955. Actual: TSQLAggregateOption);
  956. Var
  957. NE,NA : String;
  958. begin
  959. NE:=GetEnumName(TypeInfo(TSQLAggregateOption),Ord(Expected));
  960. NA:=GetEnumName(TypeInfo(TSQLAggregateOption),Ord(Actual));
  961. AssertEquals(AMessage,NE,NA);
  962. end;
  963. procedure TTestSQLParser.AssertEquals(const AMessage: String; Expected,
  964. Actual: TSQLOrderDirection);
  965. Var
  966. NE,NA : String;
  967. begin
  968. NE:=GetEnumName(TypeInfo(TSQLOrderDirection),Ord(Expected));
  969. NA:=GetEnumName(TypeInfo(TSQLOrderDirection),Ord(Actual));
  970. AssertEquals(AMessage,NE,NA);
  971. end;
  972. procedure TTestSQLParser.AssertEquals(const AMessage: String; Expected,
  973. Actual: TPlanJoinType);
  974. Var
  975. NE,NA : String;
  976. begin
  977. NE:=GetEnumName(TypeInfo(TPlanJoinType),Ord(Expected));
  978. NA:=GetEnumName(TypeInfo(TPlanJoinType),Ord(Actual));
  979. AssertEquals(AMessage,NE,NA);
  980. end;
  981. procedure TTestSQLParser.AssertEquals(const AMessage: String; Expected,
  982. Actual: TTriggerMoment);
  983. Var
  984. NE,NA : String;
  985. begin
  986. NE:=GetEnumName(TypeInfo(TTriggerMoment),Ord(Expected));
  987. NA:=GetEnumName(TypeInfo(TTriggerMoment),Ord(Actual));
  988. AssertEquals(AMessage,NE,NA);
  989. end;
  990. procedure TTestSQLParser.AssertEquals(const AMessage: String; Expected,
  991. Actual: TTriggerState);
  992. Var
  993. NE,NA : String;
  994. begin
  995. NE:=GetEnumName(TypeInfo(TTriggerState),Ord(Expected));
  996. NA:=GetEnumName(TypeInfo(TTriggerState),Ord(Actual));
  997. AssertEquals(AMessage,NE,NA);
  998. end;
  999. procedure TTestSQLParser.AssertEquals(const AMessage: String; Expected,
  1000. Actual: TTriggerOperations);
  1001. begin
  1002. If Expected<>Actual then
  1003. Fail(Amessage)
  1004. end;
  1005. Function TTestSQLParser.AssertLiteralExpr(const AMessage: String;
  1006. Element: TSQLExpression; ALiteralClass: TSQLElementClass) : TSQLLiteral;
  1007. begin
  1008. CheckClass(Element,TSQLLiteralExpression);
  1009. Result:=TSQLLiteral(Checkclass(TSQLLiteralExpression(Element).Literal,ALiteralClass));
  1010. end;
  1011. procedure TTestSQLParser.AssertIdentifierName(const AMessage : String;
  1012. const AExpected: String; Element: TSQLElement);
  1013. begin
  1014. AssertNotNull(AMessage+': Have identifier ',Element);
  1015. CheckClass(Element,TSQLidentifierName);
  1016. AssertEquals(AMessage+': Correct identifier name',AExpected,TSQLidentifierName(Element).Name);
  1017. end;
  1018. procedure TTestSQLParser.AssertField(AField: TSQLElement; const AName: String;
  1019. const AAlias: String);
  1020. Var
  1021. F : TSQLSelectField;
  1022. E : TSQLidentifierExpression;
  1023. begin
  1024. AssertNotNull('Have field',AField);
  1025. F:=TSQLSelectField(CheckClass(AField,TSQLSelectField));
  1026. AssertNotNull('Have field expresssion,',F.Expression);
  1027. E:=TSQLidentifierExpression(CheckClass(F.Expression,TSQLidentifierExpression));
  1028. AssertIdentifierName('Correct field name',AName,E.Identifier);
  1029. If (AAlias<>'') then
  1030. AssertIdentifierName('Correct alias',AALias,F.AliasName);
  1031. end;
  1032. procedure TTestSQLParser.AssertAggregate(AField: TSQLElement;
  1033. AAgregate: TSQLAggregateFunction; const AFieldName: String;
  1034. AOption: TSQLAggregateOption; const AAlias: String);
  1035. Var
  1036. F : TSQLSelectField;
  1037. begin
  1038. AssertNotNull('Have field',AField);
  1039. F:=TSQLSelectField(CheckClass(AField,TSQLSelectField));
  1040. AssertNotNull('Have field expresssion,',F.Expression);
  1041. AssertAggregateExpression(F.Expression,AAgregate,AFieldName,AOption);
  1042. If (AAlias<>'') then
  1043. AssertIdentifierName('Correct alias',AALias,F.AliasName);
  1044. end;
  1045. procedure TTestSQLParser.AssertAggregateExpression(E: TSQLElement;
  1046. AAgregate: TSQLAggregateFunction; const AFieldName: String;
  1047. AOption: TSQLAggregateOption);
  1048. Var
  1049. AF : TSQLAggregateFunctionExpression;
  1050. I : TSQLIdentifierExpression;
  1051. begin
  1052. AF:=TSQLAggregateFunctionExpression(CheckClass(E,TSQLAggregateFunctionExpression));
  1053. AssertEquals('Correct function',AAgregate,AF.Aggregate);
  1054. AssertEquals('Correct function',AOption,AF.Option);
  1055. If (AFieldName<>'') then
  1056. begin
  1057. I:=TSQLIdentifierExpression(CheckClass(AF.Expression, TSQLIdentifierExpression));
  1058. AssertIdentifierName('Correct field name',AFieldName,I.Identifier);
  1059. end;
  1060. end;
  1061. procedure TTestSQLParser.AssertTable(ATable: TSQLElement; const AName: String;
  1062. const AAlias: String);
  1063. Var
  1064. T : TSQLSimpleTablereference;
  1065. begin
  1066. AssertNotNull('Have table',ATable);
  1067. T:=TSQLSimpleTablereference(CheckClass(ATable,TSQLSimpleTablereference));
  1068. AssertIdentifierName('Correct table name',AName,T.ObjectName);
  1069. If (AAlias<>'') then
  1070. AssertIdentifierName('Correct alias',AALias,T.AliasName);
  1071. end;
  1072. function TTestSQLParser.AssertJoin(AJoin: TSQLElement; const AFirst,
  1073. ASecond: String; const ajointype: TSQLJoinType):TSQLJoinTableReference;
  1074. Var
  1075. J : TSQLJoinTableReference;
  1076. begin
  1077. AssertNotNull('Have join',AJoin);
  1078. J:=TSQLJoinTableReference(CheckClass(AJoin,TSQLJoinTableReference));
  1079. if (AFirst<>'') then
  1080. AssertTable(J.Left,AFirst,'');
  1081. if (ASecond<>'') then
  1082. AssertTable(J.Right,ASecond,'');
  1083. AssertEquals('Correct join type',AJoinType,J.JoinType);
  1084. Result:=J;
  1085. end;
  1086. function TTestSQLParser.AssertJoinOn(AJoin: TSQLExpression; const AFirst,
  1087. ASecond: String; const AOperation: TSQLBinaryOperation): TSQLBinaryExpression;
  1088. Var
  1089. I : TSQLIdentifierExpression;
  1090. begin
  1091. Result:=TSQLBinaryExpression(CheckClass(AJoin,TSQLBinaryExpression));
  1092. AssertEquals('Correct ON operation',AOperation,Result.Operation);
  1093. I:=TSQLIdentifierExpression(CheckClass(Result.Left,TSQLIdentifierExpression));
  1094. AssertIdentifierName('Left field name',AFirst,I.Identifier);
  1095. I:=TSQLIdentifierExpression(CheckClass(Result.Right,TSQLIdentifierExpression));
  1096. AssertIdentifierName('Right field name',ASecond,I.Identifier);
  1097. end;
  1098. function TTestSQLParser.AssertOrderBy(AOrderBy: TSQLElement;
  1099. const AField: String; const ANumber: Integer; const AOrdering: TSQLOrderDirection
  1100. ): TSQLOrderByElement;
  1101. Var
  1102. I : TSQLIntegerLiteral;
  1103. begin
  1104. Result:=TSQLOrderByElement(CheckClass(AorderBy,TSQLOrderByElement));
  1105. If (AField<>'') then
  1106. AssertIdentifierName('Correct order by field',AField,Result.Field)
  1107. else if (ANumber>0) then
  1108. begin
  1109. I:=TSQLIntegerLiteral(CheckClass(Result.Field,TSQLIntegerLiteral));
  1110. AssertEquals('Correct order by column number',ANumber,I.Value);
  1111. end;
  1112. AssertEquals('Correct ordering',AOrdering,Result.OrderBy);
  1113. end;
  1114. function TTestSQLParser.AssertSecondaryFile(ASecondaryFile: TSQLElement;
  1115. const AFile: String; const ALength, AStart: Integer): TSQLDatabaseFileInfo;
  1116. begin
  1117. Result:=TSQLDatabaseFileInfo(CheckClass(ASecondaryFile,TSQLDatabaseFileInfo));
  1118. AssertEquals('Secondary file name',AFile,Result.FileName);
  1119. AssertEquals('Secondary file length',ALength,Result.Length);
  1120. AssertEquals('Secondary file start',AStart,Result.StartPage);
  1121. end;
  1122. procedure TTestSQLParser.TestTypeError;
  1123. begin
  1124. TestType(FErrSource,[],sdtInteger);
  1125. end;
  1126. procedure TTestSQLParser.TestStringError;
  1127. begin
  1128. TestStringDef(FErrSource,sdtchar,0);
  1129. end;
  1130. procedure TTestSQLParser.TestCheckError;
  1131. begin
  1132. TestCheck(FErrSource,TSQLExpression);
  1133. end;
  1134. procedure TTestSQLParser.TestParseError;
  1135. begin
  1136. CreateParser(FErrSource);
  1137. FToFree:=Parser.Parse;
  1138. end;
  1139. procedure TTestSQLParser.TestStringDef(ASource : String; ExpectDT : TSQLDataType; ExpectLen : Integer; ExpectCharset : TSQLStringType='');
  1140. Var
  1141. Dt : TSQLDataType;
  1142. L : integer;
  1143. cs : TSQLStringType;
  1144. begin
  1145. CreateParser(ASOURCE);
  1146. Parser.GetNextToken;
  1147. Parser.ParseStringDef(dt,l,cs);
  1148. AssertEquals('Datatype is Char',ExpectDT,Dt);
  1149. AssertEquals('Length is 1',ExpectLen,l);
  1150. AssertEquals('End of Stream reached',tsqlEOF,Parser.CurrentToken);
  1151. AssertEquals('Correct character set',ExpectCharset,CS);
  1152. end;
  1153. Function TTestSQLParser.TestType(ASource : string; AFlags : TParseTypeFlags; AExpectedType : TSQLDataType) : TSQLTypeDefinition;
  1154. begin
  1155. CreateParser(ASource);
  1156. FToFree:=Parser.ParseType(AFlags);
  1157. AssertNotNull('ParseType returns result',FToFree);
  1158. CheckClass(FTofree,TSQLTypeDefinition);
  1159. Result:=TSQLTypeDefinition(FToFree);
  1160. AssertEquals('Type definition has correct data type',AExpectedType,Result.Datatype);
  1161. end;
  1162. function TTestSQLParser.TestCheck(ASource: string; AExpectedConstraint: TSQLElementClass
  1163. ): TSQLExpression;
  1164. begin
  1165. CreateParser('('+ASource+')');
  1166. FToFree:=Parser.ParseConstraint();
  1167. AssertNotNull('ParseType returns result',FToFree);
  1168. CheckClass(FTofree,AExpectedConstraint);
  1169. Result:=TSQLExpression(FToFree);
  1170. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  1171. end;
  1172. function TTestSQLParser.GetParserOptions: TParserOptions;
  1173. begin
  1174. if Assigned(FParser) then
  1175. Result:=FParser.Options
  1176. else
  1177. Result:=FParserOptions;
  1178. end;
  1179. procedure TTestSQLParser.AssertTypeDefaults(TD : TSQLTypeDefinition;Len : Integer = 0);
  1180. begin
  1181. AssertNull(TD.DefaultValue);
  1182. AssertNull(TD.Check);
  1183. AssertNull(TD.Collation);
  1184. AssertEquals('Array dim 0',0,Length(TD.ArrayDims));
  1185. AssertEquals('Blob type 0',0,TD.BlobType);
  1186. AssertEquals('Not required',False,TD.NotNull);
  1187. AssertEquals('Length',Len,TD.Len);
  1188. end;
  1189. procedure TTestSQLParser.TestDropStatement(const ASource: string;
  1190. C: TSQLElementClass);
  1191. Var
  1192. D : TSQLDropStatement;
  1193. begin
  1194. If ASOURCE='SHADOW' then
  1195. CreateParser('DROP '+ASource+' 1')
  1196. else
  1197. CreateParser('DROP '+ASource+' A');
  1198. FToFree:=Parser.Parse;
  1199. AssertNotNull('Parse returns result',FTofree);
  1200. If Not FToFree.InheritsFrom(TSQLDropStatement) then
  1201. Fail('Drop statement is not of type TSQLDropStatement');
  1202. CheckClass(FToFree ,C);
  1203. D:=TSQLDropStatement(FToFree);
  1204. If ASOURCE='SHADOW' then
  1205. AssertIdentifierName('object name','1',D.ObjectName)
  1206. else
  1207. AssertIdentifierName('object name','A',D.ObjectName);
  1208. end;
  1209. function TTestSQLParser.TestCreateStatement(const ASource,AName: string;
  1210. C: TSQLElementClass): TSQLCreateOrAlterStatement;
  1211. begin
  1212. CreateParser(ASource);
  1213. FToFree:=Parser.Parse;
  1214. AssertNotNull('Parse returns result',FTofree);
  1215. If Not FToFree.InheritsFrom(TSQLCreateOrAlterStatement) then
  1216. Fail('create statement is not of type TSQLCreateOrAlterStatement');
  1217. CheckClass(FToFree ,C);
  1218. Result:=TSQLCreateOrAlterStatement(FToFree);
  1219. AssertIdentifierName('Correct identifier',AName,Result.ObjectName);
  1220. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  1221. end;
  1222. { --------------------------------------------------------------------
  1223. TTestDropParser
  1224. --------------------------------------------------------------------}
  1225. procedure TTestDropParser.TestDropDatabase;
  1226. begin
  1227. TestDropStatement('DATABASE',TSQLDropDatabaseStatement);
  1228. end;
  1229. procedure TTestDropParser.TestDropDomain;
  1230. begin
  1231. TestDropStatement('DOMAIN',TSQLDropDomainStatement);
  1232. end;
  1233. procedure TTestDropParser.TestDropException;
  1234. begin
  1235. TestDropStatement('EXCEPTION',TSQLDropExceptionStatement);
  1236. end;
  1237. procedure TTestDropParser.TestDropGenerator;
  1238. begin
  1239. TestDropStatement('GENERATOR',TSQLDropGeneratorStatement);
  1240. end;
  1241. procedure TTestDropParser.TestDropIndex;
  1242. begin
  1243. TestDropStatement('INDEX',TSQLDropIndexStatement);
  1244. end;
  1245. procedure TTestDropParser.TestDropProcedure;
  1246. begin
  1247. TestDropStatement('PROCEDURE',TSQLDropProcedureStatement);
  1248. end;
  1249. procedure TTestDropParser.TestDropRole;
  1250. begin
  1251. TestDropStatement('ROLE',TSQLDropRoleStatement);
  1252. end;
  1253. procedure TTestDropParser.TestDropTable;
  1254. begin
  1255. TestDropStatement('TABLE',TSQLDropTableStatement);
  1256. end;
  1257. procedure TTestDropParser.TestDropTrigger;
  1258. begin
  1259. TestDropStatement('TRIGGER',TSQLDropTriggerStatement);
  1260. end;
  1261. procedure TTestDropParser.TestDropView;
  1262. begin
  1263. TestDropStatement('VIEW',TSQLDropViewStatement);
  1264. end;
  1265. procedure TTestDropParser.TestDropShadow;
  1266. begin
  1267. TestDropStatement('SHADOW',TSQLDropShadowStatement);
  1268. end;
  1269. procedure TTestDropParser.TestDropExternalFunction;
  1270. begin
  1271. TestDropStatement('EXTERNAL FUNCTION',TSQLDropExternalFunctionStatement);
  1272. end;
  1273. { --------------------------------------------------------------------
  1274. TTestGeneratorParser
  1275. --------------------------------------------------------------------}
  1276. procedure TTestGeneratorParser.TestCreateGenerator;
  1277. begin
  1278. TestCreateStatement('CREATE GENERATOR A','A',TSQLCreateGeneratorStatement);
  1279. end;
  1280. procedure TTestGeneratorParser.TestCreateSequence;
  1281. Var
  1282. C : TSQLCreateOrAlterStatement;
  1283. begin
  1284. C:=TestCreateStatement('CREATE SEQUENCE A','A',TSQLCreateGeneratorStatement);
  1285. AssertEquals('Sequence detected',True,TSQLCreateGeneratorStatement(c).IsSequence);
  1286. end;
  1287. procedure TTestGeneratorParser.TestAlterSequence;
  1288. Var
  1289. C : TSQLCreateOrAlterStatement;
  1290. D : TSQLAlterGeneratorStatement absolute C;
  1291. begin
  1292. C:=TestCreateStatement('ALTER SEQUENCE A RESTART WITH 100','A',TSQLAlterGeneratorStatement);
  1293. AssertEquals('Sequence detected',True,D.IsSequence);
  1294. AssertEquals('Sequence restart ',True,D.HasRestart);
  1295. AssertEquals('Sequence restart value',100,D.Restart);
  1296. end;
  1297. procedure TTestGeneratorParser.TestSetGenerator;
  1298. Var
  1299. S : TSQLSetGeneratorStatement;
  1300. begin
  1301. CreateParser('SET GENERATOR A TO 1');
  1302. FToFree:=Parser.Parse;
  1303. S:=TSQLSetGeneratorStatement(CheckClass(FToFree,TSQLSetGeneratorStatement));
  1304. AssertIdentifierName('Correct generator name','A',S.Objectname);
  1305. AssertEquals('New value',1,S.NewValue);
  1306. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  1307. end;
  1308. { --------------------------------------------------------------------
  1309. TTestTypeParser
  1310. --------------------------------------------------------------------}
  1311. procedure TTestTypeParser.TestStringType1;
  1312. begin
  1313. TestStringDef('CHAR(1)',sdtChar,1);
  1314. end;
  1315. procedure TTestTypeParser.TestStringType2;
  1316. begin
  1317. TestStringDef('CHAR',sdtChar,0);
  1318. end;
  1319. procedure TTestTypeParser.TestStringType3;
  1320. begin
  1321. TestStringDef('CHARACTER',sdtChar,0);
  1322. end;
  1323. procedure TTestTypeParser.TestStringType4;
  1324. begin
  1325. TestStringDef('CHARACTER VARYING',sdtVarChar,0);
  1326. end;
  1327. procedure TTestTypeParser.TestStringType5;
  1328. begin
  1329. TestStringDef('VARCHAR',sdtVarChar,0);
  1330. end;
  1331. procedure TTestTypeParser.TestStringType6;
  1332. begin
  1333. TestStringDef('VARCHAR(2)',sdtVarChar,2);
  1334. end;
  1335. procedure TTestTypeParser.TestStringType7;
  1336. begin
  1337. TestStringDef('CHARACTER VARYING (2)',sdtVarChar,2);
  1338. end;
  1339. procedure TTestTypeParser.TestStringType8;
  1340. begin
  1341. TestStringDef('NATIONAL CHARACTER VARYING (2)',sdtNVarChar,2);
  1342. end;
  1343. procedure TTestTypeParser.TestStringType9;
  1344. begin
  1345. TestStringDef('NATIONAL CHARACTER (2)',sdtNChar,2);
  1346. end;
  1347. procedure TTestTypeParser.TestStringType10;
  1348. begin
  1349. TestStringDef('NATIONAL CHARACTER',sdtNChar,0);
  1350. end;
  1351. procedure TTestTypeParser.TestStringType11;
  1352. begin
  1353. TestStringDef('NATIONAL CHARACTER VARYING',sdtNVarChar,0);
  1354. end;
  1355. procedure TTestTypeParser.TestStringType12;
  1356. begin
  1357. TestStringDef('NCHAR',sdtNChar,0);
  1358. end;
  1359. procedure TTestTypeParser.TestStringType13;
  1360. begin
  1361. TestStringDef('NCHAR(2)',sdtNChar,2);
  1362. end;
  1363. procedure TTestTypeParser.TestStringType14;
  1364. begin
  1365. TestStringDef('NCHAR VARYING(2)',sdtNVarChar,2);
  1366. end;
  1367. procedure TTestTypeParser.TestStringType15;
  1368. begin
  1369. TestStringDef('CHAR (15) CHARACTER SET UTF8',sdtChar,15,'UTF8');
  1370. end;
  1371. procedure TTestTypeParser.TestStringType16;
  1372. begin
  1373. TestStringDef('CHAR VARYING (15) CHARACTER SET UTF8',sdtVarChar,15,'UTF8');
  1374. end;
  1375. procedure TTestTypeParser.TestStringType17;
  1376. begin
  1377. TestStringDef('CHAR VARYING CHARACTER SET UTF8',sdtVarChar,0,'UTF8');
  1378. end;
  1379. procedure TTestTypeParser.TestStringType18;
  1380. begin
  1381. TestStringDef('CHARACTER CHARACTER SET UTF8',sdtChar,0,'UTF8');
  1382. end;
  1383. procedure TTestTypeParser.TestStringType19;
  1384. Var
  1385. T : TSQLTypeDefinition;
  1386. begin
  1387. T:=TestType('CHAR(10) COLLATE UTF8',[],sdtChar);
  1388. AssertNotNull('Have collation',T.Collation);
  1389. AssertEquals('Correct collation','UTF8',T.Collation.Name);
  1390. end;
  1391. procedure TTestTypeParser.TestStringTypeErrors1;
  1392. begin
  1393. FErrSource:='VARCHAR VARYING';
  1394. AssertException(ESQLParser,@TestStringError);
  1395. end;
  1396. procedure TTestTypeParser.TestStringTypeErrors2;
  1397. begin
  1398. FErrSource:='CHAR(A)';
  1399. AssertException(ESQLParser,@TestStringError);
  1400. end;
  1401. procedure TTestTypeParser.TestStringTypeErrors3;
  1402. begin
  1403. FErrSource:='CHAR(1]';
  1404. AssertException(ESQLParser,@TestStringError);
  1405. end;
  1406. procedure TTestTypeParser.TestTypeInt1;
  1407. Var
  1408. TD : TSQLTypeDefinition;
  1409. begin
  1410. TD:=TestType('INT',[],sdtInteger);
  1411. AssertTypeDefaults(TD);
  1412. end;
  1413. procedure TTestTypeParser.TestTypeInt2;
  1414. Var
  1415. TD : TSQLTypeDefinition;
  1416. begin
  1417. TD:=TestType('INT DEFAULT NULL',[],sdtInteger);
  1418. AssertNotNull('Have Default value',TD.DefaultValue);
  1419. CheckClass(TD.DefaultValue,TSQLNullLiteral);
  1420. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  1421. end;
  1422. procedure TTestTypeParser.TestTypeInt3;
  1423. Var
  1424. TD : TSQLTypeDefinition;
  1425. begin
  1426. TD:=TestType('INT DEFAULT 1',[],sdtInteger);
  1427. AssertNotNull('Have Default value',TD.DefaultValue);
  1428. CheckClass(TD.DefaultValue,TSQLIntegerLiteral);
  1429. AssertEquals('Correct default value ',1,TSQLIntegerLiteral(TD.DefaultValue).Value);
  1430. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  1431. end;
  1432. procedure TTestTypeParser.TestTypeInt4;
  1433. Var
  1434. TD : TSQLTypeDefinition;
  1435. begin
  1436. TD:=TestType('INT NOT NULL',[],sdtInteger);
  1437. AssertNull('No Default value',TD.DefaultValue);
  1438. AssertEquals('Required field',True,TD.NotNull);
  1439. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  1440. end;
  1441. procedure TTestTypeParser.TestTypeInt5;
  1442. Var
  1443. TD : TSQLTypeDefinition;
  1444. begin
  1445. TD:=TestType('INT [3]',[],sdtInteger);
  1446. AssertEquals('Array of length',1,Length(TD.ArrayDims));
  1447. AssertEquals('Upper bound',3,TD.ArrayDims[0][2]);
  1448. AssertEquals('Lower bound',1,TD.ArrayDims[0][1]);
  1449. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  1450. end;
  1451. procedure TTestTypeParser.TestNumerical1;
  1452. Var
  1453. TD : TSQLTypeDefinition;
  1454. begin
  1455. TD:=TestType('NUMERIC (10)',[],sdtNumeric);
  1456. AssertEquals('Correct length',10,TD.Len);
  1457. end;
  1458. procedure TTestTypeParser.TestNumerical2;
  1459. Var
  1460. TD : TSQLTypeDefinition;
  1461. begin
  1462. TD:=TestType('NUMERIC (10,3)',[],sdtNumeric);
  1463. AssertEquals('Correct length',10,TD.Len);
  1464. AssertEquals('Correct scale',3,TD.Scale);
  1465. end;
  1466. procedure TTestTypeParser.TestNumerical3;
  1467. Var
  1468. TD : TSQLTypeDefinition;
  1469. begin
  1470. TD:=TestType('NUMERIC',[],sdtNumeric);
  1471. AssertEquals('Correct length',0,TD.Len);
  1472. AssertEquals('Correct scale',0,TD.Scale);
  1473. end;
  1474. procedure TTestTypeParser.TestNumericalError1;
  1475. begin
  1476. FErrSource:='NUMERIC ()';
  1477. AssertException(ESQLParser,@TestTypeError);
  1478. end;
  1479. procedure TTestTypeParser.TestNumericalError2;
  1480. begin
  1481. FErrSource:='NUMERIC (A)';
  1482. AssertException(ESQLParser,@TestTypeError);
  1483. end;
  1484. procedure TTestTypeParser.TestNumericalError3;
  1485. begin
  1486. FErrSource:='NUMERIC (,1)';
  1487. AssertException(ESQLParser,@TestTypeError);
  1488. end;
  1489. procedure TTestTypeParser.TestNumericalError4;
  1490. begin
  1491. FErrSource:='NUMERIC (1,)';
  1492. AssertException(ESQLParser,@TestTypeError);
  1493. end;
  1494. procedure TTestTypeParser.TestNumericalError5;
  1495. begin
  1496. FErrSource:='NUMERIC (1';
  1497. AssertException(ESQLParser,@TestTypeError);
  1498. end;
  1499. procedure TTestTypeParser.TestNumericalError6;
  1500. begin
  1501. FErrSource:='NUMERIC (1,';
  1502. AssertException(ESQLParser,@TestTypeError);
  1503. end;
  1504. procedure TTestTypeParser.TestNumericalError7;
  1505. begin
  1506. FErrSource:='NUMERIC (1 NOT';
  1507. AssertException(ESQLParser,@TestTypeError);
  1508. end;
  1509. procedure TTestTypeParser.TestBlob1;
  1510. Var
  1511. TD : TSQLTypeDefinition;
  1512. begin
  1513. TD:=TestType('BLOB sub_type 1 SEGMENT SIZE 80 CHARACTER SET UTF8',[],sdtBlob);
  1514. AssertEquals('Blob type 1',1,TD.BlobType);
  1515. AssertEquals('Blob segment size',80,TD.Len);
  1516. AssertEquals('Character set','UTF8',TD.Charset);
  1517. end;
  1518. procedure TTestTypeParser.TestBlob2;
  1519. Var
  1520. TD : TSQLTypeDefinition;
  1521. begin
  1522. TD:=TestType('BLOB (80,1) CHARACTER SET UTF8',[],sdtBlob);
  1523. AssertEquals('Blob type 1',1,TD.BlobType);
  1524. AssertEquals('Blob segment size',80,TD.Len);
  1525. AssertEquals('Character set','UTF8',TD.Charset);
  1526. end;
  1527. procedure TTestTypeParser.TestBlob3;
  1528. Var
  1529. TD : TSQLTypeDefinition;
  1530. begin
  1531. TD:=TestType('BLOB SEGMENT SIZE 80',[],sdtBlob);
  1532. AssertEquals('Blob type 0',0,TD.BlobType);
  1533. AssertEquals('Blob segment size',80,TD.Len);
  1534. AssertEquals('Character set','',TD.Charset);
  1535. end;
  1536. procedure TTestTypeParser.TestBlob4;
  1537. Var
  1538. TD : TSQLTypeDefinition;
  1539. begin
  1540. TD:=TestType('BLOB SUB_TYPE 1',[],sdtBlob);
  1541. AssertEquals('Blob type 1',1,TD.BlobType);
  1542. AssertEquals('Blob segment size',0,TD.Len);
  1543. AssertEquals('Character set','',TD.Charset);
  1544. end;
  1545. procedure TTestTypeParser.TestBlob5;
  1546. Var
  1547. TD : TSQLTypeDefinition;
  1548. begin
  1549. TD:=TestType('BLOB (80)',[],sdtBlob);
  1550. AssertEquals('Blob type 0',0,TD.BlobType);
  1551. AssertEquals('Blob segment size',80,TD.Len);
  1552. AssertEquals('Character set','',TD.Charset);
  1553. end;
  1554. procedure TTestTypeParser.TestBlob6;
  1555. Var
  1556. TD : TSQLTypeDefinition;
  1557. begin
  1558. TD:=TestType('BLOB',[],sdtBlob);
  1559. AssertEquals('Blob type 0',0,TD.BlobType);
  1560. AssertEquals('Blob segment size',0,TD.Len);
  1561. AssertEquals('Character set','',TD.Charset);
  1562. end;
  1563. procedure TTestTypeParser.TestBlob7;
  1564. var
  1565. TD : TSQLTypeDefinition;
  1566. begin
  1567. TD:=TestType('BLOB SUB_TYPE BINARY',[],sdtBlob);
  1568. AssertEquals('Blob type 0',0,TD.BlobType);
  1569. AssertEquals('Blob segment size',0,TD.Len);
  1570. AssertEquals('Character set','',TD.Charset);
  1571. end;
  1572. procedure TTestTypeParser.TestBlob8;
  1573. var
  1574. TD : TSQLTypeDefinition;
  1575. begin
  1576. TD:=TestType('BLOB SUB_TYPE TEXT',[],sdtBlob);
  1577. AssertEquals('Blob type 1',1,TD.BlobType);
  1578. AssertEquals('Blob segment size',0,TD.Len);
  1579. AssertEquals('Character set','',TD.Charset);
  1580. end;
  1581. procedure TTestTypeParser.TestSmallInt;
  1582. begin
  1583. TestType('SMALLINT',[],sdtSmallint);
  1584. end;
  1585. procedure TTestTypeParser.TestFloat;
  1586. begin
  1587. TestType('FLOAT',[],sdtFloat);
  1588. end;
  1589. procedure TTestTypeParser.TestDoublePrecision;
  1590. begin
  1591. TestType('DOUBLE PRECISION',[],sdtDoublePrecision);
  1592. end;
  1593. procedure TTestTypeParser.TestDoublePrecisionDefault;
  1594. begin
  1595. TestType('DOUBLE PRECISION DEFAULT 0',[],sdtDoublePrecision);
  1596. end;
  1597. procedure TTestTypeParser.TestBlobError1;
  1598. begin
  1599. FerrSource:='BLOB (1,)';
  1600. AssertException(ESQLParser,@TestTypeError);
  1601. end;
  1602. procedure TTestTypeParser.TestBlobError2;
  1603. begin
  1604. FerrSource:='BLOB 1,)';
  1605. // EAssertionfailed, due to not EOF
  1606. AssertException(EAssertionFailedError,@TestTypeError);
  1607. end;
  1608. procedure TTestTypeParser.TestBlobError3;
  1609. begin
  1610. FerrSource:='BLOB (80) SUB_TYPE 3';
  1611. AssertException(ESQLParser,@TestTypeError);
  1612. end;
  1613. procedure TTestTypeParser.TestBlobError4;
  1614. begin
  1615. FerrSource:='BLOB CHARACTER UTF8';
  1616. AssertException(ESQLParser,@TestTypeError);
  1617. end;
  1618. procedure TTestTypeParser.TestBlobError5;
  1619. begin
  1620. FerrSource:='BLOB (80) SEGMENT SIZE 80';
  1621. AssertException(ESQLParser,@TestTypeError);
  1622. end;
  1623. procedure TTestTypeParser.TestBlobError6;
  1624. begin
  1625. FerrSource:='BLOB (A)';
  1626. AssertException(ESQLParser,@TestTypeError);
  1627. end;
  1628. procedure TTestTypeParser.TestBlobError7;
  1629. begin
  1630. FerrSource:='BLOB (1';
  1631. AssertException(ESQLParser,@TestTypeError);
  1632. end;
  1633. { --------------------------------------------------------------------
  1634. TTestCheckParser
  1635. --------------------------------------------------------------------}
  1636. procedure TTestCheckParser.TestCheckNotNull;
  1637. Var
  1638. B : TSQLBinaryExpression;
  1639. begin
  1640. B:=TSQLBinaryExpression(TestCheck('VALUE IS NOT NULL',TSQLBinaryExpression));
  1641. AssertEquals('IS NOT operator,',boISNot,B.Operation);
  1642. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1643. AssertLiteralExpr('Right is null',B.Right,TSQLNullLiteral);
  1644. end;
  1645. procedure TTestCheckParser.TestCheckNull;
  1646. Var
  1647. B : TSQLBinaryExpression;
  1648. begin
  1649. B:=TSQLBinaryExpression(TestCheck('VALUE IS NULL',TSQLBinaryExpression));
  1650. AssertEquals('IS operator,',boIS,B.Operation);
  1651. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1652. AssertLiteralExpr('Right is null',B.Right,TSQLNullLiteral);
  1653. end;
  1654. procedure TTestCheckParser.TestCheckBraces;
  1655. Var
  1656. B : TSQLBinaryExpression;
  1657. begin
  1658. B:=TSQLBinaryExpression(TestCheck('(VALUE IS NULL)',TSQLBinaryExpression));
  1659. AssertEquals('IS operator,',boIS,B.Operation);
  1660. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1661. AssertLiteralExpr('Right is null',B.Right,TSQLNullLiteral);
  1662. end;
  1663. procedure TTestCheckParser.TestCheckBracesError;
  1664. begin
  1665. FErrSource:='(VALUE IS NOT NULL ME )';
  1666. AssertException('Error in braces.', ESQLParser,@TestCheckError);
  1667. end;
  1668. procedure TTestCheckParser.TestCheckParamError;
  1669. begin
  1670. FErrSource:='VALUE <> :P';
  1671. AssertException('Parameter.', ESQLParser,@TestCheckError);
  1672. end;
  1673. procedure TTestCheckParser.TestCheckIdentifierError;
  1674. begin
  1675. FErrSource:='(X IS NOT NULL)';
  1676. AssertException('Error in check: identifier.', ESQLParser,@TestCheckError);
  1677. end;
  1678. procedure TTestCheckParser.TestIsEqual;
  1679. Var
  1680. B : TSQLBinaryExpression;
  1681. begin
  1682. B:=TSQLBinaryExpression(TestCheck('VALUE = 3',TSQLBinaryExpression));
  1683. AssertEquals('Equal operator',boEq,B.Operation);
  1684. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1685. AssertLiteralExpr('Right is integer',B.Right,TSQLIntegerLiteral);
  1686. end;
  1687. procedure TTestCheckParser.TestIsNotEqual1;
  1688. Var
  1689. B : TSQLBinaryExpression;
  1690. begin
  1691. B:=TSQLBinaryExpression(TestCheck('VALUE <> 3',TSQLBinaryExpression));
  1692. AssertEquals('Not Equal operator',boNE,B.Operation);
  1693. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1694. AssertLiteralExpr('Right is integer',B.Right,TSQLIntegerLiteral);
  1695. end;
  1696. procedure TTestCheckParser.TestIsNotEqual2;
  1697. Var
  1698. B : TSQLBinaryExpression;
  1699. begin
  1700. B:=TSQLBinaryExpression(TestCheck('VALUE != 3',TSQLBinaryExpression));
  1701. AssertEquals('ENot qual operator',boNE,B.Operation);
  1702. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1703. AssertLiteralExpr('Right is integer',B.Right,TSQLIntegerLiteral);
  1704. end;
  1705. procedure TTestCheckParser.TestGreaterThan;
  1706. Var
  1707. B : TSQLBinaryExpression;
  1708. begin
  1709. B:=TSQLBinaryExpression(TestCheck('VALUE > 3',TSQLBinaryExpression));
  1710. AssertEquals('Greater than operator',boGT,B.Operation);
  1711. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1712. AssertLiteralExpr('Right is integer',B.Right,TSQLIntegerLiteral);
  1713. end;
  1714. procedure TTestCheckParser.TestGreaterThanEqual1;
  1715. Var
  1716. B : TSQLBinaryExpression;
  1717. begin
  1718. B:=TSQLBinaryExpression(TestCheck('VALUE >= 3',TSQLBinaryExpression));
  1719. AssertEquals('Greater or Equal operator',boGE,B.Operation);
  1720. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1721. AssertLiteralExpr('Right is integer',B.Right,TSQLIntegerLiteral);
  1722. end;
  1723. procedure TTestCheckParser.TestGreaterThanEqual2;
  1724. Var
  1725. B : TSQLBinaryExpression;
  1726. begin
  1727. B:=TSQLBinaryExpression(TestCheck('VALUE !< 3',TSQLBinaryExpression));
  1728. AssertEquals('Greater or Equal operator',boGE,B.Operation);
  1729. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1730. AssertLiteralExpr('Right is integer',B.Right,TSQLIntegerLiteral);
  1731. end;
  1732. procedure TTestCheckParser.TestLessThan;
  1733. Var
  1734. B : TSQLBinaryExpression;
  1735. begin
  1736. B:=TSQLBinaryExpression(TestCheck('VALUE < 3',TSQLBinaryExpression));
  1737. AssertEquals('Less than operator',boLT,B.Operation);
  1738. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1739. AssertLiteralExpr('Right is integer',B.Right,TSQLIntegerLiteral);
  1740. end;
  1741. procedure TTestCheckParser.TestLessThanEqual1;
  1742. Var
  1743. B : TSQLBinaryExpression;
  1744. begin
  1745. B:=TSQLBinaryExpression(TestCheck('VALUE <= 3',TSQLBinaryExpression));
  1746. AssertEquals('Less or Equal operator',boLE,B.Operation);
  1747. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1748. AssertLiteralExpr('Right is integer',B.Right,TSQLIntegerLiteral);
  1749. end;
  1750. procedure TTestCheckParser.TestLessThanEqual2;
  1751. Var
  1752. B : TSQLBinaryExpression;
  1753. begin
  1754. B:=TSQLBinaryExpression(TestCheck('VALUE !> 3',TSQLBinaryExpression));
  1755. AssertEquals('Less or Equal operator',boLE,B.Operation);
  1756. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1757. AssertLiteralExpr('Right is integer',B.Right,TSQLIntegerLiteral);
  1758. end;
  1759. procedure TTestCheckParser.TestLike;
  1760. Var
  1761. B : TSQLBinaryExpression;
  1762. begin
  1763. B:=TSQLBinaryExpression(TestCheck('VALUE LIKE ''%3''',TSQLBinaryExpression));
  1764. AssertEquals('Like operator',boLike,B.Operation);
  1765. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1766. AssertLiteralExpr('Right is string',B.Right,TSQLStringLiteral);
  1767. end;
  1768. procedure TTestCheckParser.TestNotLike;
  1769. Var
  1770. B : TSQLBinaryExpression;
  1771. U : TSQLUnaryExpression;
  1772. begin
  1773. U:=TSQLUnaryExpression(TestCheck('VALUE NOT LIKE ''%3''',TSQLUnaryExpression));
  1774. AssertEquals('Like operator',uoNot,U.Operation);
  1775. CheckClass(U.Operand,TSQLBinaryExpression);
  1776. B:=TSQLBinaryExpression(U.Operand);
  1777. AssertEquals('Like operator',boLike,B.Operation);
  1778. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1779. AssertLiteralExpr('Right is string',B.Right,TSQLStringLiteral);
  1780. end;
  1781. procedure TTestCheckParser.TestContaining;
  1782. Var
  1783. B : TSQLBinaryExpression;
  1784. begin
  1785. B:=TSQLBinaryExpression(TestCheck('VALUE CONTAINING ''3''',TSQLBinaryExpression));
  1786. AssertEquals('Like operator',boContaining,B.Operation);
  1787. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1788. AssertLiteralExpr('Right is string',B.Right,TSQLStringLiteral);
  1789. end;
  1790. procedure TTestCheckParser.TestDivide;
  1791. Var
  1792. B : TSQLBinaryExpression;
  1793. begin
  1794. B:=TSQLBinaryExpression(TestCheck('VALUE / 1',TSQLBinaryExpression));
  1795. AssertEquals('Correct operator', boDivide, B.Operation);
  1796. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1797. AssertLiteralExpr('Right is integer',B.Right,TSQLIntegerLiteral);
  1798. AssertEquals('Right is 1',1, TSQLIntegerLiteral(TSQLLiteralExpression(B.Right).Literal).Value);
  1799. end;
  1800. procedure TTestCheckParser.TestNotContaining;
  1801. Var
  1802. B : TSQLBinaryExpression;
  1803. U : TSQLUnaryExpression;
  1804. begin
  1805. U:=TSQLUnaryExpression(TestCheck('VALUE NOT CONTAINING ''3''',TSQLUnaryExpression));
  1806. AssertEquals('Like operator',uoNot,U.Operation);
  1807. CheckClass(U.Operand,TSQLBinaryExpression);
  1808. B:=TSQLBinaryExpression(U.Operand);
  1809. AssertEquals('Like operator',boContaining,B.Operation);
  1810. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1811. AssertLiteralExpr('Right is string',B.Right,TSQLStringLiteral);
  1812. end;
  1813. procedure TTestCheckParser.TestStarting;
  1814. Var
  1815. B : TSQLBinaryExpression;
  1816. begin
  1817. B:=TSQLBinaryExpression(TestCheck('VALUE STARTING ''3''',TSQLBinaryExpression));
  1818. AssertEquals('Starting operator',boStarting,B.Operation);
  1819. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1820. AssertLiteralExpr('Right is string',B.Right,TSQLStringLiteral);
  1821. end;
  1822. procedure TTestCheckParser.TestNotStarting;
  1823. Var
  1824. B : TSQLBinaryExpression;
  1825. U : TSQLUnaryExpression;
  1826. begin
  1827. U:=TSQLUnaryExpression(TestCheck('VALUE NOT STARTING ''3''',TSQLUnaryExpression));
  1828. AssertEquals('Not operator',uoNot,U.Operation);
  1829. CheckClass(U.Operand,TSQLBinaryExpression);
  1830. B:=TSQLBinaryExpression(U.Operand);
  1831. AssertEquals('Starting operator',boStarting,B.Operation);
  1832. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1833. AssertLiteralExpr('Right is string',B.Right,TSQLStringLiteral);
  1834. end;
  1835. procedure TTestCheckParser.TestStartingWith;
  1836. Var
  1837. B : TSQLBinaryExpression;
  1838. begin
  1839. B:=TSQLBinaryExpression(TestCheck('VALUE STARTING WITH ''3''',TSQLBinaryExpression));
  1840. AssertEquals('Starting operator',boStarting,B.Operation);
  1841. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1842. AssertLiteralExpr('Right is string',B.Right,TSQLStringLiteral);
  1843. end;
  1844. procedure TTestCheckParser.TestSubtract;
  1845. Var
  1846. B : TSQLBinaryExpression;
  1847. begin
  1848. B:=TSQLBinaryExpression(TestCheck('VALUE - 1',TSQLBinaryExpression));
  1849. AssertEquals('Correct operator', boSubtract, B.Operation);
  1850. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1851. AssertLiteralExpr('Right is integer',B.Right,TSQLIntegerLiteral);
  1852. AssertEquals('Right is 1',1, TSQLIntegerLiteral(TSQLLiteralExpression(B.Right).Literal).Value);
  1853. end;
  1854. procedure TTestCheckParser.TestNotStartingWith;
  1855. Var
  1856. B : TSQLBinaryExpression;
  1857. U : TSQLUnaryExpression;
  1858. begin
  1859. U:=TSQLUnaryExpression(TestCheck('VALUE NOT STARTING WITH ''3''',TSQLUnaryExpression));
  1860. AssertEquals('Not operator',uoNot,U.Operation);
  1861. CheckClass(U.Operand,TSQLBinaryExpression);
  1862. B:=TSQLBinaryExpression(U.Operand);
  1863. AssertEquals('Starting operator',boStarting,B.Operation);
  1864. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1865. AssertLiteralExpr('Right is string',B.Right,TSQLStringLiteral);
  1866. end;
  1867. procedure TTestCheckParser.TestBetween;
  1868. Var
  1869. T : TSQLTernaryExpression;
  1870. begin
  1871. T:=TSQLTernaryExpression(TestCheck('VALUE BETWEEN 1 AND 5',TSQLTernaryExpression));
  1872. AssertEquals('Like operator',tobetween,T.Operation);
  1873. AssertLiteralExpr('Left is value',T.Left,TSQLValueLiteral);
  1874. AssertLiteralExpr('Middle is integer',T.Middle,TSQLIntegerLiteral);
  1875. AssertLiteralExpr('Right is integer',T.Right,TSQLIntegerLiteral);
  1876. end;
  1877. procedure TTestCheckParser.TestCase;
  1878. Var
  1879. T : TSQLCaseExpression;
  1880. B : TSQLBinaryExpression;
  1881. R : TSQLIdentifierName;
  1882. begin
  1883. T:=TSQLCaseExpression(TestCheck('CASE WHEN A=1 THEN "a" WHEN B=2 THEN "b" ELSE "c" END',TSQLCaseExpression));
  1884. AssertEquals('Branch count = 2',2,T.BranchCount);
  1885. AssertNotNull('Else branch exists',T.ElseBranch);
  1886. B:=(T.Branches[0].Condition as TSQLBinaryExpression);
  1887. R:=(T.Branches[0].Expression as TSQLIdentifierExpression).Identifier;
  1888. AssertEquals('First WHEN Identifier is A', 'A', (B.Left as TSQLIdentifierExpression).Identifier.Name);
  1889. AssertEquals('First WHEN Number is 1', 1, ((B.Right as TSQLLiteralExpression).Literal as TSQLIntegerLiteral).Value);
  1890. AssertEquals('First THEN result is "a"', 'a', R.Name);
  1891. B:=(T.Branches[1].Condition as TSQLBinaryExpression);
  1892. R:=(T.Branches[1].Expression as TSQLIdentifierExpression).Identifier;
  1893. AssertEquals('Second WHEN Identifier is B', 'B', (B.Left as TSQLIdentifierExpression).Identifier.Name);
  1894. AssertEquals('Second WHEN Number is 2', 2, ((B.Right as TSQLLiteralExpression).Literal as TSQLIntegerLiteral).Value);
  1895. AssertEquals('Second THEN result is "b"', 'b', R.Name);
  1896. R:=(T.ElseBranch as TSQLIdentifierExpression).Identifier;
  1897. AssertEquals('ELSE result is "c"', 'c', R.Name);
  1898. end;
  1899. procedure TTestCheckParser.TestCaseWithSelector;
  1900. Var
  1901. T : TSQLCaseExpression;
  1902. L : TSQLLiteralExpression;
  1903. R : TSQLIdentifierName;
  1904. begin
  1905. T:=TSQLCaseExpression(TestCheck('CASE A WHEN 1 THEN "a" WHEN 2 THEN "b" ELSE "c" END',TSQLCaseExpression));
  1906. AssertNotNull('Selector exists',T.Selector);
  1907. AssertEquals('Branch count = 2',2,T.BranchCount);
  1908. AssertNotNull('Else branch exists',T.ElseBranch);
  1909. R:=(T.Selector as TSQLIdentifierExpression).Identifier;
  1910. AssertEquals('Selector identifier is "A"', 'A', R.Name);
  1911. L:=(T.Branches[0].Condition as TSQLLiteralExpression);
  1912. R:=(T.Branches[0].Expression as TSQLIdentifierExpression).Identifier;
  1913. AssertEquals('First WHEN Number is 1', 1, (L.Literal as TSQLIntegerLiteral).Value);
  1914. AssertEquals('First THEN result is "a"', 'a', R.Name);
  1915. L:=(T.Branches[1].Condition as TSQLLiteralExpression);
  1916. R:=(T.Branches[1].Expression as TSQLIdentifierExpression).Identifier;
  1917. AssertEquals('Second WHEN Number is 2', 2, (L.Literal as TSQLIntegerLiteral).Value);
  1918. AssertEquals('Second THEN result is "b"', 'b', R.Name);
  1919. R:=(T.ElseBranch as TSQLIdentifierExpression).Identifier;
  1920. AssertEquals('ELSE result is "c"', 'c', R.Name);
  1921. end;
  1922. procedure TTestCheckParser.TestNotBetween;
  1923. Var
  1924. U : TSQLUnaryExpression;
  1925. T : TSQLTernaryExpression;
  1926. begin
  1927. U:=TSQLUnaryExpression(TestCheck('VALUE NOT BETWEEN 1 AND 5',TSQLUnaryExpression));
  1928. AssertEquals('Not operator',uoNot,U.Operation);
  1929. CheckClass(U.Operand,TSQLTernaryExpression);
  1930. T:=TSQLTernaryExpression(U.Operand);
  1931. AssertEquals('Like operator',tobetween,T.Operation);
  1932. AssertLiteralExpr('Left is value',T.Left,TSQLValueLiteral);
  1933. AssertLiteralExpr('Middle is integer',T.Middle,TSQLIntegerLiteral);
  1934. AssertLiteralExpr('Right is integer',T.Right,TSQLIntegerLiteral);
  1935. end;
  1936. procedure TTestCheckParser.TestLikeEscape;
  1937. Var
  1938. T : TSQLTernaryExpression;
  1939. begin
  1940. T:=TSQLTernaryExpression(TestCheck('VALUE LIKE ''%2'' ESCAPE ''3''',TSQLTernaryExpression));
  1941. AssertEquals('Like operator',toLikeEscape,T.Operation);
  1942. AssertLiteralExpr('Left is value',T.Left,TSQLValueLiteral);
  1943. AssertLiteralExpr('Middle is string',T.Middle,TSQLStringLiteral);
  1944. AssertLiteralExpr('Right is string',T.Right,TSQLStringLiteral);
  1945. end;
  1946. procedure TTestCheckParser.TestMultiply;
  1947. Var
  1948. B : TSQLBinaryExpression;
  1949. begin
  1950. B:=TSQLBinaryExpression(TestCheck('VALUE * 1',TSQLBinaryExpression));
  1951. AssertEquals('Correct operator', boMultiply, B.Operation);
  1952. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1953. AssertLiteralExpr('Right is integer',B.Right,TSQLIntegerLiteral);
  1954. AssertEquals('Right is 1',1, TSQLIntegerLiteral(TSQLLiteralExpression(B.Right).Literal).Value);
  1955. end;
  1956. procedure TTestCheckParser.TestNotLikeEscape;
  1957. Var
  1958. U : TSQLUnaryExpression;
  1959. T : TSQLTernaryExpression;
  1960. begin
  1961. U:=TSQLUnaryExpression(TestCheck('VALUE NOT LIKE ''%2'' ESCAPE ''3''',TSQLUnaryExpression));
  1962. AssertEquals('Not operator',uoNot,U.Operation);
  1963. CheckClass(U.Operand,TSQLTernaryExpression);
  1964. T:=TSQLTernaryExpression(U.Operand);
  1965. AssertEquals('Like operator',toLikeEscape,T.Operation);
  1966. AssertLiteralExpr('Left is value',T.Left,TSQLValueLiteral);
  1967. AssertLiteralExpr('Middle is string',T.Middle,TSQLStringLiteral);
  1968. AssertLiteralExpr('Right is string',T.Right,TSQLStringLiteral);
  1969. end;
  1970. procedure TTestCheckParser.TestAdd;
  1971. Var
  1972. B : TSQLBinaryExpression;
  1973. begin
  1974. B:=TSQLBinaryExpression(TestCheck('VALUE + 1',TSQLBinaryExpression));
  1975. AssertEquals('Correct operator', boAdd, B.Operation);
  1976. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1977. AssertLiteralExpr('Right is integer',B.Right,TSQLIntegerLiteral);
  1978. AssertEquals('Right is 1',1, TSQLIntegerLiteral(TSQLLiteralExpression(B.Right).Literal).Value);
  1979. end;
  1980. procedure TTestCheckParser.TestAnd;
  1981. Var
  1982. T,B : TSQLBinaryExpression;
  1983. begin
  1984. T:=TSQLBinaryExpression(TestCheck('VALUE > 4 AND Value < 11',TSQLBinaryExpression));
  1985. AssertEquals('And operator',boand,T.Operation);
  1986. CheckClass(T.Left,TSQLBinaryExpression);
  1987. CheckClass(T.Right,TSQLBinaryExpression);
  1988. B:=TSQLBinaryExpression(T.Left);
  1989. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1990. AssertEquals('Less than operator',boGT,B.Operation);
  1991. AssertLiteralExpr('Right is value',B.Right,TSQLIntegerLiteral);
  1992. B:=TSQLBinaryExpression(T.Right);
  1993. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  1994. AssertEquals('Less than operator',boLT,B.Operation);
  1995. AssertLiteralExpr('Right is value',B.Right,TSQLIntegerLiteral);
  1996. end;
  1997. procedure TTestCheckParser.TestOr;
  1998. Var
  1999. T,B : TSQLBinaryExpression;
  2000. begin
  2001. T:=TSQLBinaryExpression(TestCheck('VALUE < 4 or Value > 11',TSQLBinaryExpression));
  2002. AssertEquals('And operator',boor,T.Operation);
  2003. CheckClass(T.Left,TSQLBinaryExpression);
  2004. CheckClass(T.Right,TSQLBinaryExpression);
  2005. B:=TSQLBinaryExpression(T.Left);
  2006. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  2007. AssertEquals('Less than operator',boLT,B.Operation);
  2008. AssertLiteralExpr('Right is value',B.Right,TSQLIntegerLiteral);
  2009. B:=TSQLBinaryExpression(T.Right);
  2010. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  2011. AssertEquals('Less than operator',boGT,B.Operation);
  2012. AssertLiteralExpr('Right is value',B.Right,TSQLIntegerLiteral);
  2013. end;
  2014. procedure TTestCheckParser.TestNotOr;
  2015. Var
  2016. T,B : TSQLBinaryExpression;
  2017. begin
  2018. T:=TSQLBinaryExpression(TestCheck('VALUE IS NOT NULL or Value > 11',TSQLBinaryExpression));
  2019. AssertEquals('And operator',boor,T.Operation);
  2020. CheckClass(T.Left,TSQLBinaryExpression);
  2021. CheckClass(T.Right,TSQLBinaryExpression);
  2022. B:=TSQLBinaryExpression(T.Left);
  2023. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  2024. AssertEquals('Is not null operator',boisNot,B.Operation);
  2025. AssertLiteralExpr('Right is value',B.Right,TSQLNullLiteral);
  2026. B:=TSQLBinaryExpression(T.Right);
  2027. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  2028. AssertEquals('Less than operator',boGT,B.Operation);
  2029. AssertLiteralExpr('Right is value',B.Right,TSQLIntegerLiteral);
  2030. end;
  2031. { TTestDomainParser }
  2032. procedure TTestDomainParser.TestSimpleDomain;
  2033. Var
  2034. P : TSQLCreateOrAlterStatement;
  2035. D : TSQLCreateDomainStatement;
  2036. T : TSQLTypeDefinition;
  2037. begin
  2038. P:=TestCreateStatement('CREATE DOMAIN A INT','A',TSQLCreateDomainStatement);
  2039. CheckClass(P,TSQLCreateDomainStatement);
  2040. D:=TSQLCreateDomainStatement(P);
  2041. AssertNotNull('Have type Definition',D.TypeDefinition);
  2042. T:=D.TypeDefinition;
  2043. AssertTypeDefaults(T);
  2044. AssertEquals('Integer data type',sdtInteger,T.DataType);
  2045. end;
  2046. procedure TTestDomainParser.TestSimpleDomainAs;
  2047. Var
  2048. P : TSQLCreateOrAlterStatement;
  2049. D : TSQLCreateDomainStatement;
  2050. T : TSQLTypeDefinition;
  2051. begin
  2052. P:=TestCreateStatement('CREATE DOMAIN A AS INT','A',TSQLCreateDomainStatement);
  2053. CheckClass(P,TSQLCreateDomainStatement);
  2054. D:=TSQLCreateDomainStatement(P);
  2055. AssertNotNull('Have type Definition',D.TypeDefinition);
  2056. T:=D.TypeDefinition;
  2057. AssertTypeDefaults(T);
  2058. AssertEquals('Integer data type',sdtInteger,T.DataType);
  2059. end;
  2060. procedure TTestDomainParser.TestNotNullDomain;
  2061. Var
  2062. P : TSQLCreateOrAlterStatement;
  2063. D : TSQLCreateDomainStatement;
  2064. T : TSQLTypeDefinition;
  2065. begin
  2066. P:=TestCreateStatement('CREATE DOMAIN A INT NOT NULL','A',TSQLCreateDomainStatement);
  2067. CheckClass(P,TSQLCreateDomainStatement);
  2068. D:=TSQLCreateDomainStatement(P);
  2069. AssertNotNull('Have type Definition',D.TypeDefinition);
  2070. T:=D.TypeDefinition;
  2071. AssertEquals('Integer data type',sdtInteger,T.DataType);
  2072. AssertEquals('Not null',True,T.NotNull);
  2073. end;
  2074. procedure TTestDomainParser.TestDefaultNotNullDomain;
  2075. Var
  2076. P : TSQLCreateOrAlterStatement;
  2077. D : TSQLCreateDomainStatement;
  2078. T : TSQLTypeDefinition;
  2079. begin
  2080. P:=TestCreateStatement('CREATE DOMAIN A INT DEFAULT 2 NOT NULL','A',TSQLCreateDomainStatement);
  2081. CheckClass(P,TSQLCreateDomainStatement);
  2082. D:=TSQLCreateDomainStatement(P);
  2083. AssertNotNull('Have type Definition',D.TypeDefinition);
  2084. T:=D.TypeDefinition;
  2085. AssertNotNull('Have default value',T.DefaultValue);
  2086. CheckClass(T.DefaultValue,TSQLINtegerLiteral);
  2087. AssertEquals('Integer data type',sdtInteger,T.DataType);
  2088. AssertEquals('Not null',True,T.NotNull);
  2089. end;
  2090. procedure TTestDomainParser.TestCheckDomain;
  2091. var
  2092. P : TSQLCreateOrAlterStatement;
  2093. D : TSQLCreateDomainStatement;
  2094. T : TSQLTypeDefinition;
  2095. begin
  2096. P:=TestCreateStatement('CREATE DOMAIN A AS CHAR(8) CHECK (VALUE STARTING WITH ''V'')','A',TSQLCreateDomainStatement);
  2097. CheckClass(P,TSQLCreateDomainStatement);
  2098. D:=TSQLCreateDomainStatement(P);
  2099. AssertNotNull('Have type Definition',D.TypeDefinition);
  2100. T:=D.TypeDefinition;
  2101. AssertNull('No default value',T.DefaultValue);
  2102. AssertEquals('Character data type',sdtChar,T.DataType);
  2103. AssertEquals('Not null must be allowed',False,T.NotNull);
  2104. end;
  2105. procedure TTestDomainParser.TestDefaultCheckNotNullDomain;
  2106. var
  2107. P : TSQLCreateOrAlterStatement;
  2108. D : TSQLCreateDomainStatement;
  2109. T : TSQLTypeDefinition;
  2110. begin
  2111. P:=TestCreateStatement(
  2112. 'CREATE DOMAIN DEFCHECKNOTN AS VARCHAR(1) DEFAULT ''s'' CHECK (VALUE IN (''s'',''h'',''A'')) NOT NULL',
  2113. 'DEFCHECKNOTN',TSQLCreateDomainStatement);
  2114. CheckClass(P,TSQLCreateDomainStatement);
  2115. D:=TSQLCreateDomainStatement(P);
  2116. AssertNotNull('Have type Definition',D.TypeDefinition);
  2117. T:=D.TypeDefinition;
  2118. AssertNotNull('Have default value',T.DefaultValue);
  2119. AssertEquals('Varchar data type',sdtVarChar,T.DataType);
  2120. AssertEquals('Not null',True,T.NotNull);
  2121. end;
  2122. procedure TTestDomainParser.TestAlterDomainDropDefault;
  2123. begin
  2124. TestCreateStatement('ALTER DOMAIN A DROP DEFAULT','A',TSQLAlterDomainDropDefaultStatement);
  2125. end;
  2126. procedure TTestDomainParser.TestAlterDomainDropCheck;
  2127. begin
  2128. TestCreateStatement('ALTER DOMAIN A DROP CONSTRAINT','A',TSQLAlterDomainDropCheckStatement);
  2129. end;
  2130. procedure TTestDomainParser.TestAlterDomainAddCheck;
  2131. Var
  2132. P : TSQLCreateOrAlterStatement;
  2133. D : TSQLAlterDomainAddCheckStatement;
  2134. B : TSQLBinaryExpression;
  2135. begin
  2136. P:=TestCreateStatement('ALTER DOMAIN A ADD CHECK (VALUE IS NOT NULL)','A',TSQLAlterDomainAddCheckStatement);
  2137. D:=TSQLAlterDomainAddCheckStatement(P);
  2138. AssertNotNull('Have check',D.Check);
  2139. CheckClass(D.Check,TSQLBinaryExpression);
  2140. B:=TSQLBinaryExpression(D.Check);
  2141. AssertEquals('Is not null operator',boIsNot,B.Operation);
  2142. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  2143. AssertEquals('Is not null operator',boisNot,B.Operation);
  2144. AssertLiteralExpr('Right is value',B.Right,TSQLNullLiteral);
  2145. end;
  2146. procedure TTestDomainParser.TestAlterDomainAddConstraintCheck;
  2147. Var
  2148. P : TSQLCreateOrAlterStatement;
  2149. D : TSQLAlterDomainAddCheckStatement;
  2150. B : TSQLBinaryExpression;
  2151. begin
  2152. P:=TestCreateStatement('ALTER DOMAIN A ADD CONSTRAINT CHECK (VALUE IS NOT NULL)','A',TSQLAlterDomainAddCheckStatement);
  2153. D:=TSQLAlterDomainAddCheckStatement(P);
  2154. AssertNotNull('Have check',D.Check);
  2155. CheckClass(D.Check,TSQLBinaryExpression);
  2156. B:=TSQLBinaryExpression(D.Check);
  2157. AssertEquals('Is not null operation',boIsNot,B.Operation);
  2158. AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
  2159. AssertEquals('Is not null operator',boisNot,B.Operation);
  2160. AssertLiteralExpr('Right is value',B.Right,TSQLNullLiteral);
  2161. end;
  2162. procedure TTestDomainParser.TestAlterDomainAddConstraintError;
  2163. begin
  2164. FErrSource:='ALTER DOMAIN A ADD CONSTRAINT (VALUE IS NOT NULL)';
  2165. AssertException(ESQLParser,@TestParseError);
  2166. end;
  2167. procedure TTestDomainParser.TestAlterDomainSetDefault;
  2168. Var
  2169. P : TSQLCreateOrAlterStatement;
  2170. D : TSQLAlterDomainSetDefaultStatement;
  2171. begin
  2172. P:=TestCreateStatement('ALTER DOMAIN A SET DEFAULT NULL','A',TSQLAlterDomainSetDefaultStatement);
  2173. D:=TSQLAlterDomainSetDefaultStatement(P);
  2174. AssertNotNull('Have default',D.DefaultValue);
  2175. CheckClass(D.DefaultValue,TSQLNullLiteral);
  2176. end;
  2177. procedure TTestDomainParser.TestAlterDomainRename;
  2178. Var
  2179. P : TSQLCreateOrAlterStatement;
  2180. D : TSQLAlterDomainRenameStatement;
  2181. begin
  2182. P:=TestCreateStatement('ALTER DOMAIN A B','A',TSQLAlterDomainRenameStatement);
  2183. D:=TSQLAlterDomainRenameStatement(P);
  2184. AssertIdentifierName('New name','B',D.NewName);
  2185. end;
  2186. procedure TTestDomainParser.TestAlterDomainNewType;
  2187. Var
  2188. P : TSQLCreateOrAlterStatement;
  2189. D : TSQLAlterDomainTypeStatement;
  2190. begin
  2191. P:=TestCreateStatement('ALTER DOMAIN A TYPE CHAR(10)','A',TSQLAlterDomainTypeStatement);
  2192. D:=TSQLAlterDomainTypeStatement(P);
  2193. AssertNotNull('Have type definition',D.NewType);
  2194. AssertEquals('Char type',sdtChar,D.NewType.DataType);
  2195. AssertEquals('Char type of len 10',10,D.NewType.Len);
  2196. end;
  2197. procedure TTestDomainParser.TestAlterDomainNewTypeError1;
  2198. begin
  2199. FErrSource:='ALTER DOMAIN A TYPE INT NOT NULL';
  2200. AssertException(ESQLParser,@TestParseError);
  2201. end;
  2202. procedure TTestDomainParser.TestAlterDomainNewTypeError2;
  2203. begin
  2204. FErrSource:='ALTER DOMAIN A TYPE INT DEFAULT 1';
  2205. AssertException(ESQLParser,@TestParseError);
  2206. end;
  2207. procedure TTestDomainParser.TestAlterDomainDropCheckError;
  2208. begin
  2209. FErrSource:='ALTER DOMAIN A DROP CHECK';
  2210. AssertException(ESQLParser,@TestParseError);
  2211. end;
  2212. { TTestExceptionParser }
  2213. procedure TTestExceptionParser.TestException;
  2214. Var
  2215. P : TSQLCreateOrAlterStatement;
  2216. E : TSQLCreateExceptionStatement;
  2217. begin
  2218. P:=TestCreateStatement('CREATE EXCEPTION A ''A message''','A',TSQLCreateExceptionStatement);
  2219. E:=TSQLCreateExceptionStatement(P);
  2220. AssertNotNull('Have message',E.ExceptionMessage);
  2221. AssertEquals('Message','A message',E.ExceptionMessage.Value)
  2222. end;
  2223. procedure TTestExceptionParser.TestAlterException;
  2224. Var
  2225. P : TSQLCreateOrAlterStatement;
  2226. E : TSQLCreateExceptionStatement;
  2227. begin
  2228. P:=TestCreateStatement('ALTER EXCEPTION A ''A massage''','A',TSQLAlterExceptionStatement);
  2229. E:=TSQLCreateExceptionStatement(P);
  2230. AssertNotNull('Have message',E.ExceptionMessage);
  2231. AssertEquals('Message','A massage',E.ExceptionMessage.Value)
  2232. end;
  2233. procedure TTestExceptionParser.TestExceptionError1;
  2234. begin
  2235. FErrSource:='CREATE EXCEPTION NOT';
  2236. ASsertException(ESQLParser,@TestParseError);
  2237. end;
  2238. procedure TTestExceptionParser.TestExceptionError2;
  2239. begin
  2240. FErrSource:='CREATE EXCEPTION A NOT';
  2241. ASsertException(ESQLParser,@TestParseError);
  2242. end;
  2243. { TTestRoleParser }
  2244. procedure TTestRoleParser.TestCreateRole;
  2245. begin
  2246. TestCreateStatement('CREATE ROLE A','A',TSQLCreateROLEStatement);
  2247. end;
  2248. procedure TTestRoleParser.TestAlterRole;
  2249. begin
  2250. FErrSource:='ALTER ROLE A';
  2251. ASsertException(ESQLParser,@TestParseError);
  2252. end;
  2253. { TTestIndexParser }
  2254. procedure TTestIndexParser.TestAlterindexActive;
  2255. Var
  2256. A : TSQLAlterIndexStatement;
  2257. begin
  2258. A:=TSQLAlterIndexStatement(TestCreateStatement('ALTER INDEX A ACTIVE','A',TSQLAlterIndexStatement));
  2259. AssertEquals('Active',False,A.Inactive);
  2260. end;
  2261. procedure TTestIndexParser.TestAlterindexInactive;
  2262. Var
  2263. A : TSQLAlterIndexStatement;
  2264. begin
  2265. A:=TSQLAlterIndexStatement(TestCreateStatement('ALTER INDEX A INACTIVE','A',TSQLAlterIndexStatement));
  2266. AssertEquals('Inactive',True,A.Inactive);
  2267. end;
  2268. procedure TTestIndexParser.TestCreateIndexSimple;
  2269. Var
  2270. C : TSQLCreateIndexStatement;
  2271. begin
  2272. C:=TSQLCreateIndexStatement(TestCreateStatement('CREATE INDEX A ON B (C)','A',TSQLCreateIndexStatement));
  2273. If Not (C.Options=[]) then
  2274. Fail('Options empty');
  2275. AssertIdentifiername('Correct table name','B',C.TableName);
  2276. AssertNotNull('Have fieldlist',C.FieldNames);
  2277. AssertEquals('Number of fields',1,C.FieldNames.Count);
  2278. AssertIdentifiername('Field name','C',C.FieldNames[0]);
  2279. end;
  2280. procedure TTestIndexParser.TestIndexIndexDouble;
  2281. Var
  2282. C : TSQLCreateIndexStatement;
  2283. begin
  2284. C:=TSQLCreateIndexStatement(TestCreateStatement('CREATE INDEX A ON B (C,D)','A',TSQLCreateIndexStatement));
  2285. If Not (C.Options=[]) then
  2286. Fail('Options empty');
  2287. AssertIdentifiername('Correct table name','B',C.TableName);
  2288. AssertNotNull('Have fieldlist',C.FieldNames);
  2289. AssertEquals('Number of fields',2,C.FieldNames.Count);
  2290. AssertIdentifiername('Field name 1','C',C.FieldNames[0]);
  2291. AssertIdentifiername('Field name 2','D',C.FieldNames[1]);
  2292. end;
  2293. procedure TTestIndexParser.TestIndexError1;
  2294. begin
  2295. FErrSource:='ALTER UNIQUE INDEX A ACTIVE';
  2296. AssertException(ESQLParser,@TestParseError);
  2297. end;
  2298. procedure TTestIndexParser.TestIndexError2;
  2299. begin
  2300. FErrSource:='ALTER ASCENDING INDEX A ACTIVE';
  2301. AssertException(ESQLParser,@TestParseError);
  2302. end;
  2303. procedure TTestIndexParser.TestIndexError3;
  2304. begin
  2305. FErrSource:='ALTER DESCENDING INDEX A ACTIVE';
  2306. AssertException(ESQLParser,@TestParseError);
  2307. end;
  2308. procedure TTestIndexParser.TestIndexError4;
  2309. begin
  2310. FErrSource:='CREATE INDEX A ON B';
  2311. AssertException(ESQLParser,@TestParseError);
  2312. end;
  2313. procedure TTestIndexParser.TestIndexError5;
  2314. begin
  2315. FErrSource:='CREATE INDEX A ON B ()';
  2316. AssertException(ESQLParser,@TestParseError);
  2317. end;
  2318. procedure TTestIndexParser.TestIndexError6;
  2319. begin
  2320. FErrSource:='CREATE INDEX A ON B (A,)';
  2321. AssertException(ESQLParser,@TestParseError);
  2322. end;
  2323. procedure TTestIndexParser.TestCreateIndexUnique;
  2324. Var
  2325. C : TSQLCreateIndexStatement;
  2326. begin
  2327. C:=TSQLCreateIndexStatement(TestCreateStatement('CREATE UNIQUE INDEX A ON B (C)','A',TSQLCreateIndexStatement));
  2328. If not ([ioUnique]=C.Options) then
  2329. Fail('Not Unique index');
  2330. AssertIdentifierName('Have table name','B',C.TableName);
  2331. AssertNotNull('Have fieldlist',C.FieldNames);
  2332. AssertEquals('Number of fields',1,C.FieldNames.Count);
  2333. AssertIdentifierName('Correct field name','C',C.FieldNames[0]);
  2334. end;
  2335. procedure TTestIndexParser.TestCreateIndexUniqueAscending;
  2336. Var
  2337. C : TSQLCreateIndexStatement;
  2338. begin
  2339. C:=TSQLCreateIndexStatement(TestCreateStatement('CREATE UNIQUE ASCENDING INDEX A ON B (C)','A',TSQLCreateIndexStatement));
  2340. If not ([ioUnique,ioAscending ]=C.Options) then
  2341. Fail('Not Unique ascending index');
  2342. AssertIdentifierName('Have table name','B',C.TableName);
  2343. AssertNotNull('Have fieldlist',C.FieldNames);
  2344. AssertEquals('Number of fields',1,C.FieldNames.Count);
  2345. AssertIdentifierName('Correct field name','C',C.FieldNames[0]);
  2346. end;
  2347. procedure TTestIndexParser.TestCreateIndexUniqueDescending;
  2348. Var
  2349. C : TSQLCreateIndexStatement;
  2350. begin
  2351. C:=TSQLCreateIndexStatement(TestCreateStatement('CREATE UNIQUE DESCENDING INDEX A ON B (C)','A',TSQLCreateIndexStatement));
  2352. If not ([ioUnique,ioDescending]=C.Options) then
  2353. Fail('Not Unique descending index');
  2354. AssertIdentifierName('Have table name','B',C.TableName);
  2355. AssertNotNull('Have fieldlist',C.FieldNames);
  2356. AssertEquals('Number of fields',1,C.FieldNames.Count);
  2357. AssertIdentifierName('Correct field name','C',C.FieldNames[0]);
  2358. end;
  2359. procedure TTestIndexParser.TestCreateIndexAscending;
  2360. Var
  2361. C : TSQLCreateIndexStatement;
  2362. begin
  2363. C:=TSQLCreateIndexStatement(TestCreateStatement('CREATE ASCENDING INDEX A ON B (C)','A',TSQLCreateIndexStatement));
  2364. If not ([ioAscending]=C.Options) then
  2365. Fail('Not ascending index');
  2366. AssertIdentifierName('Have table name','B',C.TableName);
  2367. AssertNotNull('Have fieldlist',C.FieldNames);
  2368. AssertEquals('Number of fields',1,C.FieldNames.Count);
  2369. AssertIdentifierName('Correct field name','C',C.FieldNames[0]);
  2370. end;
  2371. procedure TTestIndexParser.TestCreateIndexDescending;
  2372. Var
  2373. C : TSQLCreateIndexStatement;
  2374. begin
  2375. C:=TSQLCreateIndexStatement(TestCreateStatement('CREATE DESCENDING INDEX A ON B (C)','A',TSQLCreateIndexStatement));
  2376. If not ([ioDescending] = C.Options) then
  2377. Fail('Not descending index');
  2378. AssertIdentifierName('Table name','B',C.TableName);
  2379. AssertNotNull('Have fieldlist',C.FieldNames);
  2380. AssertEquals('Number of fields',1,C.FieldNames.Count);
  2381. AssertIdentifierName('Correct field name','C',C.FieldNames[0]);
  2382. end;
  2383. { TTestTableParser }
  2384. procedure TTestTableParser.DoTestCreateReferencesField(const ASource: String;
  2385. AOnUpdate, AOnDelete: TForeignKeyAction);
  2386. Var
  2387. C : TSQLCreateTableStatement;
  2388. F : TSQLTableFieldDef;
  2389. D : TSQLForeignKeyFieldConstraint;
  2390. begin
  2391. C:=TSQLCreateTableStatement(TestCreateStatement(ASource,'A',TSQLCreateTableStatement));
  2392. AssertEquals('One field',1,C.FieldDefs.Count);
  2393. AssertEquals('No constraints',0,C.Constraints.Count);
  2394. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2395. AssertIdentifierName('fieldname','B',F.FieldName);
  2396. AssertNotNull('Have field type',F.FieldType);
  2397. AssertEquals('Correct field type',sdtInteger,F.FieldType.DataType);
  2398. AssertEquals('Field can be NULL',false,F.FieldType.NotNull);
  2399. AssertNull('Have default',F.FieldType.DefaultValue);
  2400. AssertNotNull('Have constraint',F.FieldType.Constraint);
  2401. D:=TSQLForeignKeyFieldConstraint(CheckClass(F.FieldType.Constraint,TSQLForeignKeyFieldConstraint));
  2402. AssertNull('No constraint name',D.ConstraintName);
  2403. AssertIdentifierName('Correct table name','C',D.Definition.TableName);
  2404. AssertEquals('Correct field list count',1,D.Definition.FieldList.Count);
  2405. AssertIdentifierName('Correct field name','D',D.Definition.FieldList[0]);
  2406. AssertEquals('No on update action',AOnUpdate,D.Definition.OnUpdate);
  2407. AssertEquals('No on delete action',AOnDelete,D.Definition.OnDelete);
  2408. end;
  2409. procedure TTestTableParser.TestCreateOneSimpleField;
  2410. Var
  2411. C : TSQLCreateTableStatement;
  2412. F : TSQLTableFieldDef;
  2413. begin
  2414. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT)','A',TSQLCreateTableStatement));
  2415. AssertEquals('One field',1,C.FieldDefs.Count);
  2416. AssertEquals('No constraints',0,C.Constraints.Count);
  2417. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2418. AssertIdentifierName('fieldname','B',F.FieldName);
  2419. AssertNotNull('Have field type',F.FieldType);
  2420. AssertEquals('Correct field type',sdtInteger,F.FieldType.DataType);
  2421. end;
  2422. procedure TTestTableParser.TestCreateTwoSimpleFields;
  2423. Var
  2424. C : TSQLCreateTableStatement;
  2425. F : TSQLTableFieldDef;
  2426. begin
  2427. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT, C CHAR(5))','A',TSQLCreateTableStatement));
  2428. AssertEquals('Two fields',2,C.FieldDefs.Count);
  2429. AssertEquals('No constraints',0,C.Constraints.Count);
  2430. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2431. AssertIdentifierName('fieldname','B',F.FieldName);
  2432. AssertNotNull('Have field type',F.FieldType);
  2433. AssertEquals('Correct field type',sdtInteger,F.FieldType.DataType);
  2434. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[1],TSQLTableFieldDef));
  2435. AssertIdentifierName('fieldname','C',F.FieldName);
  2436. AssertNotNull('Have field type',F.FieldType);
  2437. AssertEquals('Correct field type',sdtChar,F.FieldType.DataType);
  2438. end;
  2439. procedure TTestTableParser.TestCreateOnePrimaryField;
  2440. Var
  2441. C : TSQLCreateTableStatement;
  2442. F : TSQLTableFieldDef;
  2443. P : TSQLPrimaryKeyFieldConstraint;
  2444. begin
  2445. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT PRIMARY KEY)','A',TSQLCreateTableStatement));
  2446. AssertEquals('One field',1,C.FieldDefs.Count);
  2447. AssertEquals('No constraints',0,C.Constraints.Count);
  2448. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2449. AssertIdentifierName('fieldname','B',F.FieldName);
  2450. AssertNotNull('Have field type',F.FieldType);
  2451. AssertEquals('Correct field type',sdtInteger,F.FieldType.DataType);
  2452. AssertNotNull('Have constraint',F.FieldType.Constraint);
  2453. P:=TSQLPrimaryKeyFieldConstraint(CheckClass(F.FieldType.Constraint,TSQLPrimaryKeyFieldConstraint));
  2454. AssertNull('No constraint name',P.ConstraintName);
  2455. end;
  2456. procedure TTestTableParser.TestCreateOneNamedPrimaryField;
  2457. Var
  2458. C : TSQLCreateTableStatement;
  2459. F : TSQLTableFieldDef;
  2460. P : TSQLPrimaryKeyFieldConstraint;
  2461. begin
  2462. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT CONSTRAINT C PRIMARY KEY)','A',TSQLCreateTableStatement));
  2463. AssertEquals('One field',1,C.FieldDefs.Count);
  2464. AssertEquals('No constraints',0,C.Constraints.Count);
  2465. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2466. AssertIdentifierName('fieldname','B',F.FieldName);
  2467. AssertNotNull('Have field type',F.FieldType);
  2468. AssertEquals('Correct field type',sdtInteger,F.FieldType.DataType);
  2469. AssertNotNull('Have constraint',F.FieldType.Constraint);
  2470. P:=TSQLPrimaryKeyFieldConstraint(CheckClass(F.FieldType.Constraint,TSQLPrimaryKeyFieldConstraint));
  2471. AssertIdentifierName('Constraint name','C',P.ConstraintName);
  2472. end;
  2473. procedure TTestTableParser.TestCreateOneUniqueField;
  2474. Var
  2475. C : TSQLCreateTableStatement;
  2476. F : TSQLTableFieldDef;
  2477. U : TSQLUniqueFieldConstraint;
  2478. begin
  2479. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT UNIQUE)','A',TSQLCreateTableStatement));
  2480. AssertEquals('One field',1,C.FieldDefs.Count);
  2481. AssertEquals('No constraints',0,C.Constraints.Count);
  2482. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2483. AssertIdentifierName('fieldname','B',F.FieldName);
  2484. AssertNotNull('Have field type',F.FieldType);
  2485. AssertEquals('Correct field type',sdtInteger,F.FieldType.DataType);
  2486. AssertNotNull('Have constraint',F.FieldType.Constraint);
  2487. U:=TSQLUniqueFieldConstraint(CheckClass(F.FieldType.Constraint,TSQLUniqueFieldConstraint));
  2488. AssertNull('No constraint name',U.ConstraintName);
  2489. end;
  2490. procedure TTestTableParser.TestCreateOneNamedUniqueField;
  2491. Var
  2492. C : TSQLCreateTableStatement;
  2493. F : TSQLTableFieldDef;
  2494. U : TSQLUniqueFieldConstraint;
  2495. begin
  2496. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT CONSTRAINT C UNIQUE)','A',TSQLCreateTableStatement));
  2497. AssertEquals('One field',1,C.FieldDefs.Count);
  2498. AssertEquals('No constraints',0,C.Constraints.Count);
  2499. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2500. AssertIdentifierName('fieldname','B',F.FieldName);
  2501. AssertNotNull('Have field type',F.FieldType);
  2502. AssertEquals('Correct field type',sdtInteger,F.FieldType.DataType);
  2503. AssertNotNull('Have constraint',F.FieldType.Constraint);
  2504. U:=TSQLUniqueFieldConstraint(CheckClass(F.FieldType.Constraint,TSQLUniqueFieldConstraint));
  2505. AssertIdentifierName('Constraint name','C',U.ConstraintName);
  2506. end;
  2507. procedure TTestTableParser.TestCreateNotNullPrimaryField;
  2508. Var
  2509. C : TSQLCreateTableStatement;
  2510. F : TSQLTableFieldDef;
  2511. begin
  2512. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT NOT NULL PRIMARY KEY)','A',TSQLCreateTableStatement));
  2513. AssertEquals('One field',1,C.FieldDefs.Count);
  2514. AssertEquals('No constraints',0,C.Constraints.Count);
  2515. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2516. AssertIdentifierName('fieldname','B',F.FieldName);
  2517. AssertNotNull('Have field type',F.FieldType);
  2518. AssertEquals('Correct field type',sdtInteger,F.FieldType.DataType);
  2519. AssertEquals('Field is not NULL',true,F.FieldType.NotNull);
  2520. AssertNotNull('Have constraint',F.FieldType.Constraint);
  2521. CheckClass(F.FieldType.Constraint,TSQLPrimaryKeyFieldConstraint);
  2522. end;
  2523. procedure TTestTableParser.TestCreateNotNullDefaultPrimaryField;
  2524. Var
  2525. C : TSQLCreateTableStatement;
  2526. F : TSQLTableFieldDef;
  2527. begin
  2528. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT DEFAULT 0 NOT NULL PRIMARY KEY)','A',TSQLCreateTableStatement));
  2529. AssertEquals('One field',1,C.FieldDefs.Count);
  2530. AssertEquals('No constraints',0,C.Constraints.Count);
  2531. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2532. AssertIdentifierName('fieldname','B',F.FieldName);
  2533. AssertNotNull('Have field type',F.FieldType);
  2534. AssertEquals('Correct field type',sdtInteger,F.FieldType.DataType);
  2535. AssertEquals('Field is not NULL',true,F.FieldType.NotNull);
  2536. AssertNotNull('Have default',F.FieldType.DefaultValue);
  2537. CheckClass(F.FieldType.DefaultValue,TSQLIntegerLiteral);
  2538. AssertNotNull('Have constraint',F.FieldType.Constraint);
  2539. CheckClass(F.FieldType.Constraint,TSQLPrimaryKeyFieldConstraint);
  2540. end;
  2541. procedure TTestTableParser.TestCreateCheckField;
  2542. Var
  2543. C : TSQLCreateTableStatement;
  2544. F : TSQLTableFieldDef;
  2545. B : TSQLBinaryExpression;
  2546. CC : TSQLCheckFieldConstraint;
  2547. begin
  2548. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT CHECK (B<>0))','A',TSQLCreateTableStatement));
  2549. AssertEquals('One field',1,C.FieldDefs.Count);
  2550. AssertEquals('No constraints',0,C.Constraints.Count);
  2551. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2552. AssertIdentifierName('fieldname','B',F.FieldName);
  2553. AssertNotNull('Have field type',F.FieldType);
  2554. AssertEquals('Correct field type',sdtInteger,F.FieldType.DataType);
  2555. AssertNull('Have no default',F.FieldType.DefaultValue);
  2556. AssertNull('Fieldtype has no check',F.FieldType.Check);
  2557. AssertNotNull('Field has constraint check',F.FieldType.Constraint);
  2558. CC:=TSQLCheckFieldConstraint(CheckClass(F.FieldType.Constraint,TSQLCheckFieldConstraint));
  2559. AssertNull('No constraint name',CC.ConstraintName);
  2560. B:=TSQLBinaryExpression(CheckClass(CC.Expression,TSQLBinaryExpression));
  2561. AssertEquals('Unequal check',boNE,B.Operation);
  2562. end;
  2563. procedure TTestTableParser.TestCreateNamedCheckField;
  2564. Var
  2565. C : TSQLCreateTableStatement;
  2566. F : TSQLTableFieldDef;
  2567. B : TSQLBinaryExpression;
  2568. CC : TSQLCheckFieldConstraint;
  2569. begin
  2570. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT CONSTRAINT C CHECK (B<>0))','A',TSQLCreateTableStatement));
  2571. AssertEquals('One field',1,C.FieldDefs.Count);
  2572. AssertEquals('No constraints',0,C.Constraints.Count);
  2573. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2574. AssertIdentifierName('fieldname','B',F.FieldName);
  2575. AssertNotNull('Have field type',F.FieldType);
  2576. AssertEquals('Correct field type',sdtInteger,F.FieldType.DataType);
  2577. AssertNull('Have no default',F.FieldType.DefaultValue);
  2578. AssertNull('Fieldtype has no check',F.FieldType.Check);
  2579. AssertNotNull('Field has constraint check',F.FieldType.Constraint);
  2580. CC:=TSQLCheckFieldConstraint(CheckClass(F.FieldType.Constraint,TSQLCheckFieldConstraint));
  2581. AssertidentifierName('Constraint name','C',CC.ConstraintName);
  2582. B:=TSQLBinaryExpression(CheckClass(CC.Expression,TSQLBinaryExpression));
  2583. AssertEquals('Unequal check',boNE,B.Operation);
  2584. end;
  2585. procedure TTestTableParser.TestCreateReferencesField;
  2586. begin
  2587. DoTestCreateReferencesField('CREATE TABLE A (B INT REFERENCES C(D))',fkaNone,fkaNone);
  2588. end;
  2589. procedure TTestTableParser.TestCreateReferencesOnUpdateCascadeField;
  2590. begin
  2591. DoTestCreateReferencesField('CREATE TABLE A (B INT REFERENCES C(D) ON UPDATE CASCADE)',fkaCascade,fkaNone);
  2592. end;
  2593. procedure TTestTableParser.TestCreateReferencesOnUpdateNoActionField;
  2594. begin
  2595. DoTestCreateReferencesField('CREATE TABLE A (B INT REFERENCES C(D) ON UPDATE NO ACTION)',fkaNoAction,fkaNone);
  2596. end;
  2597. procedure TTestTableParser.TestCreateReferencesOnUpdateSetDefaultField;
  2598. begin
  2599. DoTestCreateReferencesField('CREATE TABLE A (B INT REFERENCES C(D) ON UPDATE SET DEFAULT)',fkaSetDefault,fkaNone);
  2600. end;
  2601. procedure TTestTableParser.TestCreateReferencesOnUpdateSetNullField;
  2602. begin
  2603. DoTestCreateReferencesField('CREATE TABLE A (B INT REFERENCES C(D) ON UPDATE SET NULL)',fkaSetNull,fkaNone);
  2604. end;
  2605. procedure TTestTableParser.TestCreateReferencesOnDeleteCascadeField;
  2606. begin
  2607. DoTestCreateReferencesField('CREATE TABLE A (B INT REFERENCES C(D) ON DELETE CASCADE)',fkaNone,fkaCascade);
  2608. end;
  2609. procedure TTestTableParser.TestCreateReferencesOnDeleteNoActionField;
  2610. begin
  2611. DoTestCreateReferencesField('CREATE TABLE A (B INT REFERENCES C(D) ON DELETE NO ACTION)',fkaNone,fkaNoAction);
  2612. end;
  2613. procedure TTestTableParser.TestCreateReferencesOnDeleteSetDefaultField;
  2614. begin
  2615. DoTestCreateReferencesField('CREATE TABLE A (B INT REFERENCES C(D) ON DELETE SET DEFAULT)',fkaNone,fkaSetDefault);
  2616. end;
  2617. procedure TTestTableParser.TestCreateReferencesOnDeleteSetNullField;
  2618. begin
  2619. DoTestCreateReferencesField('CREATE TABLE A (B INT REFERENCES C(D) ON DELETE SET NULL)',fkaNone,fkaSetNull);
  2620. end;
  2621. procedure TTestTableParser.TestCreateReferencesOnUpdateAndDeleteSetNullField;
  2622. begin
  2623. DoTestCreateReferencesField('CREATE TABLE A (B INT REFERENCES C(D) ON UPDATE SET NULL ON DELETE SET NULL)',fkaSetNull,fkaSetNull);
  2624. end;
  2625. procedure TTestTableParser.TestCreateNamedReferencesField;
  2626. Var
  2627. C : TSQLCreateTableStatement;
  2628. F : TSQLTableFieldDef;
  2629. D : TSQLForeignKeyFieldConstraint;
  2630. begin
  2631. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT CONSTRAINT FK REFERENCES C(D))','A',TSQLCreateTableStatement));
  2632. AssertEquals('One field',1,C.FieldDefs.Count);
  2633. AssertEquals('No constraints',0,C.Constraints.Count);
  2634. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2635. AssertIdentifierName('fieldname','B',F.FieldName);
  2636. AssertNotNull('Have field type',F.FieldType);
  2637. AssertEquals('Correct field type',sdtInteger,F.FieldType.DataType);
  2638. AssertEquals('Field can be NULL',false,F.FieldType.NotNull);
  2639. AssertNull('Have default',F.FieldType.DefaultValue);
  2640. AssertNotNull('Have constraint',F.FieldType.Constraint);
  2641. D:=TSQLForeignKeyFieldConstraint(CheckClass(F.FieldType.Constraint,TSQLForeignKeyFieldConstraint));
  2642. AssertIdentifierName('Correct constraint name','FK',D.ConstraintName);
  2643. AssertIdentifierName('Correct table name','C',D.Definition.TableName);
  2644. AssertEquals('Correct field list count',1,D.Definition.FieldList.Count);
  2645. AssertIdentifierName('Correct field name','D',D.Definition.FieldList[0]);
  2646. end;
  2647. procedure TTestTableParser.TestCreateComputedByField;
  2648. Var
  2649. C : TSQLCreateTableStatement;
  2650. F : TSQLTableFieldDef;
  2651. B : TSQLBinaryExpression;
  2652. begin
  2653. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT, C INT, D COMPUTED BY (B+C))','A',TSQLCreateTableStatement));
  2654. AssertEquals('Three fields',3,C.FieldDefs.Count);
  2655. AssertEquals('No constraints',0,C.Constraints.Count);
  2656. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[2],TSQLTableFieldDef));
  2657. AssertIdentifierName('fieldname','D',F.FieldName);
  2658. AssertNull('No field type',F.FieldType);
  2659. AssertNotNull('Have computed by expression',F.ComputedBy);
  2660. B:=TSQLBinaryExpression(CheckClass(F.ComputedBy,TSQLBinaryExpression));
  2661. AssertEquals('Add operation',boAdd,B.Operation);
  2662. CheckClass(B.Left,TSQLIdentifierExpression);
  2663. AssertIdentifierName('Correct identifier','B',TSQLIdentifierExpression(B.Left).Identifier);
  2664. CheckClass(B.Right,TSQLIdentifierExpression);
  2665. AssertIdentifierName('Correct identifier','C',TSQLIdentifierExpression(B.Right).Identifier);
  2666. end;
  2667. procedure TTestTableParser.TestCreatePrimaryKeyConstraint;
  2668. Var
  2669. C : TSQLCreateTableStatement;
  2670. F : TSQLTableFieldDef;
  2671. P: TSQLTablePrimaryKeyConstraintDef;
  2672. begin
  2673. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT, PRIMARY KEY (B))','A',TSQLCreateTableStatement));
  2674. AssertEquals('One field',1,C.FieldDefs.Count);
  2675. AssertEquals('One constraints',1,C.Constraints.Count);
  2676. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2677. AssertIdentifierName('fieldname','B',F.FieldName);
  2678. P:=TSQLTablePrimaryKeyConstraintDef(CheckClass(C.Constraints[0],TSQLTablePrimaryKeyConstraintDef));
  2679. AssertNotNull('Fieldlist assigned',P.FieldList);
  2680. AssertNull('Constraint name empty',P.ConstraintName);
  2681. AssertEquals('One field in primary key',1,P.FieldList.Count);
  2682. AssertIdentifierName('fieldname','B',P.FieldList[0]);
  2683. end;
  2684. procedure TTestTableParser.TestCreateNamedPrimaryKeyConstraint;
  2685. Var
  2686. C : TSQLCreateTableStatement;
  2687. F : TSQLTableFieldDef;
  2688. P: TSQLTablePrimaryKeyConstraintDef;
  2689. begin
  2690. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT, CONSTRAINT A_PK PRIMARY KEY (B))','A',TSQLCreateTableStatement));
  2691. AssertEquals('One field',1,C.FieldDefs.Count);
  2692. AssertEquals('One constraints',1,C.Constraints.Count);
  2693. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2694. AssertIdentifierName('fieldname','B',F.FieldName);
  2695. P:=TSQLTablePrimaryKeyConstraintDef(CheckClass(C.Constraints[0],TSQLTablePrimaryKeyConstraintDef));
  2696. AssertNotNull('Fieldlist assigned',P.FieldList);
  2697. AssertIdentifierName('fieldname','A_PK',P.ConstraintName);
  2698. AssertEquals('One field in primary key',1,P.FieldList.Count);
  2699. AssertIdentifierName('fieldname','B',P.FieldList[0]);
  2700. end;
  2701. procedure TTestTableParser.TestCreateForeignKeyConstraint;
  2702. Var
  2703. C : TSQLCreateTableStatement;
  2704. F : TSQLTableFieldDef;
  2705. P: TSQLTableForeignKeyConstraintDef;
  2706. begin
  2707. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT, FOREIGN KEY (B) REFERENCES C(D))','A',TSQLCreateTableStatement));
  2708. AssertEquals('One field',1,C.FieldDefs.Count);
  2709. AssertEquals('One constraints',1,C.Constraints.Count);
  2710. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2711. AssertIdentifierName('fieldname','B',F.FieldName);
  2712. P:=TSQLTableForeignKeyConstraintDef(CheckClass(C.Constraints[0],TSQLTableForeignKeyConstraintDef));
  2713. AssertNotNull('Fieldlist assigned',P.FieldList);
  2714. AssertNull('Constraint name',P.ConstraintName);
  2715. AssertEquals('One field in foreign key',1,P.FieldList.Count);
  2716. AssertIdentifierName('fieldname','B',P.FieldList[0]);
  2717. AssertIdentifierName('Target table name','C',P.Definition.TableName);
  2718. AssertEquals('One field in primary key target',1,P.Definition.FieldList.Count);
  2719. AssertIdentifierName('target fieldname','D',P.Definition.FieldList[0]);
  2720. end;
  2721. procedure TTestTableParser.TestCreateNamedForeignKeyConstraint;
  2722. Var
  2723. C : TSQLCreateTableStatement;
  2724. F : TSQLTableFieldDef;
  2725. P: TSQLTableForeignKeyConstraintDef;
  2726. begin
  2727. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT, CONSTRAINT A_FK FOREIGN KEY (B) REFERENCES C(D))','A',TSQLCreateTableStatement));
  2728. AssertEquals('One field',1,C.FieldDefs.Count);
  2729. AssertEquals('One constraints',1,C.Constraints.Count);
  2730. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2731. AssertIdentifierName('fieldname','B',F.FieldName);
  2732. P:=TSQLTableForeignKeyConstraintDef(CheckClass(C.Constraints[0],TSQLTableForeignKeyConstraintDef));
  2733. AssertNotNull('Fieldlist assigned',P.FieldList);
  2734. AssertIdentifierName('fieldname','A_FK',P.ConstraintName);
  2735. AssertEquals('One field in foreign key',1,P.FieldList.Count);
  2736. AssertIdentifierName('fieldname','B',P.FieldList[0]);
  2737. AssertIdentifierName('Target table name','C',P.Definition.TableName);
  2738. AssertEquals('One field in primary key target',1,P.Definition.FieldList.Count);
  2739. AssertIdentifierName('target fieldname','D',P.Definition.FieldList[0]);
  2740. end;
  2741. procedure TTestTableParser.TestCreateUniqueConstraint;
  2742. Var
  2743. C : TSQLCreateTableStatement;
  2744. F : TSQLTableFieldDef;
  2745. P: TSQLTableUniqueConstraintDef;
  2746. begin
  2747. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT, UNIQUE (B))','A',TSQLCreateTableStatement));
  2748. AssertEquals('One field',1,C.FieldDefs.Count);
  2749. AssertEquals('One constraints',1,C.Constraints.Count);
  2750. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2751. AssertIdentifierName('fieldname','B',F.FieldName);
  2752. P:=TSQLTableUniqueConstraintDef(CheckClass(C.Constraints[0],TSQLTableUniqueConstraintDef));
  2753. AssertNotNull('Fieldlist assigned',P.FieldList);
  2754. AssertNull('Constraint name empty',P.ConstraintName);
  2755. AssertEquals('One field in primary key',1,P.FieldList.Count);
  2756. AssertIdentifierName('Name is correct','B',P.FieldList[0]);
  2757. end;
  2758. procedure TTestTableParser.TestCreateNamedUniqueConstraint;
  2759. Var
  2760. C : TSQLCreateTableStatement;
  2761. F : TSQLTableFieldDef;
  2762. P: TSQLTableUniqueConstraintDef;
  2763. begin
  2764. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT, CONSTRAINT U_A UNIQUE (B))','A',TSQLCreateTableStatement));
  2765. AssertEquals('One field',1,C.FieldDefs.Count);
  2766. AssertEquals('One constraints',1,C.Constraints.Count);
  2767. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2768. AssertIdentifierName('fieldname','B',F.FieldName);
  2769. P:=TSQLTableUniqueConstraintDef(CheckClass(C.Constraints[0],TSQLTableUniqueConstraintDef));
  2770. AssertNotNull('Fieldlist assigned',P.FieldList);
  2771. AssertIdentifierName('fieldname','U_A',P.ConstraintName);
  2772. AssertEquals('One field in primary key',1,P.FieldList.Count);
  2773. AssertIdentifierName('Name is correct','B',P.FieldList[0]);
  2774. end;
  2775. procedure TTestTableParser.TestCreateCheckConstraint;
  2776. Var
  2777. C : TSQLCreateTableStatement;
  2778. F : TSQLTableFieldDef;
  2779. B : TSQLBinaryExpression;
  2780. P: TSQLTableCheckConstraintDef;
  2781. begin
  2782. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT, CHECK (B<>0))','A',TSQLCreateTableStatement));
  2783. AssertEquals('One field',1,C.FieldDefs.Count);
  2784. AssertEquals('One constraints',1,C.Constraints.Count);
  2785. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2786. AssertIdentifierName('fieldname','B',F.FieldName);
  2787. P:=TSQLTableCheckConstraintDef(CheckClass(C.Constraints[0],TSQLTableCheckConstraintDef));
  2788. AssertNull('Constraint name empty',P.ConstraintName);
  2789. AssertNotNull('Check expression assigned',P.Check);
  2790. B:=TSQLBinaryExpression(CheckClass(P.Check,TSQLBinaryExpression));
  2791. AssertEquals('Unequal',boNE,B.Operation);
  2792. end;
  2793. procedure TTestTableParser.TestCreateNamedCheckConstraint;
  2794. Var
  2795. C : TSQLCreateTableStatement;
  2796. F : TSQLTableFieldDef;
  2797. B : TSQLBinaryExpression;
  2798. P: TSQLTableCheckConstraintDef;
  2799. begin
  2800. C:=TSQLCreateTableStatement(TestCreateStatement('CREATE TABLE A (B INT, CONSTRAINT C_A CHECK (B<>0))','A',TSQLCreateTableStatement));
  2801. AssertEquals('One field',1,C.FieldDefs.Count);
  2802. AssertEquals('One constraints',1,C.Constraints.Count);
  2803. F:=TSQLTableFieldDef(CheckClass(C.FieldDefs[0],TSQLTableFieldDef));
  2804. AssertIdentifierName('fieldname','B',F.FieldName);
  2805. P:=TSQLTableCheckConstraintDef(CheckClass(C.Constraints[0],TSQLTableCheckConstraintDef));
  2806. AssertIdentifierName('Constainrname','C_A',P.ConstraintName);
  2807. AssertNotNull('Check expression assigned',P.Check);
  2808. B:=TSQLBinaryExpression(CheckClass(P.Check,TSQLBinaryExpression));
  2809. AssertEquals('Not equal operation',boNE,B.Operation);
  2810. end;
  2811. procedure TTestTableParser.TestAlterDropField;
  2812. Var
  2813. A : TSQLAlterTableStatement;
  2814. D : TSQLDropTableFieldOperation;
  2815. begin
  2816. A:=TSQLAlterTableStatement(TestCreateStatement('ALTER TABLE A DROP B','A',TSQLAlterTableStatement));
  2817. AssertEquals('One operation',1,A.Operations.Count);
  2818. D:=TSQLDropTableFieldOperation(CheckClass(A.Operations[0],TSQLDropTableFieldOperation));
  2819. AssertidentifierName('Drop field name','B',D.ObjectName);
  2820. end;
  2821. procedure TTestTableParser.TestAlterDropFields;
  2822. Var
  2823. A : TSQLAlterTableStatement;
  2824. D : TSQLDropTableFieldOperation;
  2825. begin
  2826. A:=TSQLAlterTableStatement(TestCreateStatement('ALTER TABLE A DROP B, DROP C','A',TSQLAlterTableStatement));
  2827. AssertEquals('Two operations',2,A.Operations.Count);
  2828. D:=TSQLDropTableFieldOperation(CheckClass(A.Operations[0],TSQLDropTableFieldOperation));
  2829. AssertidentifierName('Drop field name','B',D.ObjectName);
  2830. D:=TSQLDropTableFieldOperation(CheckClass(A.Operations[1],TSQLDropTableFieldOperation));
  2831. AssertidentifierName('Drop field name','C',D.ObjectName);
  2832. end;
  2833. procedure TTestTableParser.TestAlterDropConstraint;
  2834. Var
  2835. A : TSQLAlterTableStatement;
  2836. D : TSQLDropTableConstraintOperation;
  2837. begin
  2838. A:=TSQLAlterTableStatement(TestCreateStatement('ALTER TABLE A DROP CONSTRAINT B','A',TSQLAlterTableStatement));
  2839. AssertEquals('One operation',1,A.Operations.Count);
  2840. D:=TSQLDropTableConstraintOperation(CheckClass(A.Operations[0],TSQLDropTableConstraintOperation));
  2841. AssertidentifierName('Drop field name','B',D.ObjectName);
  2842. end;
  2843. procedure TTestTableParser.TestAlterDropConstraints;
  2844. Var
  2845. A : TSQLAlterTableStatement;
  2846. D : TSQLDropTableConstraintOperation;
  2847. begin
  2848. A:=TSQLAlterTableStatement(TestCreateStatement('ALTER TABLE A DROP CONSTRAINT B, DROP CONSTRAINT C','A',TSQLAlterTableStatement));
  2849. AssertEquals('Two operations',2,A.Operations.Count);
  2850. D:=TSQLDropTableConstraintOperation(CheckClass(A.Operations[0],TSQLDropTableConstraintOperation));
  2851. AssertidentifierName('Drop Constraint name','B',D.ObjectName);
  2852. D:=TSQLDropTableConstraintOperation(CheckClass(A.Operations[1],TSQLDropTableConstraintOperation));
  2853. AssertidentifierName('Drop field name','C',D.ObjectName);
  2854. end;
  2855. procedure TTestTableParser.TestAlterRenameField;
  2856. Var
  2857. A : TSQLAlterTableStatement;
  2858. R : TSQLAlterTableFieldNameOperation;
  2859. begin
  2860. A:=TSQLAlterTableStatement(TestCreateStatement('ALTER TABLE A ALTER B TO C','A',TSQLAlterTableStatement));
  2861. AssertEquals('One operation',1,A.Operations.Count);
  2862. R:=TSQLAlterTableFieldNameOperation(CheckClass(A.Operations[0],TSQLAlterTableFieldNameOperation));
  2863. AssertidentifierName('Old field name','B',R.ObjectName);
  2864. AssertidentifierName('New field name','C',R.NewName);
  2865. end;
  2866. procedure TTestTableParser.TestAlterRenameColumnField;
  2867. Var
  2868. A : TSQLAlterTableStatement;
  2869. R : TSQLAlterTableFieldNameOperation;
  2870. begin
  2871. A:=TSQLAlterTableStatement(TestCreateStatement('ALTER TABLE A ALTER COLUMN B TO C','A',TSQLAlterTableStatement));
  2872. AssertEquals('One operation',1,A.Operations.Count);
  2873. R:=TSQLAlterTableFieldNameOperation(CheckClass(A.Operations[0],TSQLAlterTableFieldNameOperation));
  2874. AssertidentifierName('Old field name','B',R.ObjectName);
  2875. AssertidentifierName('New field name','C',R.NewName);
  2876. end;
  2877. procedure TTestTableParser.TestAlterFieldType;
  2878. Var
  2879. A : TSQLAlterTableStatement;
  2880. R : TSQLAlterTableFieldTypeOperation;
  2881. begin
  2882. A:=TSQLAlterTableStatement(TestCreateStatement('ALTER TABLE A ALTER COLUMN B TYPE INT','A',TSQLAlterTableStatement));
  2883. AssertEquals('One operation',1,A.Operations.Count);
  2884. R:=TSQLAlterTableFieldTypeOperation(CheckClass(A.Operations[0],TSQLAlterTableFieldTypeOperation));
  2885. AssertidentifierName('Old field name','B',R.ObjectName);
  2886. AssertNotNull('Have field type',R.NewType);
  2887. Checkclass(R.NewType,TSQLTypeDefinition);
  2888. AssertEquals('Correct data type',sdtInteger,R.NewType.DataType);
  2889. end;
  2890. procedure TTestTableParser.TestAlterFieldPosition;
  2891. Var
  2892. A : TSQLAlterTableStatement;
  2893. R : TSQLAlterTableFieldPositionOperation;
  2894. begin
  2895. A:=TSQLAlterTableStatement(TestCreateStatement('ALTER TABLE A ALTER COLUMN B POSITION 3','A',TSQLAlterTableStatement));
  2896. AssertEquals('One operation',1,A.Operations.Count);
  2897. R:=TSQLAlterTableFieldPositionOperation(CheckClass(A.Operations[0],TSQLAlterTableFieldPositionOperation));
  2898. AssertidentifierName('Old field name','B',R.ObjectName);
  2899. AssertEquals('Correct position',3,R.NewPosition);
  2900. end;
  2901. procedure TTestTableParser.TestAlterAddField;
  2902. Var
  2903. A : TSQLAlterTableStatement;
  2904. F : TSQLAlterTableAddFieldOperation;
  2905. D : TSQLTableFieldDef;
  2906. begin
  2907. A:=TSQLAlterTableStatement(TestCreateStatement('ALTER TABLE A ADD B INT','A',TSQLAlterTableStatement));
  2908. AssertEquals('One operation',1,A.Operations.Count);
  2909. F:=TSQLAlterTableAddFieldOperation(CheckClass(A.Operations[0],TSQLAlterTableAddFieldOperation));
  2910. AssertNotNull('Have element',F.Element);
  2911. D:=TSQLTableFieldDef(CheckClass(F.Element,TSQLTableFieldDef));
  2912. AssertIdentifierName('New field name','B',D.FieldName);
  2913. AssertNotNull('Have fielddef',D.FieldType);
  2914. AssertEquals('Correct field type',sdtINteger,D.FieldType.DataType);
  2915. end;
  2916. procedure TTestTableParser.TestAlterAddFields;
  2917. Var
  2918. A : TSQLAlterTableStatement;
  2919. F : TSQLAlterTableAddFieldOperation;
  2920. D : TSQLTableFieldDef;
  2921. begin
  2922. A:=TSQLAlterTableStatement(TestCreateStatement('ALTER TABLE A ADD B INT, ADD C CHAR(50)','A',TSQLAlterTableStatement));
  2923. AssertEquals('Two operations',2,A.Operations.Count);
  2924. F:=TSQLAlterTableAddFieldOperation(CheckClass(A.Operations[0],TSQLAlterTableAddFieldOperation));
  2925. AssertNotNull('Have element',F.Element);
  2926. D:=TSQLTableFieldDef(CheckClass(F.Element,TSQLTableFieldDef));
  2927. AssertIdentifierName('New field name','B',D.FieldName);
  2928. AssertNotNull('Have fielddef',D.FieldType);
  2929. AssertEquals('Correct field type',sdtINteger,D.FieldType.DataType);
  2930. F:=TSQLAlterTableAddFieldOperation(CheckClass(A.Operations[1],TSQLAlterTableAddFieldOperation));
  2931. AssertNotNull('Have element',F.Element);
  2932. D:=TSQLTableFieldDef(CheckClass(F.Element,TSQLTableFieldDef));
  2933. AssertIdentifierName('New field name','C',D.FieldName);
  2934. AssertNotNull('Have fielddef',D.FieldType);
  2935. AssertEquals('Correct field type',sdtChar,D.FieldType.DataType);
  2936. AssertEquals('Correct field lengthe',50,D.FieldType.Len);
  2937. end;
  2938. procedure TTestTableParser.TestAlterAddPrimarykey;
  2939. Var
  2940. A : TSQLAlterTableStatement;
  2941. F : TSQLAlterTableAddConstraintOperation;
  2942. D : TSQLTablePrimaryKeyConstraintDef;
  2943. begin
  2944. A:=TSQLAlterTableStatement(TestCreateStatement('ALTER TABLE A ADD PRIMARY KEY (B)','A',TSQLAlterTableStatement));
  2945. AssertEquals('One operation',1,A.Operations.Count);
  2946. F:=TSQLAlterTableAddConstraintOperation(CheckClass(A.Operations[0],TSQLAlterTableAddConstraintOperation));
  2947. AssertNotNull('Have element',F.Element);
  2948. D:=TSQLTablePrimaryKeyConstraintDef(CheckClass(F.Element,TSQLTablePrimaryKeyConstraintDef));
  2949. AssertNull('No constraint name',D.ConstraintName);
  2950. AssertEquals('Have 1 field',1,D.FieldList.Count);
  2951. AssertIdentifierName('fieldname','B',D.FieldList[0]);
  2952. end;
  2953. procedure TTestTableParser.TestAlterAddNamedPrimarykey;
  2954. Var
  2955. A : TSQLAlterTableStatement;
  2956. F : TSQLAlterTableAddConstraintOperation;
  2957. D : TSQLTablePrimaryKeyConstraintDef;
  2958. begin
  2959. A:=TSQLAlterTableStatement(TestCreateStatement('ALTER TABLE A ADD CONSTRAINT U_K PRIMARY KEY (B)','A',TSQLAlterTableStatement));
  2960. AssertEquals('One operation',1,A.Operations.Count);
  2961. F:=TSQLAlterTableAddConstraintOperation(CheckClass(A.Operations[0],TSQLAlterTableAddConstraintOperation));
  2962. AssertNotNull('Have element',F.Element);
  2963. D:=TSQLTablePrimaryKeyConstraintDef(CheckClass(F.Element,TSQLTablePrimaryKeyConstraintDef));
  2964. AssertIdentifierName('No constraint name','U_K',D.ConstraintName);
  2965. AssertEquals('Have 1 field',1,D.FieldList.Count);
  2966. AssertIdentifierName('fieldname','B',D.FieldList[0]);
  2967. end;
  2968. procedure TTestTableParser.TestAlterAddCheckConstraint;
  2969. Var
  2970. A : TSQLAlterTableStatement;
  2971. F : TSQLAlterTableAddConstraintOperation;
  2972. D : TSQLTableCheckConstraintDef;
  2973. begin
  2974. A:=TSQLAlterTableStatement(TestCreateStatement('ALTER TABLE A ADD CHECK (B<>0)','A',TSQLAlterTableStatement));
  2975. AssertEquals('One operation',1,A.Operations.Count);
  2976. F:=TSQLAlterTableAddConstraintOperation(CheckClass(A.Operations[0],TSQLAlterTableAddConstraintOperation));
  2977. AssertNotNull('Have element',F.Element);
  2978. D:=TSQLTableCheckConstraintDef(CheckClass(F.Element,TSQLTableCheckConstraintDef));
  2979. AssertNull('Constaintname',D.ConstraintName);
  2980. AssertNotNull('Check expression assigned',D.Check);
  2981. CheckClass(D.Check,TSQLBinaryExpression);
  2982. end;
  2983. procedure TTestTableParser.TestAlterAddNamedCheckConstraint;
  2984. Var
  2985. A : TSQLAlterTableStatement;
  2986. F : TSQLAlterTableAddConstraintOperation;
  2987. D : TSQLTableCheckConstraintDef;
  2988. begin
  2989. A:=TSQLAlterTableStatement(TestCreateStatement('ALTER TABLE A ADD CONSTRAINT C_A CHECK (B<>0)','A',TSQLAlterTableStatement));
  2990. AssertEquals('One operation',1,A.Operations.Count);
  2991. F:=TSQLAlterTableAddConstraintOperation(CheckClass(A.Operations[0],TSQLAlterTableAddConstraintOperation));
  2992. AssertNotNull('Have element',F.Element);
  2993. D:=TSQLTableCheckConstraintDef(CheckClass(F.Element,TSQLTableCheckConstraintDef));
  2994. AssertIdentifierName('Constaintname','C_A',D.ConstraintName);
  2995. AssertNotNull('Check expression assigned',D.Check);
  2996. CheckClass(D.Check,TSQLBinaryExpression);
  2997. end;
  2998. procedure TTestTableParser.TestAlterAddForeignkey;
  2999. Var
  3000. A : TSQLAlterTableStatement;
  3001. F : TSQLAlterTableAddConstraintOperation;
  3002. D : TSQLTableForeignKeyConstraintDef;
  3003. begin
  3004. A:=TSQLAlterTableStatement(TestCreateStatement('ALTER TABLE A ADD FOREIGN KEY (B) REFERENCES C(D)','A',TSQLAlterTableStatement));
  3005. AssertEquals('One operation',1,A.Operations.Count);
  3006. F:=TSQLAlterTableAddConstraintOperation(CheckClass(A.Operations[0],TSQLAlterTableAddConstraintOperation));
  3007. AssertNotNull('Have element',F.Element);
  3008. D:=TSQLTableForeignKeyConstraintDef(CheckClass(F.Element,TSQLTableForeignKeyConstraintDef));
  3009. AssertNull('No constraint name',D.ConstraintName);
  3010. AssertEquals('Have 1 field',1,D.FieldList.Count);
  3011. AssertIdentifierName('fieldname','B',D.FieldList[0]);
  3012. AssertIdentifierName('Target table name','C',D.Definition.TableName);
  3013. AssertEquals('One field in primary key target',1,D.Definition.FieldList.Count);
  3014. AssertIdentifierName('target fieldname','D',D.Definition.FieldList[0]);
  3015. end;
  3016. procedure TTestTableParser.TestAlterAddNamedForeignkey;
  3017. Var
  3018. A : TSQLAlterTableStatement;
  3019. F : TSQLAlterTableAddConstraintOperation;
  3020. D : TSQLTableForeignKeyConstraintDef;
  3021. begin
  3022. A:=TSQLAlterTableStatement(TestCreateStatement('ALTER TABLE A ADD CONSTRAINT F_A FOREIGN KEY (B) REFERENCES C(D)','A',TSQLAlterTableStatement));
  3023. AssertEquals('One operation',1,A.Operations.Count);
  3024. F:=TSQLAlterTableAddConstraintOperation(CheckClass(A.Operations[0],TSQLAlterTableAddConstraintOperation));
  3025. AssertNotNull('Have element',F.Element);
  3026. D:=TSQLTableForeignKeyConstraintDef(CheckClass(F.Element,TSQLTableForeignKeyConstraintDef));
  3027. AssertIdentifierName('constraint name','F_A',D.ConstraintName);
  3028. AssertEquals('Have 1 field',1,D.FieldList.Count);
  3029. AssertIdentifierName('fieldname','B',D.FieldList[0]);
  3030. AssertIdentifierName('Target table name','C',D.Definition.TableName);
  3031. AssertEquals('One field in primary key target',1,D.Definition.FieldList.Count);
  3032. AssertIdentifierName('target fieldname','D',D.Definition.FieldList[0]);
  3033. end;
  3034. { TTestDeleteParser }
  3035. function TTestDeleteParser.TestDelete(const ASource,ATable: String
  3036. ): TSQLDeleteStatement;
  3037. begin
  3038. CreateParser(ASource);
  3039. FToFree:=Parser.Parse;
  3040. Result:=TSQLDeleteStatement(CheckClass(FToFree,TSQLDeleteStatement));
  3041. AssertIdentifierName('Correct table name',ATable,Result.TableName);
  3042. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  3043. end;
  3044. procedure TTestDeleteParser.TestSimpleDelete;
  3045. Var
  3046. D : TSQLDeleteStatement;
  3047. begin
  3048. D:=TestDelete('DELETE FROM A','A');
  3049. AssertNull('No where',D.WhereClause);
  3050. end;
  3051. procedure TTestDeleteParser.TestSimpleDeleteAlias;
  3052. Var
  3053. D : TSQLDeleteStatement;
  3054. begin
  3055. D:=TestDelete('DELETE FROM A B','A');
  3056. AssertIdentifierName('Alias name','B',D.AliasName);
  3057. AssertNull('No where',D.WhereClause);
  3058. end;
  3059. procedure TTestDeleteParser.TestDeleteWhereNull;
  3060. Var
  3061. D : TSQLDeleteStatement;
  3062. B : TSQLBinaryExpression;
  3063. I : TSQLIdentifierExpression;
  3064. L : TSQLLiteralExpression;
  3065. begin
  3066. D:=TestDelete('DELETE FROM A WHERE B IS NULL','A');
  3067. AssertNotNull('No where',D.WhereClause);
  3068. B:=TSQLBinaryExpression(CheckClass(D.WhereClause,TSQLBinaryExpression));
  3069. AssertEquals('Is null operation',boIs,B.Operation);
  3070. I:=TSQLIdentifierExpression(CheckClass(B.Left,TSQLIdentifierExpression));
  3071. AssertIdentifierName('Correct field name','B',I.Identifier);
  3072. L:=TSQLLiteralExpression(CheckClass(B.Right,TSQLLiteralExpression));
  3073. CheckClass(L.Literal,TSQLNullLiteral);
  3074. end;
  3075. { TTestUpdateParser }
  3076. function TTestUpdateParser.TestUpdate(const ASource, ATable: String
  3077. ): TSQLUpdateStatement;
  3078. begin
  3079. CreateParser(ASource);
  3080. FToFree:=Parser.Parse;
  3081. Result:=TSQLUpdateStatement(CheckClass(FToFree,TSQLUpdateStatement));
  3082. AssertIdentifierName('Correct table name',ATable,Result.TableName);
  3083. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  3084. end;
  3085. procedure TTestUpdateParser.TestUpdateOneField;
  3086. Var
  3087. U : TSQLUpdateStatement;
  3088. P : TSQLUpdatePair;
  3089. E : TSQLLiteralExpression;
  3090. I : TSQLIntegerLiteral;
  3091. begin
  3092. U:=TestUpdate('UPDATE A SET B=1','A');
  3093. AssertEquals('One field updated',1,U.Values.Count);
  3094. P:=TSQLUpdatePair(CheckClass(U.Values[0],TSQLUpdatePair));
  3095. AssertIdentifierName('Correct field name','B',P.FieldName);
  3096. E:=TSQLLiteralExpression(CheckClass(P.Value,TSQLLiteralExpression));
  3097. I:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  3098. AssertEquals('Value 1',1,I.Value);
  3099. AssertNull('No where clause',U.WhereClause);
  3100. end;
  3101. procedure TTestUpdateParser.TestUpdateOneFieldFull;
  3102. Var
  3103. U : TSQLUpdateStatement;
  3104. P : TSQLUpdatePair;
  3105. E : TSQLLiteralExpression;
  3106. I : TSQLIntegerLiteral;
  3107. begin
  3108. U:=TestUpdate('UPDATE A SET A.B=1','A');
  3109. AssertEquals('One field updated',1,U.Values.Count);
  3110. P:=TSQLUpdatePair(CheckClass(U.Values[0],TSQLUpdatePair));
  3111. AssertIdentifierName('Correct field name','A.B',P.FieldName);
  3112. E:=TSQLLiteralExpression(CheckClass(P.Value,TSQLLiteralExpression));
  3113. I:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  3114. AssertEquals('Value 1',1,I.Value);
  3115. AssertNull('No where clause',U.WhereClause);
  3116. end;
  3117. procedure TTestUpdateParser.TestUpdateTwoFields;
  3118. Var
  3119. U : TSQLUpdateStatement;
  3120. P : TSQLUpdatePair;
  3121. E : TSQLLiteralExpression;
  3122. I : TSQLIntegerLiteral;
  3123. begin
  3124. U:=TestUpdate('UPDATE A SET B=1, C=2','A');
  3125. AssertEquals('One field updated',2,U.Values.Count);
  3126. P:=TSQLUpdatePair(CheckClass(U.Values[0],TSQLUpdatePair));
  3127. AssertIdentifierName('Correct field name','B',P.FieldName);
  3128. E:=TSQLLiteralExpression(CheckClass(P.Value,TSQLLiteralExpression));
  3129. I:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  3130. AssertEquals('Value 1',1,I.Value);
  3131. P:=TSQLUpdatePair(CheckClass(U.Values[1],TSQLUpdatePair));
  3132. AssertIdentifierName('Correct field name','C',P.FieldName);
  3133. E:=TSQLLiteralExpression(CheckClass(P.Value,TSQLLiteralExpression));
  3134. I:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  3135. AssertEquals('Value 2',2,I.Value);
  3136. AssertNull('No where clause',U.WhereClause);
  3137. end;
  3138. procedure TTestUpdateParser.TestUpdateOneFieldWhereIsNull;
  3139. Var
  3140. U : TSQLUpdateStatement;
  3141. P : TSQLUpdatePair;
  3142. E : TSQLLiteralExpression;
  3143. I : TSQLIntegerLiteral;
  3144. B : TSQLBinaryExpression;
  3145. IE : TSQLIdentifierExpression;
  3146. L : TSQLLiteralExpression;
  3147. begin
  3148. U:=TestUpdate('UPDATE A SET B=1 WHERE B IS NULL','A');
  3149. AssertEquals('One field updated',1,U.Values.Count);
  3150. P:=TSQLUpdatePair(CheckClass(U.Values[0],TSQLUpdatePair));
  3151. AssertIdentifierName('Correct field name','B',P.FieldName);
  3152. E:=TSQLLiteralExpression(CheckClass(P.Value,TSQLLiteralExpression));
  3153. I:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  3154. AssertEquals('Value 1',1,I.Value);
  3155. AssertNotNull('where clause',U.WhereClause);
  3156. B:=TSQLBinaryExpression(CheckClass(U.WhereClause,TSQLBinaryExpression));
  3157. AssertEquals('Is null operation',boIs,B.Operation);
  3158. IE:=TSQLIdentifierExpression(CheckClass(B.Left,TSQLIdentifierExpression));
  3159. AssertIdentifierName('Correct field name','B',IE.Identifier);
  3160. L:=TSQLLiteralExpression(CheckClass(B.Right,TSQLLiteralExpression));
  3161. CheckClass(L.Literal,TSQLNullLiteral);
  3162. end;
  3163. { TTestInsertParser }
  3164. function TTestInsertParser.TestInsert(const ASource, ATable: String
  3165. ): TSQLInsertStatement;
  3166. begin
  3167. CreateParser(ASource);
  3168. FToFree:=Parser.Parse;
  3169. Result:=TSQLInsertStatement(CheckClass(FToFree,TSQLInsertStatement));
  3170. AssertIdentifierName('Correct table name',ATable,Result.TableName);
  3171. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  3172. end;
  3173. procedure TTestInsertParser.TestInsertOneField;
  3174. Var
  3175. I : TSQLInsertStatement;
  3176. E : TSQLLiteralExpression;
  3177. L : TSQLIntegerLiteral;
  3178. begin
  3179. I:=TestInsert('INSERT INTO A (B) VALUES (1)','A');
  3180. AssertNotNull('Have fields',I.Fields);
  3181. AssertEquals('1 field',1,I.Fields.Count);
  3182. AssertIdentifierName('Correct field name','B',I.Fields[0]);
  3183. AssertNotNull('Have values',I.Values);
  3184. AssertEquals('Have 1 value',1,I.Values.Count);
  3185. E:=TSQLLiteralExpression(CheckClass(I.Values[0],TSQLLiteralExpression));
  3186. L:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  3187. AssertEquals('Correct value',1,L.Value);
  3188. end;
  3189. procedure TTestInsertParser.TestInsertTwoFields;
  3190. Var
  3191. I : TSQLInsertStatement;
  3192. E : TSQLLiteralExpression;
  3193. L : TSQLIntegerLiteral;
  3194. begin
  3195. I:=TestInsert('INSERT INTO A (B,C) VALUES (1,2)','A');
  3196. AssertNotNull('Have fields',I.Fields);
  3197. AssertEquals('2 fields',2,I.Fields.Count);
  3198. AssertIdentifierName('Correct field 1 name','B',I.Fields[0]);
  3199. AssertIdentifierName('Correct field 2 name','C',I.Fields[1]);
  3200. AssertNotNull('Have values',I.Values);
  3201. AssertEquals('Have 2 values',2,I.Values.Count);
  3202. E:=TSQLLiteralExpression(CheckClass(I.Values[0],TSQLLiteralExpression));
  3203. L:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  3204. AssertEquals('Correct value',1,L.Value);
  3205. E:=TSQLLiteralExpression(CheckClass(I.Values[1],TSQLLiteralExpression));
  3206. L:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  3207. AssertEquals('Correct value',2,L.Value);
  3208. end;
  3209. procedure TTestInsertParser.TestInsertOneValue;
  3210. Var
  3211. I : TSQLInsertStatement;
  3212. E : TSQLLiteralExpression;
  3213. L : TSQLIntegerLiteral;
  3214. begin
  3215. I:=TestInsert('INSERT INTO A VALUES (1)','A');
  3216. AssertNull('Have no fields',I.Fields);
  3217. AssertNotNull('Have values',I.Values);
  3218. AssertEquals('Have 1 value',1,I.Values.Count);
  3219. E:=TSQLLiteralExpression(CheckClass(I.Values[0],TSQLLiteralExpression));
  3220. L:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  3221. AssertEquals('Correct value',1,L.Value);
  3222. end;
  3223. procedure TTestInsertParser.TestInsertTwoValues;
  3224. Var
  3225. I : TSQLInsertStatement;
  3226. E : TSQLLiteralExpression;
  3227. L : TSQLIntegerLiteral;
  3228. begin
  3229. I:=TestInsert('INSERT INTO A VALUES (1,2)','A');
  3230. AssertNull('Have no fields',I.Fields);
  3231. AssertNotNull('Have values',I.Values);
  3232. AssertEquals('Have 2 values',2,I.Values.Count);
  3233. E:=TSQLLiteralExpression(CheckClass(I.Values[0],TSQLLiteralExpression));
  3234. L:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  3235. AssertEquals('Correct value',1,L.Value);
  3236. E:=TSQLLiteralExpression(CheckClass(I.Values[1],TSQLLiteralExpression));
  3237. L:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  3238. AssertEquals('Correct value',2,L.Value);
  3239. end;
  3240. { TTestSelectParser }
  3241. function TTestSelectParser.TestSelect(const ASource: String; AOptions: TParserOptions;
  3242. AScannerOptions: TSQLScannerOptions): TSQLSelectStatement;
  3243. begin
  3244. CreateParser(ASource,AOptions);
  3245. Parser.Scanner.Options:=AScannerOptions;
  3246. FToFree:=Parser.Parse;
  3247. Result:=TSQLSelectStatement(CheckClass(FToFree,TSQLSelectStatement));
  3248. FSelect:=Result;
  3249. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  3250. end;
  3251. procedure TTestSelectParser.TestSelectError(const ASource: String);
  3252. begin
  3253. FErrSource:=ASource;
  3254. AssertException(ESQLParser,@TestParseError);
  3255. end;
  3256. procedure TTestSelectParser.TestSelectFieldAsStringLiteral;
  3257. Var
  3258. F : TSQLSelectField;
  3259. L : TSQLStringLiteral;
  3260. begin
  3261. TestSelect('SELECT ''B'' ''C'''); // 'B' as 'C'
  3262. AssertEquals('One field',1,Select.Fields.Count);
  3263. F:=TSQLSelectField(CheckClass(Select.Fields[0],TSQLSelectField));
  3264. AssertNotNull('Have field expresssion,',F.Expression);
  3265. L:=TSQLStringLiteral(AssertLiteralExpr('Field is a literal',F.Expression,TSQLStringLiteral));
  3266. AssertEquals('Field literal is B','B',L.Value);
  3267. AssertEquals('Field alias is C','C',F.AliasName.Name);
  3268. AssertEquals('No table',0,Select.Tables.Count);
  3269. end;
  3270. procedure TTestSelectParser.TestSelectFieldWithSchema;
  3271. Var
  3272. Expr: TSQLIdentifierExpression;
  3273. begin
  3274. TestSelect('SELECT S.A.B,C FROM S.A');
  3275. AssertEquals('Two fields',2,Select.Fields.Count);
  3276. AssertField(Select.Fields[0],'B');
  3277. Expr := ((Select.Fields[0] as TSQLSelectField).Expression as TSQLIdentifierExpression);
  3278. AssertEquals('Field[0] path has 3 identifiers',3,Expr.IdentifierPath.Count);
  3279. AssertEquals('Field[0] schema is S','S',Expr.IdentifierPath[0].Name);
  3280. AssertEquals('Field[0] table is A','A',Expr.IdentifierPath[1].Name);
  3281. AssertField(Select.Fields[1],'C');
  3282. AssertEquals('One table',1,Select.Tables.Count);
  3283. AssertTable(Select.Tables[0],'A','');
  3284. AssertEquals('Table path has 2 objects',2,(Select.Tables[0] as TSQLSimpleTableReference).ObjectNamePath.Count);
  3285. AssertEquals('Schema name = S','S',(Select.Tables[0] as TSQLSimpleTableReference).ObjectNamePath[0].Name);
  3286. end;
  3287. procedure TTestSelectParser.TestSelectFirst;
  3288. begin
  3289. // FireBird
  3290. TestSelect('SELECT FIRST 100 A FROM B');
  3291. AssertEquals('Limit style',Ord(lsFireBird),Ord(Select.Limit.Style));
  3292. AssertEquals('Limit FIRST 100',100,Select.Limit.First);
  3293. end;
  3294. procedure TTestSelectParser.TestSelectFirstSkip;
  3295. begin
  3296. // FireBird
  3297. TestSelect('SELECT FIRST 100 SKIP 200 A FROM B');
  3298. AssertEquals('Limit style',Ord(lsFireBird),Ord(Select.Limit.Style));
  3299. AssertEquals('Limit FIRST 100',100,Select.Limit.First);
  3300. AssertEquals('Limit SKIP 200',200,Select.Limit.Skip);
  3301. end;
  3302. procedure TTestSelectParser.TestSelectLimit;
  3303. begin
  3304. // MySQL&Postgres
  3305. TestSelect('SELECT A FROM B LIMIT 100');
  3306. AssertEquals('Limit style',Ord(lsPostgres),Ord(Select.Limit.Style));
  3307. AssertEquals('Limit RowCount 100',100,Select.Limit.RowCount);
  3308. end;
  3309. procedure TTestSelectParser.TestSelectLimitAll;
  3310. begin
  3311. // Postgres
  3312. TestSelect('SELECT A FROM B LIMIT ALL');
  3313. AssertEquals('Limit style',Ord(lsPostgres),Ord(Select.Limit.Style));
  3314. AssertEquals('Limit RowCount -1',-1,Select.Limit.RowCount);
  3315. end;
  3316. procedure TTestSelectParser.TestSelectLimitAllOffset;
  3317. begin
  3318. // Postgres
  3319. TestSelect('SELECT A FROM B LIMIT ALL OFFSET 200');
  3320. AssertEquals('Limit style',Ord(lsPostgres),Ord(Select.Limit.Style));
  3321. AssertEquals('Limit Offset 200',200,Select.Limit.Offset);
  3322. end;
  3323. procedure TTestSelectParser.TestSelectLimitOffset1;
  3324. begin
  3325. // MySQL
  3326. TestSelect('SELECT A FROM B LIMIT 200, 100');
  3327. AssertEquals('Limit style',Ord(lsPostgres),Ord(Select.Limit.Style));
  3328. AssertEquals('Limit RowCount 100',100,Select.Limit.RowCount);
  3329. AssertEquals('Limit Offset 200',200,Select.Limit.Offset);
  3330. end;
  3331. procedure TTestSelectParser.TestSelectLimitOffset2;
  3332. begin
  3333. // MySQL&Postgres
  3334. TestSelect('SELECT A FROM B LIMIT 100 OFFSET 200');
  3335. AssertEquals('Limit style',Ord(lsPostgres),Ord(Select.Limit.Style));
  3336. AssertEquals('Limit RowCount 100',100,Select.Limit.RowCount);
  3337. AssertEquals('Limit Offset 200',200,Select.Limit.Offset);
  3338. end;
  3339. procedure TTestSelectParser.TestSelectOffset;
  3340. begin
  3341. // Postgres
  3342. TestSelect('SELECT A FROM B OFFSET 200');
  3343. AssertEquals('Limit style',Ord(lsPostgres),Ord(Select.Limit.Style));
  3344. AssertEquals('Limit Offset 200',200,Select.Limit.Offset);
  3345. end;
  3346. procedure TTestSelectParser.TestSelectOneFieldOneTable;
  3347. begin
  3348. TestSelect('SELECT B FROM A');
  3349. AssertNull('No transaction name',Select.TransactionName);
  3350. AssertEquals('One field',1,Select.Fields.Count);
  3351. AssertField(Select.Fields[0],'B');
  3352. AssertEquals('One table',1,Select.Tables.Count);
  3353. AssertTable(Select.Tables[0],'A');
  3354. end;
  3355. procedure TTestSelectParser.TestSelectOneFieldOneTableTransaction;
  3356. begin
  3357. TestSelect('SELECT TRANSACTION C B FROM A');
  3358. AssertIdentifierName('Correct transaction name','C',Select.TransactionName);
  3359. AssertEquals('One field',1,Select.Fields.Count);
  3360. AssertField(Select.Fields[0],'B');
  3361. AssertEquals('One table',1,Select.Tables.Count);
  3362. AssertTable(Select.Tables[0],'A');
  3363. end;
  3364. procedure TTestSelectParser.TestSelectOneArrayFieldOneTable;
  3365. Var
  3366. E : TSQLIdentifierExpression;
  3367. begin
  3368. TestSelect('SELECT B[1] FROM A');
  3369. AssertEquals('One field',1,Select.Fields.Count);
  3370. AssertField(Select.Fields[0],'B');
  3371. E:=TSQLIdentifierExpression(CheckClass(TSQLSelectField(Select.Fields[0]).Expression,TSQLIdentifierExpression));
  3372. AssertEquals('Element 1 in array ',1,E.ElementIndex);
  3373. AssertEquals('One table',1,Select.Tables.Count);
  3374. AssertTable(Select.Tables[0],'A');
  3375. end;
  3376. procedure TTestSelectParser.TestSelectTwoFieldsOneTable;
  3377. begin
  3378. TestSelect('SELECT B,_C FROM A');
  3379. AssertEquals('Two fields',2,Select.Fields.Count);
  3380. AssertField(Select.Fields[0],'B');
  3381. AssertField(Select.Fields[1],'_C');
  3382. AssertEquals('One table',1,Select.Tables.Count);
  3383. AssertTable(Select.Tables[0],'A');
  3384. end;
  3385. procedure TTestSelectParser.TestSelectOneFieldAliasOneTable;
  3386. begin
  3387. TestSelect('SELECT B AS C FROM A');
  3388. AssertEquals('One field',1,Select.Fields.Count);
  3389. AssertField(Select.Fields[0],'B','C');
  3390. AssertEquals('One table',1,Select.Tables.Count);
  3391. AssertTable(Select.Tables[0],'A');
  3392. end;
  3393. procedure TTestSelectParser.TestSelectTwoFieldAliasesOneTable;
  3394. begin
  3395. TestSelect('SELECT B AS D,C AS E FROM A');
  3396. AssertEquals('Two fields',2,Select.Fields.Count);
  3397. AssertField(Select.Fields[0],'B','D');
  3398. AssertField(Select.Fields[1],'C','E');
  3399. AssertEquals('One table',1,Select.Tables.Count);
  3400. AssertTable(Select.Tables[0],'A');
  3401. end;
  3402. procedure TTestSelectParser.TestSelectOneTableFieldOneTable;
  3403. Var
  3404. Expr: TSQLIdentifierExpression;
  3405. begin
  3406. TestSelect('SELECT A.B FROM A');
  3407. AssertEquals('One field',1,Select.Fields.Count);
  3408. // Field supports linking/refering to a table
  3409. AssertField(Select.Fields[0],'B');
  3410. Expr := ((Select.Fields[0] as TSQLSelectField).Expression as TSQLIdentifierExpression);
  3411. AssertEquals('Field has explicit table',2,Expr.IdentifierPath.Count);
  3412. AssertEquals('Field has explicit table named A','A',Expr.IdentifierPath[0].Name);
  3413. AssertEquals('One table',1,Select.Tables.Count);
  3414. AssertTable(Select.Tables[0],'A');
  3415. end;
  3416. procedure TTestSelectParser.TestSelectTableWithSchema;
  3417. begin
  3418. TestSelect('SELECT B,C FROM S.A');
  3419. AssertEquals('Two fields',2,Select.Fields.Count);
  3420. AssertField(Select.Fields[0],'B');
  3421. AssertField(Select.Fields[1],'C');
  3422. AssertEquals('One table',1,Select.Tables.Count);
  3423. AssertTable(Select.Tables[0],'A','');
  3424. AssertEquals('Table path has 2 objects',2,(Select.Tables[0] as TSQLSimpleTableReference).ObjectNamePath.Count);
  3425. AssertEquals('Schema name = S','S',(Select.Tables[0] as TSQLSimpleTableReference).ObjectNamePath[0].Name);
  3426. end;
  3427. procedure TTestSelectParser.TestSelectTop;
  3428. begin
  3429. // MSSQL
  3430. TestSelect('SELECT TOP 100 A FROM B');
  3431. AssertEquals('Limit style',Ord(lsMSSQL),Ord(Select.Limit.Style));
  3432. AssertEquals('Limit TOP 100',100,Select.Limit.Top);
  3433. end;
  3434. procedure TTestSelectParser.TestSelectOneDistinctFieldOneTable;
  3435. begin
  3436. TestSelect('SELECT DISTINCT B FROM A');
  3437. AssertEquals('DISTINCT Query',True,Select.Distinct);
  3438. AssertEquals('One field',1,Select.Fields.Count);
  3439. AssertField(Select.Fields[0],'B');
  3440. AssertEquals('One table',1,Select.Tables.Count);
  3441. AssertTable(Select.Tables[0],'A');
  3442. end;
  3443. procedure TTestSelectParser.TestSelectOneAllFieldOneTable;
  3444. begin
  3445. TestSelect('SELECT ALL B FROM A');
  3446. AssertEquals('ALL Query',True,Select.All);
  3447. AssertEquals('One field',1,Select.Fields.Count);
  3448. AssertField(Select.Fields[0],'B');
  3449. AssertEquals('One table',1,Select.Tables.Count);
  3450. AssertTable(Select.Tables[0],'A');
  3451. end;
  3452. procedure TTestSelectParser.TestSelectAsteriskOneTable;
  3453. begin
  3454. TestSelect('SELECT * FROM A');
  3455. AssertEquals('One field',1,Select.Fields.Count);
  3456. CheckClass(Select.Fields[0],TSQLSelectAsterisk);
  3457. AssertEquals('One table',1,Select.Tables.Count);
  3458. AssertTable(Select.Tables[0],'A');
  3459. end;
  3460. procedure TTestSelectParser.TestSelectAsteriskWithPath;
  3461. begin
  3462. TestSelect('SELECT A.* FROM A');
  3463. AssertEquals('One field',1,Select.Fields.Count);
  3464. CheckClass(Select.Fields[0],TSQLSelectAsterisk);
  3465. AssertEquals('Path count = 1',1,TSQLSelectAsterisk(Select.Fields[0]).Expression.IdentifierPath.Count);
  3466. AssertEquals('Path table = A','A',TSQLSelectAsterisk(Select.Fields[0]).Expression.IdentifierPath[0].Name);
  3467. AssertEquals('One table',1,Select.Tables.Count);
  3468. AssertTable(Select.Tables[0],'A');
  3469. end;
  3470. procedure TTestSelectParser.TestSelectDistinctAsteriskOneTable;
  3471. begin
  3472. TestSelect('SELECT DISTINCT * FROM A');
  3473. AssertEquals('DISTINCT Query',True,Select.Distinct);
  3474. AssertEquals('One field',1,Select.Fields.Count);
  3475. CheckClass(Select.Fields[0],TSQLSelectAsterisk);
  3476. AssertEquals('One table',1,Select.Tables.Count);
  3477. AssertTable(Select.Tables[0],'A');
  3478. end;
  3479. procedure TTestSelectParser.TestSelectOneFieldOneTableAlias;
  3480. Var
  3481. Expr: TSQLIdentifierExpression;
  3482. begin
  3483. TestSelect('SELECT C.B FROM A C');
  3484. AssertEquals('One field',1,Select.Fields.Count);
  3485. AssertField(Select.Fields[0],'B');
  3486. Expr := ((Select.Fields[0] as TSQLSelectField).Expression as TSQLIdentifierExpression);
  3487. AssertEquals('Field has explicit table',2,Expr.IdentifierPath.Count);
  3488. AssertEquals('Field has explicit table named C','C',Expr.IdentifierPath[0].Name);
  3489. AssertEquals('One table',1,Select.Tables.Count);
  3490. AssertTable(Select.Tables[0],'A');
  3491. end;
  3492. procedure TTestSelectParser.TestSelectOneFieldOneTableAsAlias;
  3493. Var
  3494. Expr: TSQLIdentifierExpression;
  3495. begin
  3496. TestSelect('SELECT C.B FROM A AS C');
  3497. AssertEquals('One field',1,Select.Fields.Count);
  3498. AssertField(Select.Fields[0],'B');
  3499. Expr := ((Select.Fields[0] as TSQLSelectField).Expression as TSQLIdentifierExpression);
  3500. AssertEquals('Field has explicit table',2,Expr.IdentifierPath.Count);
  3501. AssertEquals('Field has explicit table named C','C',Expr.IdentifierPath[0].Name);
  3502. AssertEquals('One table',1,Select.Tables.Count);
  3503. AssertTable(Select.Tables[0],'A');
  3504. end;
  3505. procedure TTestSelectParser.TestSelectTwoFieldsTwoTables;
  3506. begin
  3507. TestSelect('SELECT B,C FROM A,D');
  3508. AssertEquals('Two fields',2,Select.Fields.Count);
  3509. AssertField(Select.Fields[0],'B');
  3510. AssertField(Select.Fields[1],'C');
  3511. AssertEquals('Two table',2,Select.Tables.Count);
  3512. AssertTable(Select.Tables[0],'A');
  3513. AssertTable(Select.Tables[1],'D');
  3514. end;
  3515. procedure TTestSelectParser.TestSelectTwoFieldsTwoTablesJoin;
  3516. Var
  3517. J : TSQLJoinTableReference;
  3518. begin
  3519. TestSelect('SELECT B,C FROM A JOIN D ON E=F');
  3520. AssertEquals('Two fields',2,Select.Fields.Count);
  3521. AssertField(Select.Fields[0],'B');
  3522. AssertField(Select.Fields[1],'C');
  3523. AssertEquals('One table',1,Select.Tables.Count);
  3524. J:=AssertJoin(Select.Tables[0],'A','D',jtNone);
  3525. AssertJoinOn(J.JoinClause,'E','F',boEq);
  3526. end;
  3527. procedure TTestSelectParser.TestSourcePosition;
  3528. begin
  3529. TestSelect('SELECT X FROM ABC ORDER BY Y');
  3530. AssertEquals('One table',1,Select.Tables.Count);
  3531. AssertEquals('FROM source line = 1', 1, Select.Tables.SourceLine);
  3532. AssertEquals('FROM source position = 10', 10, Select.Tables.SourcePos);
  3533. AssertEquals('ORDER BY source line = 1', 1, Select.Orderby.SourceLine);
  3534. AssertEquals('ORDER BY source position = 19', 19, Select.Orderby.SourcePos);
  3535. AssertEquals('Table source line = 1', 1, Select.Tables[0].SourceLine);
  3536. AssertEquals('Table source position = 15', 15, Select.Tables[0].SourcePos);
  3537. TestSelect('SELECT X'+sLineBreak+'FROM ABC'+sLineBreak+'ORDER BY Y');
  3538. AssertEquals('One table',1,Select.Tables.Count);
  3539. AssertEquals('FROM source line = 2', 2, Select.Tables.SourceLine);
  3540. AssertEquals('FROM source position = 1', 1, Select.Tables.SourcePos);
  3541. AssertEquals('ORDER BY source line = 3', 3, Select.Orderby.SourceLine);
  3542. AssertEquals('ORDER BY source position = 1', 1, Select.Orderby.SourcePos);
  3543. AssertEquals('Table source line = 2', 2, Select.Tables[0].SourceLine);
  3544. AssertEquals('Table source position = 6', 6, Select.Tables[0].SourcePos);
  3545. end;
  3546. procedure TTestSelectParser.TestSelectTwoFieldsTwoInnerTablesJoin;
  3547. Var
  3548. J : TSQLJoinTableReference;
  3549. begin
  3550. TestSelect('SELECT B,C FROM A INNER JOIN D ON E=F');
  3551. AssertEquals('Two fields',2,Select.Fields.Count);
  3552. AssertField(Select.Fields[0],'B');
  3553. AssertField(Select.Fields[1],'C');
  3554. AssertEquals('One table',1,Select.Tables.Count);
  3555. J:=AssertJoin(Select.Tables[0],'A','D',jtInner);
  3556. AssertJoinOn(J.JoinClause,'E','F',boEq);
  3557. end;
  3558. procedure TTestSelectParser.TestSelectTwoFieldsTwoFullOuterTablesJoin;
  3559. Var
  3560. J : TSQLJoinTableReference;
  3561. begin
  3562. TestSelect('SELECT B,C FROM A FULL OUTER JOIN D ON E=F');
  3563. AssertEquals('Two fields',2,Select.Fields.Count);
  3564. AssertField(Select.Fields[0],'B');
  3565. AssertField(Select.Fields[1],'C');
  3566. AssertEquals('One table',1,Select.Tables.Count);
  3567. J:=AssertJoin(Select.Tables[0],'A','D',jtFullOuter);
  3568. AssertJoinOn(J.JoinClause,'E','F',boEq);
  3569. end;
  3570. procedure TTestSelectParser.TestSelectTwoFieldsTwoFullTablesJoin;
  3571. Var
  3572. J : TSQLJoinTableReference;
  3573. begin
  3574. TestSelect('SELECT B,C FROM A FULL JOIN D ON E=F');
  3575. AssertEquals('Two fields',2,Select.Fields.Count);
  3576. AssertField(Select.Fields[0],'B');
  3577. AssertField(Select.Fields[1],'C');
  3578. AssertEquals('One table',1,Select.Tables.Count);
  3579. J:=AssertJoin(Select.Tables[0],'A','D',jtFullOuter);
  3580. AssertJoinOn(J.JoinClause,'E','F',boEq);
  3581. end;
  3582. procedure TTestSelectParser.TestSelectTwoFieldsTwoLeftTablesJoin;
  3583. Var
  3584. J : TSQLJoinTableReference;
  3585. begin
  3586. TestSelect('SELECT B,C FROM A LEFT JOIN D ON E=F');
  3587. AssertEquals('Two fields',2,Select.Fields.Count);
  3588. AssertField(Select.Fields[0],'B');
  3589. AssertField(Select.Fields[1],'C');
  3590. AssertEquals('One table',1,Select.Tables.Count);
  3591. J:=AssertJoin(Select.Tables[0],'A','D',jtLeft);
  3592. AssertJoinOn(J.JoinClause,'E','F',boEq);
  3593. end;
  3594. procedure TTestSelectParser.TestSelectTwoFieldsTwoRightTablesJoin;
  3595. Var
  3596. J : TSQLJoinTableReference;
  3597. begin
  3598. TestSelect('SELECT B,C FROM A RIGHT JOIN D ON E=F');
  3599. AssertEquals('Two fields',2,Select.Fields.Count);
  3600. AssertField(Select.Fields[0],'B');
  3601. AssertField(Select.Fields[1],'C');
  3602. AssertEquals('One table',1,Select.Tables.Count);
  3603. J:=AssertJoin(Select.Tables[0],'A','D',jtRight);
  3604. AssertJoinOn(J.JoinClause,'E','F',boEq);
  3605. end;
  3606. procedure TTestSelectParser.TestSelectTwoFieldsThreeTablesJoin;
  3607. Var
  3608. J : TSQLJoinTableReference;
  3609. begin
  3610. TestSelect('SELECT B,C FROM A JOIN D ON E=F JOIN G ON (H=I)');
  3611. AssertEquals('Two fields',2,Select.Fields.Count);
  3612. AssertField(Select.Fields[0],'B');
  3613. AssertField(Select.Fields[1],'C');
  3614. AssertEquals('One table',1,Select.Tables.Count);
  3615. j:=AssertJoin(Select.Tables[0],'','G',jtNone);
  3616. AssertJoinOn(J.JoinClause,'H','I',boEq);
  3617. J:=AssertJoin(J.Left,'A','D',jtNone);
  3618. AssertJoinOn(J.JoinClause,'E','F',boEq);
  3619. end;
  3620. procedure TTestSelectParser.TestSelectTwoFieldsBracketThreeTablesJoin;
  3621. Var
  3622. J : TSQLJoinTableReference;
  3623. begin
  3624. TestSelect('SELECT B,C FROM (A JOIN D ON E=F) JOIN G ON (H=I)');
  3625. AssertEquals('Two fields',2,Select.Fields.Count);
  3626. AssertField(Select.Fields[0],'B');
  3627. AssertField(Select.Fields[1],'C');
  3628. AssertEquals('One table',1,Select.Tables.Count);
  3629. j:=AssertJoin(Select.Tables[0],'','G',jtNone);
  3630. AssertJoinOn(J.JoinClause,'H','I',boEq);
  3631. J:=AssertJoin(J.Left,'A','D',jtNone);
  3632. AssertJoinOn(J.JoinClause,'E','F',boEq);
  3633. end;
  3634. procedure TTestSelectParser.TestSelectTwoFieldsThreeBracketTablesJoin;
  3635. Var
  3636. J : TSQLJoinTableReference;
  3637. begin
  3638. TestSelect('SELECT B,C FROM A JOIN (D JOIN G ON E=F) ON (H=I)');
  3639. AssertEquals('Two fields',2,Select.Fields.Count);
  3640. AssertField(Select.Fields[0],'B');
  3641. AssertField(Select.Fields[1],'C');
  3642. AssertEquals('One table',1,Select.Tables.Count);
  3643. j:=AssertJoin(Select.Tables[0],'A','',jtNone);
  3644. AssertJoinOn(J.JoinClause,'H','I',boEq);
  3645. j:=AssertJoin(J.Right,'D','G',jtNone);
  3646. AssertJoinOn(J.JoinClause,'E','F',boEq);
  3647. end;
  3648. procedure TTestSelectParser.TestAggregateCount;
  3649. begin
  3650. TestSelect('SELECT COUNT(B) FROM A');
  3651. AssertEquals('One field',1,Select.Fields.Count);
  3652. AssertEquals('One table',1,Select.Tables.Count);
  3653. AssertTable(Select.Tables[0],'A');
  3654. AssertAggregate(Select.Fields[0],afCount,'B',aoNone,'');
  3655. end;
  3656. procedure TTestSelectParser.TestAggregateCountAsterisk;
  3657. begin
  3658. TestSelect('SELECT COUNT(*) FROM A');
  3659. AssertEquals('One field',1,Select.Fields.Count);
  3660. AssertEquals('One table',1,Select.Tables.Count);
  3661. AssertTable(Select.Tables[0],'A');
  3662. AssertAggregate(Select.Fields[0],afCount,'',aoAsterisk,'');
  3663. end;
  3664. procedure TTestSelectParser.TestAggregateCountAll;
  3665. begin
  3666. TestSelect('SELECT COUNT(ALL B) FROM A');
  3667. AssertEquals('One field',1,Select.Fields.Count);
  3668. AssertEquals('One table',1,Select.Tables.Count);
  3669. AssertTable(Select.Tables[0],'A');
  3670. AssertAggregate(Select.Fields[0],afCount,'B',aoAll,'');
  3671. end;
  3672. procedure TTestSelectParser.TestAggregateCountDistinct;
  3673. begin
  3674. TestSelect('SELECT COUNT(DISTINCT B) FROM A');
  3675. AssertEquals('One field',1,Select.Fields.Count);
  3676. AssertEquals('One table',1,Select.Tables.Count);
  3677. AssertTable(Select.Tables[0],'A');
  3678. AssertAggregate(Select.Fields[0],afCount,'B',aoDistinct,'');
  3679. end;
  3680. procedure TTestSelectParser.TestAggregateMax;
  3681. begin
  3682. TestSelect('SELECT MAX(B) FROM A');
  3683. AssertEquals('One field',1,Select.Fields.Count);
  3684. AssertEquals('One table',1,Select.Tables.Count);
  3685. AssertTable(Select.Tables[0],'A');
  3686. AssertAggregate(Select.Fields[0],afMax,'B',aoNone,'');
  3687. end;
  3688. procedure TTestSelectParser.TestAggregateMaxAsterisk;
  3689. begin
  3690. TestSelectError('SELECT Max(*) FROM A');
  3691. end;
  3692. procedure TTestSelectParser.TestAggregateMaxAll;
  3693. begin
  3694. TestSelect('SELECT MAX(ALL B) FROM A');
  3695. AssertEquals('One field',1,Select.Fields.Count);
  3696. AssertEquals('One table',1,Select.Tables.Count);
  3697. AssertTable(Select.Tables[0],'A');
  3698. AssertAggregate(Select.Fields[0],afMax,'B',aoAll,'');
  3699. end;
  3700. procedure TTestSelectParser.TestAggregateMaxDistinct;
  3701. begin
  3702. TestSelect('SELECT MAX(DISTINCT B) FROM A');
  3703. AssertEquals('One field',1,Select.Fields.Count);
  3704. AssertEquals('One table',1,Select.Tables.Count);
  3705. AssertTable(Select.Tables[0],'A');
  3706. AssertAggregate(Select.Fields[0],afMax,'B',aoDistinct,'');
  3707. end;
  3708. procedure TTestSelectParser.TestAggregateMin;
  3709. begin
  3710. TestSelect('SELECT Min(B) FROM A');
  3711. AssertEquals('One field',1,Select.Fields.Count);
  3712. AssertEquals('One table',1,Select.Tables.Count);
  3713. AssertTable(Select.Tables[0],'A');
  3714. AssertAggregate(Select.Fields[0],afMin,'B',aoNone,'');
  3715. end;
  3716. procedure TTestSelectParser.TestAggregateMinAsterisk;
  3717. begin
  3718. TestSelectError('SELECT Min(*) FROM A');
  3719. end;
  3720. procedure TTestSelectParser.TestAggregateMinAll;
  3721. begin
  3722. TestSelect('SELECT Min(ALL B) FROM A');
  3723. AssertEquals('One field',1,Select.Fields.Count);
  3724. AssertEquals('One table',1,Select.Tables.Count);
  3725. AssertTable(Select.Tables[0],'A');
  3726. AssertAggregate(Select.Fields[0],afMin,'B',aoAll,'');
  3727. end;
  3728. procedure TTestSelectParser.TestAggregateMinDistinct;
  3729. begin
  3730. TestSelect('SELECT Min(DISTINCT B) FROM A');
  3731. AssertEquals('One field',1,Select.Fields.Count);
  3732. AssertEquals('One table',1,Select.Tables.Count);
  3733. AssertTable(Select.Tables[0],'A');
  3734. AssertAggregate(Select.Fields[0],afMin,'B',aoDistinct,'');
  3735. end;
  3736. procedure TTestSelectParser.TestAggregateSum;
  3737. begin
  3738. TestSelect('SELECT Sum(B) FROM A');
  3739. AssertEquals('One field',1,Select.Fields.Count);
  3740. AssertEquals('One table',1,Select.Tables.Count);
  3741. AssertTable(Select.Tables[0],'A');
  3742. AssertAggregate(Select.Fields[0],afSum,'B',aoNone,'');
  3743. end;
  3744. procedure TTestSelectParser.TestAggregateSumAsterisk;
  3745. begin
  3746. TestSelectError('SELECT Sum(*) FROM A');
  3747. end;
  3748. procedure TTestSelectParser.TestAggregateSumAll;
  3749. begin
  3750. TestSelect('SELECT Sum(ALL B) FROM A');
  3751. AssertEquals('One field',1,Select.Fields.Count);
  3752. AssertEquals('One table',1,Select.Tables.Count);
  3753. AssertTable(Select.Tables[0],'A');
  3754. AssertAggregate(Select.Fields[0],afSum,'B',aoAll,'');
  3755. end;
  3756. procedure TTestSelectParser.TestAggregateSumDistinct;
  3757. begin
  3758. TestSelect('SELECT Sum(DISTINCT B) FROM A');
  3759. AssertEquals('One field',1,Select.Fields.Count);
  3760. AssertEquals('One table',1,Select.Tables.Count);
  3761. AssertTable(Select.Tables[0],'A');
  3762. AssertAggregate(Select.Fields[0],afSum,'B',aoDistinct,'');
  3763. end;
  3764. procedure TTestSelectParser.TestAggregateAvg;
  3765. begin
  3766. TestSelect('SELECT Avg(B) FROM A');
  3767. AssertEquals('One field',1,Select.Fields.Count);
  3768. AssertEquals('One table',1,Select.Tables.Count);
  3769. AssertTable(Select.Tables[0],'A');
  3770. AssertAggregate(Select.Fields[0],afAvg,'B',aoNone,'');
  3771. end;
  3772. procedure TTestSelectParser.TestAggregateAvgAsterisk;
  3773. begin
  3774. TestSelectError('SELECT Avg(*) FROM A');
  3775. end;
  3776. procedure TTestSelectParser.TestAggregateAvgAll;
  3777. begin
  3778. TestSelect('SELECT Avg(ALL B) FROM A');
  3779. AssertEquals('One field',1,Select.Fields.Count);
  3780. AssertEquals('One table',1,Select.Tables.Count);
  3781. AssertTable(Select.Tables[0],'A');
  3782. AssertAggregate(Select.Fields[0],afAvg,'B',aoAll,'');
  3783. end;
  3784. procedure TTestSelectParser.TestAggregateAvgDistinct;
  3785. begin
  3786. TestSelect('SELECT Avg(DISTINCT B) FROM A');
  3787. AssertEquals('One field',1,Select.Fields.Count);
  3788. AssertEquals('One table',1,Select.Tables.Count);
  3789. AssertTable(Select.Tables[0],'A');
  3790. AssertAggregate(Select.Fields[0],afAvg,'B',aoDistinct,'');
  3791. end;
  3792. procedure TTestSelectParser.TestUpperConst;
  3793. Var
  3794. E : TSQLFunctionCallExpression;
  3795. L : TSQLLiteralExpression;
  3796. S : TSQLStringLiteral;
  3797. begin
  3798. TestSelect('SELECT UPPER(''a'') FROM A');
  3799. AssertEquals('One field',1,Select.Fields.Count);
  3800. AssertEquals('One table',1,Select.Tables.Count);
  3801. AssertTable(Select.Tables[0],'A');
  3802. CheckClass(Select.Fields[0],TSQLSelectField);
  3803. E:=TSQLFunctionCallExpression(CheckClass(TSQLSelectField(Select.Fields[0]).Expression,TSQLFunctionCallExpression));
  3804. AssertEquals('UPPER function name','UPPER',E.Identifier);
  3805. AssertEquals('One function element',1,E.Arguments.Count);
  3806. L:=TSQLLiteralExpression(CheckClass(E.Arguments[0],TSQLLiteralExpression));
  3807. S:=TSQLStringLiteral(CheckClass(L.Literal,TSQLStringLiteral));
  3808. AssertEquals('Correct constant','a',S.Value);
  3809. end;
  3810. procedure TTestSelectParser.TestUpperError;
  3811. begin
  3812. TestSelectError('SELECT UPPER(''A'',''B'') FROM C');
  3813. end;
  3814. procedure TTestSelectParser.TestGenID;
  3815. Var
  3816. E : TSQLGenIDExpression;
  3817. L : TSQLLiteralExpression;
  3818. S : TSQLIntegerLiteral;
  3819. begin
  3820. TestSelect('SELECT GEN_ID(GEN_B,1) FROM RDB$DATABASE');
  3821. AssertEquals('One field',1,Select.Fields.Count);
  3822. AssertEquals('One table',1,Select.Tables.Count);
  3823. AssertTable(Select.Tables[0],'RDB$DATABASE');
  3824. CheckClass(Select.Fields[0],TSQLSelectField);
  3825. E:=TSQLGenIDExpression(CheckClass(TSQLSelectField(Select.Fields[0]).Expression,TSQLGenIDExpression));
  3826. AssertIdentifierName('GenID generator function name','GEN_B',E.Generator);
  3827. L:=TSQLLiteralExpression(CheckClass(E.Value,TSQLLiteralExpression));
  3828. S:=TSQLIntegerLiteral(CheckClass(L.Literal,TSQLIntegerLiteral));
  3829. AssertEquals('Correct constant',1,S.Value);
  3830. end;
  3831. procedure TTestSelectParser.TestGenIDError1;
  3832. begin
  3833. TestSelectError('SELECT GEN_ID(''GEN_B'',1) FROM RDB$DATABASE');
  3834. end;
  3835. procedure TTestSelectParser.TestGenIDError2;
  3836. begin
  3837. TestSelectError('SELECT GEN_ID(''GEN_B'') FROM RDB$DATABASE');
  3838. end;
  3839. procedure TTestSelectParser.TestCastSimple;
  3840. var
  3841. C : TSQLCastExpression;
  3842. L : TSQLLiteralExpression;
  3843. S : TSQLIntegerLiteral;
  3844. begin
  3845. TestSelect('SELECT CAST(1 AS VARCHAR(5)) FROM A');
  3846. AssertEquals('One field',1,Select.Fields.Count);
  3847. AssertEquals('One table',1,Select.Tables.Count);
  3848. AssertTable(Select.Tables[0],'A');
  3849. CheckClass(Select.Fields[0],TSQLSelectField);
  3850. C:=TSQLCastExpression(CheckClass(TSQLSelectField(Select.Fields[0]).Expression,TSQLCastExpression));
  3851. L:=TSQLLiteralExpression(CheckClass(C.Value,TSQLLiteralExpression));
  3852. S:=TSQLIntegerLiteral(CheckClass(L.Literal,TSQLIntegerLiteral));
  3853. AssertEquals('Correct constant',1,S.Value);
  3854. AssertTypeDefaults(C.NewType,5);
  3855. AssertEquals('Correct type',sdtVarChar,C.NewType.DataType);
  3856. end;
  3857. procedure TTestSelectParser.DoExtractSimple(Expected: TSQLExtractElement);
  3858. var
  3859. E : TSQLExtractExpression;
  3860. I : TSQLIdentifierExpression;
  3861. begin
  3862. TestSelect('SELECT EXTRACT('+ExtractElementNames[Expected]+' FROM B) FROM A');
  3863. AssertEquals('One field',1,Select.Fields.Count);
  3864. AssertEquals('One table',1,Select.Tables.Count);
  3865. AssertTable(Select.Tables[0],'A');
  3866. CheckClass(Select.Fields[0],TSQLSelectField);
  3867. E:=TSQLExtractExpression(CheckClass(TSQLSelectField(Select.Fields[0]).Expression,TSQLExtractExpression));
  3868. I:=TSQLIdentifierExpression(CheckClass(E.Value,TSQLIdentifierExpression));
  3869. AssertIdentifierName('Correct field','B',I.Identifier);
  3870. FreeAndNil(FParser);
  3871. FreeAndNil(FSource);
  3872. FreeAndNil(FToFree);
  3873. end;
  3874. procedure TTestSelectParser.TestExtractSimple;
  3875. Var
  3876. E : TSQLExtractElement;
  3877. begin
  3878. For E:=Low(TSQLExtractElement) to High(TSQLExtractElement) do
  3879. DoExtractSimple(E);
  3880. end;
  3881. procedure TTestSelectParser.TestFunctionWithPath;
  3882. Var
  3883. E : TSQLFunctionCallExpression;
  3884. L : TSQLLiteralExpression;
  3885. S : TSQLStringLiteral;
  3886. I : TSQLIntegerLiteral;
  3887. begin
  3888. TestSelect('SELECT [dbo].[myFunc] (''abc'', 1) FROM A', [], [soSquareBracketsIdentifier]);
  3889. AssertEquals('One field',1,Select.Fields.Count);
  3890. AssertEquals('One table',1,Select.Tables.Count);
  3891. AssertTable(Select.Tables[0],'A');
  3892. CheckClass(Select.Fields[0],TSQLSelectField);
  3893. E:=TSQLFunctionCallExpression(CheckClass(TSQLSelectField(Select.Fields[0]).Expression,TSQLFunctionCallExpression));
  3894. AssertEquals('Function two identifiers',2,E.IdentifierPath.Count);
  3895. AssertEquals('dbo function first identifier','dbo',E.IdentifierPath[0].Name);
  3896. AssertEquals('myFunc function second identifier','myFunc',E.IdentifierPath[1].Name);
  3897. AssertEquals('Two function elements',2,E.Arguments.Count);
  3898. L:=TSQLLiteralExpression(CheckClass(E.Arguments[0],TSQLLiteralExpression));
  3899. S:=TSQLStringLiteral(CheckClass(L.Literal,TSQLStringLiteral));
  3900. AssertEquals('Correct string constant','abc',S.Value);
  3901. L:=TSQLLiteralExpression(CheckClass(E.Arguments[1],TSQLLiteralExpression));
  3902. I:=TSQLIntegerLiteral(CheckClass(L.Literal,TSQLIntegerLiteral));
  3903. AssertEquals('Correct integer constant',1,I.Value);
  3904. end;
  3905. procedure TTestSelectParser.TestOrderByOneField;
  3906. begin
  3907. TestSelect('SELECT B FROM A ORDER BY C');
  3908. AssertEquals('One field',1,Select.Fields.Count);
  3909. AssertEquals('One table',1,Select.Tables.Count);
  3910. AssertField(Select.Fields[0],'B');
  3911. AssertTable(Select.Tables[0],'A');
  3912. AssertEquals('One order by field',1,Select.Orderby.Count);
  3913. AssertOrderBy(Select.OrderBy[0],'C',0,obAscending);
  3914. end;
  3915. procedure TTestSelectParser.TestOrderByTwoFields;
  3916. begin
  3917. TestSelect('SELECT B FROM A ORDER BY C,D');
  3918. AssertEquals('One field',1,Select.Fields.Count);
  3919. AssertEquals('One table',1,Select.Tables.Count);
  3920. AssertField(Select.Fields[0],'B');
  3921. AssertTable(Select.Tables[0],'A');
  3922. AssertEquals('Two order by fields',2,Select.Orderby.Count);
  3923. AssertOrderBy(Select.OrderBy[0],'C',0,obAscending);
  3924. AssertOrderBy(Select.OrderBy[1],'D',0,obAscending);
  3925. end;
  3926. procedure TTestSelectParser.TestOrderByThreeFields;
  3927. begin
  3928. TestSelect('SELECT B FROM A ORDER BY C,D,E');
  3929. AssertEquals('One field',1,Select.Fields.Count);
  3930. AssertEquals('One table',1,Select.Tables.Count);
  3931. AssertField(Select.Fields[0],'B');
  3932. AssertTable(Select.Tables[0],'A');
  3933. AssertEquals('Three order by fields',3,Select.Orderby.Count);
  3934. AssertOrderBy(Select.OrderBy[0],'C',0,obAscending);
  3935. AssertOrderBy(Select.OrderBy[1],'D',0,obAscending);
  3936. AssertOrderBy(Select.OrderBy[2],'E',0,obAscending);
  3937. end;
  3938. procedure TTestSelectParser.TestOrderByOneDescField;
  3939. begin
  3940. TestSelect('SELECT B FROM A ORDER BY C DESC');
  3941. AssertEquals('One field',1,Select.Fields.Count);
  3942. AssertEquals('One table',1,Select.Tables.Count);
  3943. AssertField(Select.Fields[0],'B');
  3944. AssertTable(Select.Tables[0],'A');
  3945. AssertEquals('One order by field',1,Select.Orderby.Count);
  3946. AssertOrderBy(Select.OrderBy[0],'C',0,obDescending);
  3947. end;
  3948. procedure TTestSelectParser.TestOrderByTwoDescFields;
  3949. begin
  3950. TestSelect('SELECT B FROM A ORDER BY C DESC, D DESCENDING');
  3951. AssertEquals('One field',1,Select.Fields.Count);
  3952. AssertEquals('One table',1,Select.Tables.Count);
  3953. AssertField(Select.Fields[0],'B');
  3954. AssertTable(Select.Tables[0],'A');
  3955. AssertEquals('Two order by fields',2,Select.Orderby.Count);
  3956. AssertOrderBy(Select.OrderBy[0],'C',0,obDescending);
  3957. AssertOrderBy(Select.OrderBy[1],'D',0,obDescending);
  3958. end;
  3959. procedure TTestSelectParser.TestOrderByThreeDescFields;
  3960. begin
  3961. TestSelect('SELECT B FROM A ORDER BY C DESC,D DESCENDING, E DESC');
  3962. AssertEquals('One field',1,Select.Fields.Count);
  3963. AssertEquals('One table',1,Select.Tables.Count);
  3964. AssertField(Select.Fields[0],'B');
  3965. AssertTable(Select.Tables[0],'A');
  3966. AssertEquals('Three order by fields',3,Select.Orderby.Count);
  3967. AssertOrderBy(Select.OrderBy[0],'C',0,obDescending);
  3968. AssertOrderBy(Select.OrderBy[1],'D',0,obDescending);
  3969. AssertOrderBy(Select.OrderBy[2],'E',0,obDescending);
  3970. end;
  3971. procedure TTestSelectParser.TestOrderByOneTableField;
  3972. begin
  3973. TestSelect('SELECT B FROM A ORDER BY C.D');
  3974. AssertEquals('One field',1,Select.Fields.Count);
  3975. AssertEquals('One table',1,Select.Tables.Count);
  3976. AssertField(Select.Fields[0],'B');
  3977. AssertTable(Select.Tables[0],'A');
  3978. AssertEquals('One order by field',1,Select.Orderby.Count);
  3979. // Field does not support linking/refering to a table, so the field name is
  3980. // assigned as C.D (instead of D with a <link to table C>)
  3981. AssertOrderBy(Select.OrderBy[0],'C.D',0,obAscending);
  3982. end;
  3983. procedure TTestSelectParser.TestOrderByOneColumn;
  3984. begin
  3985. TestSelect('SELECT B FROM A ORDER BY 1');
  3986. AssertEquals('One field',1,Select.Fields.Count);
  3987. AssertEquals('One table',1,Select.Tables.Count);
  3988. AssertField(Select.Fields[0],'B');
  3989. AssertTable(Select.Tables[0],'A');
  3990. AssertEquals('One order by field',1,Select.Orderby.Count);
  3991. AssertOrderBy(Select.OrderBy[0],'',1,obAscending);
  3992. end;
  3993. procedure TTestSelectParser.TestOrderByTwoColumns;
  3994. begin
  3995. TestSelect('SELECT B,C FROM A ORDER BY 1,2');
  3996. AssertEquals('Two fields',2,Select.Fields.Count);
  3997. AssertEquals('One table',1,Select.Tables.Count);
  3998. AssertField(Select.Fields[0],'B');
  3999. AssertField(Select.Fields[1],'C');
  4000. AssertTable(Select.Tables[0],'A');
  4001. AssertEquals('Two order by fields',2,Select.Orderby.Count);
  4002. AssertOrderBy(Select.OrderBy[0],'',1,obAscending);
  4003. AssertOrderBy(Select.OrderBy[1],'',2,obAscending);
  4004. end;
  4005. procedure TTestSelectParser.TestOrderByTwoColumnsDesc;
  4006. begin
  4007. TestSelect('SELECT B,C FROM A ORDER BY 1 DESC,2');
  4008. AssertEquals('Two fields',2,Select.Fields.Count);
  4009. AssertEquals('One table',1,Select.Tables.Count);
  4010. AssertField(Select.Fields[0],'B');
  4011. AssertField(Select.Fields[1],'C');
  4012. AssertTable(Select.Tables[0],'A');
  4013. AssertEquals('Two order by fields',2,Select.Orderby.Count);
  4014. AssertOrderBy(Select.OrderBy[0],'',1,obDescending);
  4015. AssertOrderBy(Select.OrderBy[1],'',2,obAscending);
  4016. end;
  4017. procedure TTestSelectParser.TestOrderByCollate;
  4018. Var
  4019. O : TSQLOrderByElement;
  4020. begin
  4021. TestSelect('SELECT B,C FROM A ORDER BY D COLLATE E');
  4022. AssertEquals('Two fields',2,Select.Fields.Count);
  4023. AssertEquals('One table',1,Select.Tables.Count);
  4024. AssertField(Select.Fields[0],'B');
  4025. AssertField(Select.Fields[1],'C');
  4026. AssertTable(Select.Tables[0],'A');
  4027. AssertEquals('One order by fields',1,Select.Orderby.Count);
  4028. O:=AssertOrderBy(Select.OrderBy[0],'D',0,obAscending);
  4029. AssertIdentifierName('Correct collation','E',O.Collation);
  4030. end;
  4031. procedure TTestSelectParser.TestOrderByCollateDesc;
  4032. Var
  4033. O : TSQLOrderByElement;
  4034. begin
  4035. TestSelect('SELECT B,C FROM A ORDER BY D COLLATE E');
  4036. AssertEquals('Two fields',2,Select.Fields.Count);
  4037. AssertEquals('One table',1,Select.Tables.Count);
  4038. AssertField(Select.Fields[0],'B');
  4039. AssertField(Select.Fields[1],'C');
  4040. AssertTable(Select.Tables[0],'A');
  4041. AssertEquals('One order by fields',1,Select.Orderby.Count);
  4042. O:=AssertOrderBy(Select.OrderBy[0],'D',0,obAscending);
  4043. AssertIdentifierName('Correct collation','E',O.Collation);
  4044. end;
  4045. procedure TTestSelectParser.TestOrderByCollateDescTwoFields;
  4046. Var
  4047. O : TSQLOrderByElement;
  4048. begin
  4049. TestSelect('SELECT B,C FROM A ORDER BY D COLLATE E DESC,F COLLATE E');
  4050. AssertEquals('Two fields',2,Select.Fields.Count);
  4051. AssertEquals('One table',1,Select.Tables.Count);
  4052. AssertField(Select.Fields[0],'B');
  4053. AssertField(Select.Fields[1],'C');
  4054. AssertTable(Select.Tables[0],'A');
  4055. AssertEquals('Two order by fields',2,Select.Orderby.Count);
  4056. O:=AssertOrderBy(Select.OrderBy[0],'D',0,obDescending);
  4057. AssertIdentifierName('Correct collation','E',O.Collation);
  4058. O:=AssertOrderBy(Select.OrderBy[1],'F',0,obAscending);
  4059. AssertIdentifierName('Correct collation','E',O.Collation);
  4060. end;
  4061. procedure TTestSelectParser.TestGroupByOne;
  4062. begin
  4063. TestSelect('SELECT B,COUNT(C) AS THECOUNT FROM A GROUP BY B');
  4064. AssertEquals('Two fields',2,Select.Fields.Count);
  4065. AssertEquals('One group by field',1,Select.GroupBy.Count);
  4066. AssertIdentifierName('Correct group by field','B',Select.GroupBy[0]);
  4067. AssertField(Select.Fields[0],'B');
  4068. AssertAggregate(Select.Fields[1],afCount,'C',aoNone,'THECOUNT');
  4069. end;
  4070. procedure TTestSelectParser.TestGroupByTwo;
  4071. begin
  4072. TestSelect('SELECT B,C,SUM(D) AS THESUM FROM A GROUP BY B,C');
  4073. AssertEquals('Three fields',3,Select.Fields.Count);
  4074. AssertEquals('One group two fields',2,Select.GroupBy.Count);
  4075. AssertIdentifierName('Correct first group by field','B',Select.GroupBy[0]);
  4076. AssertIdentifierName('Correct second group by field','C',Select.GroupBy[1]);
  4077. AssertField(Select.Fields[0],'B');
  4078. AssertField(Select.Fields[1],'C');
  4079. AssertAggregate(Select.Fields[2],afSum,'D',aoNone,'THESUM');
  4080. end;
  4081. procedure TTestSelectParser.TestHavingOne;
  4082. Var
  4083. H : TSQLBinaryExpression;
  4084. L : TSQLLiteralExpression;
  4085. S : TSQLIntegerLiteral;
  4086. begin
  4087. TestSelect('SELECT B,COUNT(C) AS THECOUNT FROM A GROUP BY B HAVING COUNT(C)>1');
  4088. AssertEquals('Two fields',2,Select.Fields.Count);
  4089. AssertEquals('One group by field',1,Select.GroupBy.Count);
  4090. AssertIdentifierName('Correct group by field','B',Select.GroupBy[0]);
  4091. AssertField(Select.Fields[0],'B');
  4092. AssertAggregate(Select.Fields[1],afCount,'C',aoNone,'THECOUNT');
  4093. AssertNotNull('Have having',Select.Having);
  4094. H:=TSQLBinaryExpression(CheckClass(Select.Having,TSQLBinaryExpression));
  4095. AssertEquals('Larger than',boGT,H.Operation);
  4096. L:=TSQLLiteralExpression(CheckClass(H.Right,TSQLLiteralExpression));
  4097. S:=TSQLIntegerLiteral(CheckClass(L.Literal,TSQLIntegerLiteral));
  4098. AssertEquals('One',1,S.Value);
  4099. AssertAggregateExpression(H.Left,afCount,'C',aoNone);
  4100. end;
  4101. procedure TTestSelectParser.TestLeft;
  4102. Var
  4103. E : TSQLFunctionCallExpression;
  4104. L : TSQLLiteralExpression;
  4105. S : TSQLStringLiteral;
  4106. I : TSQLIntegerLiteral;
  4107. begin
  4108. TestSelect('SELECT LEFT(''abc'', 1) FROM A');
  4109. AssertEquals('One field',1,Select.Fields.Count);
  4110. AssertEquals('One table',1,Select.Tables.Count);
  4111. AssertTable(Select.Tables[0],'A');
  4112. CheckClass(Select.Fields[0],TSQLSelectField);
  4113. E:=TSQLFunctionCallExpression(CheckClass(TSQLSelectField(Select.Fields[0]).Expression,TSQLFunctionCallExpression));
  4114. AssertEquals('LEFT function name','LEFT',E.Identifier);
  4115. AssertEquals('Two function elements',2,E.Arguments.Count);
  4116. L:=TSQLLiteralExpression(CheckClass(E.Arguments[0],TSQLLiteralExpression));
  4117. S:=TSQLStringLiteral(CheckClass(L.Literal,TSQLStringLiteral));
  4118. AssertEquals('Correct string constant','abc',S.Value);
  4119. L:=TSQLLiteralExpression(CheckClass(E.Arguments[1],TSQLLiteralExpression));
  4120. I:=TSQLIntegerLiteral(CheckClass(L.Literal,TSQLIntegerLiteral));
  4121. AssertEquals('Correct integer constant',1,I.Value);
  4122. end;
  4123. procedure TTestSelectParser.TestNoTable;
  4124. Var
  4125. F : TSQLSelectField;
  4126. L : TSQLIntegerLiteral;
  4127. begin
  4128. TestSelect('SELECT 1');
  4129. AssertEquals('0 tables in select',0,Select.Tables.Count);
  4130. AssertEquals('1 field in select',1,Select.Fields.Count);
  4131. AssertNotNull('Have field',Select.Fields[0]);
  4132. F:=TSQLSelectField(CheckClass(Select.Fields[0],TSQLSelectField));
  4133. AssertNotNull('Have field expresssion,',F.Expression);
  4134. L:=TSQLIntegerLiteral(AssertLiteralExpr('Field is a literal',F.Expression,TSQLIntegerLiteral));
  4135. AssertEquals('SELECT 1',1,L.Value);
  4136. end;
  4137. procedure TTestSelectParser.TestUnionSimple;
  4138. Var
  4139. S : TSQLSelectStatement;
  4140. begin
  4141. TestSelect('SELECT B FROM A UNION SELECT C FROM D');
  4142. AssertEquals('One field',1,Select.Fields.Count);
  4143. AssertField(Select.Fields[0],'B');
  4144. AssertEquals('One table',1,Select.Tables.Count);
  4145. AssertTable(Select.Tables[0],'A');
  4146. S:=TSQLSelectStatement(CheckClass(Select.Union,TSQLSelectStatement));
  4147. AssertEquals('One field',1,S.Fields.Count);
  4148. AssertField(S.Fields[0],'C');
  4149. AssertEquals('One table',1,S.Tables.Count);
  4150. AssertTable(S.Tables[0],'D');
  4151. AssertEquals('No UNION ALL : ',False,Select.UnionAll)
  4152. end;
  4153. procedure TTestSelectParser.TestUnionSimpleAll;
  4154. Var
  4155. S : TSQLSelectStatement;
  4156. begin
  4157. TestSelect('SELECT B FROM A UNION ALL SELECT C FROM D');
  4158. AssertEquals('One field',1,Select.Fields.Count);
  4159. AssertField(Select.Fields[0],'B');
  4160. AssertEquals('One table',1,Select.Tables.Count);
  4161. AssertTable(Select.Tables[0],'A');
  4162. S:=TSQLSelectStatement(CheckClass(Select.Union,TSQLSelectStatement));
  4163. AssertEquals('One field',1,S.Fields.Count);
  4164. AssertField(S.Fields[0],'C');
  4165. AssertEquals('One table',1,S.Tables.Count);
  4166. AssertTable(S.Tables[0],'D');
  4167. AssertEquals('UNION ALL : ',True,Select.UnionAll)
  4168. end;
  4169. procedure TTestSelectParser.TestUnionSimpleOrderBy;
  4170. Var
  4171. S : TSQLSelectStatement;
  4172. begin
  4173. TestSelect('SELECT B FROM A UNION SELECT C FROM D ORDER BY 1');
  4174. AssertEquals('One field',1,Select.Fields.Count);
  4175. AssertField(Select.Fields[0],'B');
  4176. AssertEquals('One table',1,Select.Tables.Count);
  4177. AssertTable(Select.Tables[0],'A');
  4178. AssertOrderBy(Select.OrderBy[0],'',1,obAscending);
  4179. S:=TSQLSelectStatement(CheckClass(Select.Union,TSQLSelectStatement));
  4180. AssertEquals('One field',1,S.Fields.Count);
  4181. AssertField(S.Fields[0],'C');
  4182. AssertEquals('One table',1,S.Tables.Count);
  4183. AssertTable(S.Tables[0],'D');
  4184. end;
  4185. procedure TTestSelectParser.TestUnionDouble;
  4186. Var
  4187. S : TSQLSelectStatement;
  4188. begin
  4189. TestSelect('SELECT B FROM A UNION SELECT C FROM D UNION SELECT E FROM F ORDER BY 1');
  4190. AssertEquals('One field',1,Select.Fields.Count);
  4191. AssertField(Select.Fields[0],'B');
  4192. AssertEquals('One table',1,Select.Tables.Count);
  4193. AssertTable(Select.Tables[0],'A');
  4194. AssertOrderBy(Select.OrderBy[0],'',1,obAscending);
  4195. S:=TSQLSelectStatement(CheckClass(Select.Union,TSQLSelectStatement));
  4196. AssertEquals('One field',1,S.Fields.Count);
  4197. AssertField(S.Fields[0],'C');
  4198. AssertEquals('One table',1,S.Tables.Count);
  4199. AssertTable(S.Tables[0],'D');
  4200. S:=TSQLSelectStatement(CheckClass(S.Union,TSQLSelectStatement));
  4201. AssertEquals('One field',1,S.Fields.Count);
  4202. AssertField(S.Fields[0],'E');
  4203. AssertEquals('One table',1,S.Tables.Count);
  4204. AssertTable(S.Tables[0],'F');
  4205. end;
  4206. procedure TTestSelectParser.TestUnionError1;
  4207. begin
  4208. TestSelectError('SELECT B FROM A ORDER BY B UNION SELECT C FROM D');
  4209. end;
  4210. procedure TTestSelectParser.TestUnionError2;
  4211. begin
  4212. TestSelectError('SELECT B FROM A UNION SELECT C,E FROM D');
  4213. end;
  4214. procedure TTestSelectParser.TestPlanOrderNatural;
  4215. Var
  4216. E : TSQLSelectPlanExpr;
  4217. N : TSQLSelectNaturalPLan;
  4218. begin
  4219. TestSelect('SELECT A FROM B PLAN SORT (B NATURAL)');
  4220. E:=TSQLSelectPlanExpr(CheckClass(Select.Plan,TSQLSelectPlanExpr));
  4221. AssertEquals('One plan item',1,E.Items.Count);
  4222. AssertEquals('Correct plan type',pjtSort,E.JoinType);
  4223. N:=TSQLSelectNaturalPLan(CheckClass(E.Items[0],TSQLSelectNaturalPLan));
  4224. AssertIdentifierName('Correct table','B',N.TableName);
  4225. end;
  4226. procedure TTestSelectParser.TestPlanOrderOrder;
  4227. Var
  4228. E : TSQLSelectPlanExpr;
  4229. O : TSQLSelectOrderedPLan;
  4230. begin
  4231. TestSelect('SELECT A FROM B PLAN SORT (B ORDER C)');
  4232. E:=TSQLSelectPlanExpr(CheckClass(Select.Plan,TSQLSelectPlanExpr));
  4233. AssertEquals('One plan item',1,E.Items.Count);
  4234. AssertEquals('Correct plan type',pjtSort,E.JoinType);
  4235. O:=TSQLSelectOrderedPLan(CheckClass(E.Items[0],TSQLSelectOrderedPLan));
  4236. AssertIdentifierName('Correct table','B',O.TableName);
  4237. AssertIdentifierName('Correct table','C',O.OrderIndex);
  4238. end;
  4239. procedure TTestSelectParser.TestPlanOrderIndex1;
  4240. Var
  4241. E : TSQLSelectPlanExpr;
  4242. O : TSQLSelectIndexedPLan;
  4243. begin
  4244. TestSelect('SELECT A FROM B PLAN SORT (B INDEX (C))');
  4245. E:=TSQLSelectPlanExpr(CheckClass(Select.Plan,TSQLSelectPlanExpr));
  4246. AssertEquals('One plan item',1,E.Items.Count);
  4247. AssertEquals('Correct plan type',pjtSort,E.JoinType);
  4248. O:=TSQLSelectIndexedPLan(CheckClass(E.Items[0],TSQLSelectIndexedPlan));
  4249. AssertIdentifierName('Correct table','B',O.TableName);
  4250. AssertEquals('Correct index count',1,O.Indexes.Count);
  4251. AssertIdentifierName('Correct table','C',O.Indexes[0]);
  4252. end;
  4253. procedure TTestSelectParser.TestPlanOrderIndex2;
  4254. Var
  4255. E : TSQLSelectPlanExpr;
  4256. O : TSQLSelectIndexedPLan;
  4257. begin
  4258. TestSelect('SELECT A FROM B PLAN SORT (B INDEX (C,D))');
  4259. E:=TSQLSelectPlanExpr(CheckClass(Select.Plan,TSQLSelectPlanExpr));
  4260. AssertEquals('One plan item',1,E.Items.Count);
  4261. AssertEquals('Correct plan type',pjtSort,E.JoinType);
  4262. O:=TSQLSelectIndexedPLan(CheckClass(E.Items[0],TSQLSelectIndexedPlan));
  4263. AssertIdentifierName('Correct table','B',O.TableName);
  4264. AssertEquals('Correct index count',2,O.Indexes.Count);
  4265. AssertIdentifierName('Correct table','C',O.Indexes[0]);
  4266. AssertIdentifierName('Correct table','D',O.Indexes[1]);
  4267. end;
  4268. procedure TTestSelectParser.TestPlanJoinNatural;
  4269. Var
  4270. E : TSQLSelectPlanExpr;
  4271. N : TSQLSelectNaturalPLan;
  4272. O : TSQLSelectOrderedPLan;
  4273. begin
  4274. TestSelect('SELECT A FROM B PLAN JOIN (B NATURAL, C ORDER D)');
  4275. E:=TSQLSelectPlanExpr(CheckClass(Select.Plan,TSQLSelectPlanExpr));
  4276. AssertEquals('One plan item',2,E.Items.Count);
  4277. AssertEquals('Correct plan type',pjtJoin,E.JoinType);
  4278. N:=TSQLSelectNaturalPLan(CheckClass(E.Items[0],TSQLSelectNaturalPlan));
  4279. AssertIdentifierName('Correct table','B',N.TableName);
  4280. O:=TSQLSelectOrderedPLan(CheckClass(E.Items[1],TSQLSelectOrderedPlan));
  4281. AssertIdentifierName('Correct table','C',O.TableName);
  4282. AssertIdentifierName('Correct index','D',O.OrderIndex);
  4283. end;
  4284. procedure TTestSelectParser.TestPlanDefaultNatural;
  4285. Var
  4286. E : TSQLSelectPlanExpr;
  4287. N : TSQLSelectNaturalPLan;
  4288. O : TSQLSelectOrderedPLan;
  4289. begin
  4290. TestSelect('SELECT A FROM B PLAN (B NATURAL, C ORDER D)');
  4291. E:=TSQLSelectPlanExpr(CheckClass(Select.Plan,TSQLSelectPlanExpr));
  4292. AssertEquals('One plan item',2,E.Items.Count);
  4293. AssertEquals('Correct plan type',pjtJoin,E.JoinType);
  4294. N:=TSQLSelectNaturalPLan(CheckClass(E.Items[0],TSQLSelectNaturalPlan));
  4295. AssertIdentifierName('Correct table','B',N.TableName);
  4296. O:=TSQLSelectOrderedPLan(CheckClass(E.Items[1],TSQLSelectOrderedPlan));
  4297. AssertIdentifierName('Correct table','C',O.TableName);
  4298. AssertIdentifierName('Correct index','D',O.OrderIndex);
  4299. end;
  4300. procedure TTestSelectParser.TestPlanMergeNatural;
  4301. Var
  4302. E : TSQLSelectPlanExpr;
  4303. N : TSQLSelectNaturalPLan;
  4304. O : TSQLSelectOrderedPLan;
  4305. begin
  4306. TestSelect('SELECT A FROM B PLAN MERGE (B NATURAL, C ORDER D)');
  4307. E:=TSQLSelectPlanExpr(CheckClass(Select.Plan,TSQLSelectPlanExpr));
  4308. AssertEquals('One plan item',2,E.Items.Count);
  4309. AssertEquals('Correct plan type',pjtMerge,E.JoinType);
  4310. N:=TSQLSelectNaturalPLan(CheckClass(E.Items[0],TSQLSelectNaturalPlan));
  4311. AssertIdentifierName('Correct table','B',N.TableName);
  4312. O:=TSQLSelectOrderedPLan(CheckClass(E.Items[1],TSQLSelectOrderedPlan));
  4313. AssertIdentifierName('Correct table','C',O.TableName);
  4314. AssertIdentifierName('Correct index','D',O.OrderIndex);
  4315. end;
  4316. procedure TTestSelectParser.TestPlanMergeNested;
  4317. Var
  4318. E,EN : TSQLSelectPlanExpr;
  4319. N : TSQLSelectNaturalPLan;
  4320. I : TSQLSelectIndexedPLan;
  4321. begin
  4322. TestSelect('SELECT A FROM B PLAN MERGE (SORT (B NATURAL), SORT (JOIN (D NATURAL, E INDEX (F))))');
  4323. E:=TSQLSelectPlanExpr(CheckClass(Select.Plan,TSQLSelectPlanExpr));
  4324. AssertEquals('Two plan items',2,E.Items.Count);
  4325. AssertEquals('Correct overall plan type',pjtMerge,E.JoinType);
  4326. // SORT (B NATURAL)
  4327. EN:=TSQLSelectPlanExpr(CheckClass(E.Items[0],TSQLSelectPlanExpr));
  4328. AssertEquals('Correct plan type Item 1',pjtSort,EN.JoinType);
  4329. AssertEquals('On plan item in item 1',1,EN.Items.Count);
  4330. N:=TSQLSelectNaturalPLan(CheckClass(EN.Items[0],TSQLSelectNaturalPlan));
  4331. AssertIdentifierName('Correct table','B',N.TableName);
  4332. // SORT (JOIN (D...
  4333. EN:=TSQLSelectPlanExpr(CheckClass(E.Items[1],TSQLSelectPlanExpr));
  4334. AssertEquals('Correct plan type item 2',pjtSort,EN.JoinType);
  4335. AssertEquals('One plan item in item 2',1,EN.Items.Count);
  4336. // JOIN (D NATURAL, E
  4337. E:=TSQLSelectPlanExpr(CheckClass(EN.Items[0],TSQLSelectPlanExpr));
  4338. AssertEquals('Correct plan type',pjtJoin,E.JoinType);
  4339. AssertEquals('Two plan items in item 2',2,E.Items.Count);
  4340. N:=TSQLSelectNaturalPLan(CheckClass(E.Items[0],TSQLSelectNaturalPlan));
  4341. AssertIdentifierName('Correct table','D',N.TableName);
  4342. // E INDEX (F)
  4343. I:=TSQLSelectIndexedPLan(CheckClass(E.Items[1],TSQLSelectIndexedPlan));
  4344. AssertIdentifierName('Correct table','E',I.TableName);
  4345. AssertEquals('Correct index count for table E',1,I.Indexes.Count);
  4346. AssertIdentifierName('Correct index for table E','F',I.Indexes[0]);
  4347. end;
  4348. procedure TTestSelectParser.TestSubSelect;
  4349. Var
  4350. F : TSQLSelectField;
  4351. E : TSQLSelectExpression;
  4352. S : TSQLSelectStatement;
  4353. begin
  4354. TestSelect('SELECT A,(SELECT C FROM D WHERE E=A) AS THECOUNT FROM B');
  4355. AssertEquals('1 table in select',1,Select.Tables.Count);
  4356. AssertTable(Select.Tables[0],'B','');
  4357. AssertEquals('2 fields in select',2,Select.Fields.Count);
  4358. AssertField(Select.Fields[0],'A','');
  4359. F:=TSQLSelectField(CheckClass(Select.fields[1],TSQLSelectField));
  4360. AssertIdentifierName('Correct alias name for subselect','THECOUNT',F.AliasName);
  4361. E:=TSQLSelectExpression(CheckClass(F.Expression,TSQLSelectExpression));
  4362. S:=TSQLSelectStatement(CheckClass(E.Select,TSQLSelectStatement));
  4363. AssertEquals('1 field in subselect',1,S.Fields.Count);
  4364. AssertField(S.Fields[0],'C','');
  4365. AssertEquals('1 table in subselect',1,S.Tables.Count);
  4366. AssertTable(S.Tables[0],'D','');
  4367. end;
  4368. procedure TTestSelectParser.TestWhereExists;
  4369. Var
  4370. E : TSQLExistsExpression;
  4371. S : TSQLSelectStatement;
  4372. begin
  4373. TestSelect('SELECT A FROM B WHERE EXISTS (SELECT C FROM D WHERE E=A)');
  4374. AssertEquals('1 table in select',1,Select.Tables.Count);
  4375. AssertTable(Select.Tables[0],'B','');
  4376. AssertEquals('1 fields in select',1,Select.Fields.Count);
  4377. AssertField(Select.Fields[0],'A','');
  4378. E:=TSQLExistsExpression(CheckClass(Select.Where,TSQLExistsExpression));
  4379. S:=TSQLSelectStatement(CheckClass(E.Select,TSQLSelectStatement));
  4380. AssertEquals('1 field in subselect',1,S.Fields.Count);
  4381. AssertField(S.Fields[0],'C','');
  4382. AssertEquals('1 table in subselect',1,S.Tables.Count);
  4383. AssertTable(S.Tables[0],'D','');
  4384. end;
  4385. procedure TTestSelectParser.TestWhereSingular;
  4386. Var
  4387. E : TSQLSingularExpression;
  4388. S : TSQLSelectStatement;
  4389. begin
  4390. TestSelect('SELECT A FROM B WHERE SINGULAR (SELECT C FROM D WHERE E=A)');
  4391. AssertEquals('1 table in select',1,Select.Tables.Count);
  4392. AssertTable(Select.Tables[0],'B','');
  4393. AssertEquals('1 fields in select',1,Select.Fields.Count);
  4394. AssertField(Select.Fields[0],'A','');
  4395. E:=TSQLSingularExpression(CheckClass(Select.Where,TSQLSingularExpression));
  4396. S:=TSQLSelectStatement(CheckClass(E.Select,TSQLSelectStatement));
  4397. AssertEquals('1 field in subselect',1,S.Fields.Count);
  4398. AssertField(S.Fields[0],'C','');
  4399. AssertEquals('1 table in subselect',1,S.Tables.Count);
  4400. AssertTable(S.Tables[0],'D','');
  4401. end;
  4402. procedure TTestSelectParser.TestWhereAll;
  4403. Var
  4404. E : TSQLAllExpression;
  4405. S : TSQLSelectStatement;
  4406. B : TSQLBinaryExpression;
  4407. begin
  4408. TestSelect('SELECT A FROM B WHERE A > ALL (SELECT C FROM D WHERE E=F)');
  4409. AssertEquals('1 table in select',1,Select.Tables.Count);
  4410. AssertTable(Select.Tables[0],'B','');
  4411. AssertEquals('1 fields in select',1,Select.Fields.Count);
  4412. AssertField(Select.Fields[0],'A','');
  4413. B:=TSQLBinaryExpression(CheckClass(Select.Where,TSQLBinaryExpression));
  4414. AssertEquals('Correct operation',boGT,B.Operation);
  4415. E:=TSQLAllExpression(CheckClass(B.right,TSQLAllExpression));
  4416. S:=TSQLSelectStatement(CheckClass(E.Select,TSQLSelectStatement));
  4417. AssertEquals('1 field in subselect',1,S.Fields.Count);
  4418. AssertField(S.Fields[0],'C','');
  4419. AssertEquals('1 table in subselect',1,S.Tables.Count);
  4420. AssertTable(S.Tables[0],'D','');
  4421. end;
  4422. procedure TTestSelectParser.TestWhereAny;
  4423. Var
  4424. E : TSQLANyExpression;
  4425. S : TSQLSelectStatement;
  4426. B : TSQLBinaryExpression;
  4427. begin
  4428. TestSelect('SELECT A FROM B WHERE A > ANY (SELECT C FROM D WHERE E=F)');
  4429. AssertEquals('1 table in select',1,Select.Tables.Count);
  4430. AssertTable(Select.Tables[0],'B','');
  4431. AssertEquals('1 fields in select',1,Select.Fields.Count);
  4432. AssertField(Select.Fields[0],'A','');
  4433. B:=TSQLBinaryExpression(CheckClass(Select.Where,TSQLBinaryExpression));
  4434. AssertEquals('Correct operation',boGT,B.Operation);
  4435. E:=TSQLAnyExpression(CheckClass(B.right,TSQLANyExpression));
  4436. S:=TSQLSelectStatement(CheckClass(E.Select,TSQLSelectStatement));
  4437. AssertEquals('1 field in subselect',1,S.Fields.Count);
  4438. AssertField(S.Fields[0],'C','');
  4439. AssertEquals('1 table in subselect',1,S.Tables.Count);
  4440. AssertTable(S.Tables[0],'D','');
  4441. end;
  4442. procedure TTestSelectParser.TestWhereSome;
  4443. Var
  4444. E : TSQLSomeExpression;
  4445. S : TSQLSelectStatement;
  4446. B : TSQLBinaryExpression;
  4447. begin
  4448. TestSelect('SELECT A FROM B WHERE A > SOME (SELECT C FROM D WHERE E=F)');
  4449. AssertEquals('1 table in select',1,Select.Tables.Count);
  4450. AssertTable(Select.Tables[0],'B','');
  4451. AssertEquals('1 fields in select',1,Select.Fields.Count);
  4452. AssertField(Select.Fields[0],'A','');
  4453. B:=TSQLBinaryExpression(CheckClass(Select.Where,TSQLBinaryExpression));
  4454. AssertEquals('Correct operation',boGT,B.Operation);
  4455. E:=TSQLSomeExpression(CheckClass(B.right,TSQLSomeExpression));
  4456. S:=TSQLSelectStatement(CheckClass(E.Select,TSQLSelectStatement));
  4457. AssertEquals('1 field in subselect',1,S.Fields.Count);
  4458. AssertField(S.Fields[0],'C','');
  4459. AssertEquals('1 table in subselect',1,S.Tables.Count);
  4460. AssertTable(S.Tables[0],'D','');
  4461. end;
  4462. procedure TTestSelectParser.TestParam;
  4463. Var
  4464. F : TSQLSelectField;
  4465. P : TSQLParameterExpression;
  4466. begin
  4467. TestSelect('SELECT :A FROM B');
  4468. AssertEquals('1 table in select',1,Select.Tables.Count);
  4469. AssertTable(Select.Tables[0],'B','');
  4470. AssertEquals('1 fields in select',1,Select.Fields.Count);
  4471. AssertNotNull('Have field',Select.Fields[0]);
  4472. F:=TSQLSelectField(CheckClass(Select.Fields[0],TSQLSelectField));
  4473. AssertNotNull('Have field expresssion,',F.Expression);
  4474. P:=TSQLParameterExpression(CheckClass(F.Expression,TSQLParameterExpression));
  4475. AssertIdentifierName('Correct parameter name','A',P.Identifier);
  4476. end;
  4477. procedure TTestSelectParser.TestParamExpr;
  4478. Var
  4479. F : TSQLSelectField;
  4480. P : TSQLParameterExpression;
  4481. B : TSQLBinaryExpression;
  4482. begin
  4483. TestSelect('SELECT :A + 1 FROM B');
  4484. AssertEquals('1 table in select',1,Select.Tables.Count);
  4485. AssertTable(Select.Tables[0],'B','');
  4486. AssertEquals('1 fields in select',1,Select.Fields.Count);
  4487. AssertNotNull('Have field',Select.Fields[0]);
  4488. F:=TSQLSelectField(CheckClass(Select.Fields[0],TSQLSelectField));
  4489. AssertNotNull('Have field expresssion,',F.Expression);
  4490. B:=TSQLBinaryExpression(CheckClass(F.Expression,TSQLBinaryExpression));
  4491. P:=TSQLParameterExpression(CheckClass(B.Left,TSQLParameterExpression));
  4492. AssertIdentifierName('Correct parameter name','A',P.Identifier);
  4493. end;
  4494. { TTestRollBackParser }
  4495. function TTestRollBackParser.TestRollback(const ASource: String
  4496. ): TSQLRollbackStatement;
  4497. begin
  4498. CreateParser(ASource);
  4499. FToFree:=Parser.Parse;
  4500. Result:=TSQLRollbackStatement(CheckClass(FToFree,TSQLRollbackStatement));
  4501. FRollback:=Result;
  4502. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  4503. end;
  4504. procedure TTestRollBackParser.TestRollbackError(const ASource: String);
  4505. begin
  4506. FErrSource:=ASource;
  4507. AssertException(ESQLParser,@TestParseError);
  4508. end;
  4509. procedure TTestRollBackParser.TestRollback;
  4510. begin
  4511. TestRollBack('ROLLBACK');
  4512. AssertNull('No transaction name',Rollback.TransactionName);
  4513. AssertEquals('No work',False,Rollback.Work);
  4514. AssertEquals('No release',False,Rollback.Release);
  4515. end;
  4516. procedure TTestRollBackParser.TestRollbackWork;
  4517. begin
  4518. TestRollBack('ROLLBACK WORK');
  4519. AssertNull('No transaction name',Rollback.TransactionName);
  4520. AssertEquals('work',True,Rollback.Work);
  4521. AssertEquals('No release',False,Rollback.Release);
  4522. end;
  4523. procedure TTestRollBackParser.TestRollbackRelease;
  4524. begin
  4525. TestRollBack('ROLLBACK RELEASE');
  4526. AssertNull('No transaction name',Rollback.TransactionName);
  4527. AssertEquals('no work',False,Rollback.Work);
  4528. AssertEquals('release',True,Rollback.Release);
  4529. end;
  4530. procedure TTestRollBackParser.TestRollbackWorkRelease;
  4531. begin
  4532. TestRollBack('ROLLBACK WORK RELEASE');
  4533. AssertNull('No transaction name',Rollback.TransactionName);
  4534. AssertEquals('work',True,Rollback.Work);
  4535. AssertEquals('release',True,Rollback.Release);
  4536. end;
  4537. procedure TTestRollBackParser.TestRollbackTransaction;
  4538. begin
  4539. TestRollBack('ROLLBACK TRANSACTION T');
  4540. AssertIdentifierName('Transaction name','T',Rollback.TransactionName);
  4541. AssertEquals('No work',False,Rollback.Work);
  4542. AssertEquals('No release',False,Rollback.Release);
  4543. end;
  4544. procedure TTestRollBackParser.TestRollbackTransactionWork;
  4545. begin
  4546. TestRollBack('ROLLBACK TRANSACTION T WORK');
  4547. AssertIdentifierName('Transaction name','T',Rollback.TransactionName);
  4548. AssertEquals('work',True,Rollback.Work);
  4549. AssertEquals('No release',False,Rollback.Release);
  4550. end;
  4551. procedure TTestRollBackParser.TestRollbackTransactionRelease;
  4552. begin
  4553. TestRollBack('ROLLBACK TRANSACTION T RELEASE');
  4554. AssertIdentifierName('Transaction name','T',Rollback.TransactionName);
  4555. AssertEquals('no work',False,Rollback.Work);
  4556. AssertEquals('release',True,Rollback.Release);
  4557. end;
  4558. procedure TTestRollBackParser.TestRollbackTransactionWorkRelease;
  4559. begin
  4560. TestRollBack('ROLLBACK TRANSACTION T WORK RELEASE');
  4561. AssertIdentifierName('Transaction name','T',Rollback.TransactionName);
  4562. AssertEquals('work',True,Rollback.Work);
  4563. AssertEquals('release',True,Rollback.Release);
  4564. end;
  4565. { TTestCommitParser }
  4566. function TTestCommitParser.TestCommit(const ASource: String
  4567. ): TSQLCommitStatement;
  4568. begin
  4569. CreateParser(ASource);
  4570. FToFree:=Parser.Parse;
  4571. Result:=TSQLCommitStatement(CheckClass(FToFree,TSQLCommitStatement));
  4572. FCommit:=Result;
  4573. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  4574. end;
  4575. procedure TTestCommitParser.TestCommitError(const ASource: String);
  4576. begin
  4577. FErrSource:=ASource;
  4578. AssertException(ESQLParser,@TestParseError);
  4579. end;
  4580. procedure TTestCommitParser.TestCommit;
  4581. begin
  4582. TestCommit('Commit');
  4583. AssertNull('No transaction name',Commit.TransactionName);
  4584. AssertEquals('No work',False,Commit.Work);
  4585. AssertEquals('No release',False,Commit.Release);
  4586. AssertEquals('No Retain',False,Commit.Retain);
  4587. end;
  4588. procedure TTestCommitParser.TestCommitWork;
  4589. begin
  4590. TestCommit('Commit WORK');
  4591. AssertNull('No transaction name',Commit.TransactionName);
  4592. AssertEquals('work',True,Commit.Work);
  4593. AssertEquals('No release',False,Commit.Release);
  4594. AssertEquals('No Retain',False,Commit.Retain);
  4595. end;
  4596. procedure TTestCommitParser.TestCommitRelease;
  4597. begin
  4598. TestCommit('Commit RELEASE');
  4599. AssertNull('No transaction name',Commit.TransactionName);
  4600. AssertEquals('no work',False,Commit.Work);
  4601. AssertEquals('release',True,Commit.Release);
  4602. AssertEquals('No Retain',False,Commit.Retain);
  4603. end;
  4604. procedure TTestCommitParser.TestCommitWorkRelease;
  4605. begin
  4606. TestCommit('Commit WORK RELEASE');
  4607. AssertNull('No transaction name',Commit.TransactionName);
  4608. AssertEquals('work',True,Commit.Work);
  4609. AssertEquals('release',True,Commit.Release);
  4610. AssertEquals('No Retain',False,Commit.Retain);
  4611. end;
  4612. procedure TTestCommitParser.TestCommitTransaction;
  4613. begin
  4614. TestCommit('Commit TRANSACTION T');
  4615. AssertIdentifierName('Transaction name','T',Commit.TransactionName);
  4616. AssertEquals('No work',False,Commit.Work);
  4617. AssertEquals('No release',False,Commit.Release);
  4618. AssertEquals('No Retain',False,Commit.Retain);
  4619. end;
  4620. procedure TTestCommitParser.TestCommitTransactionWork;
  4621. begin
  4622. TestCommit('Commit WORK TRANSACTION T ');
  4623. AssertIdentifierName('Transaction name','T',Commit.TransactionName);
  4624. AssertEquals('work',True,Commit.Work);
  4625. AssertEquals('No release',False,Commit.Release);
  4626. AssertEquals('No Retain',False,Commit.Retain);
  4627. end;
  4628. procedure TTestCommitParser.TestCommitTransactionRelease;
  4629. begin
  4630. TestCommit('Commit TRANSACTION T RELEASE');
  4631. AssertIdentifierName('Transaction name','T',Commit.TransactionName);
  4632. AssertEquals('no work',False,Commit.Work);
  4633. AssertEquals('release',True,Commit.Release);
  4634. AssertEquals('No Retain',False,Commit.Retain);
  4635. end;
  4636. procedure TTestCommitParser.TestCommitTransactionWorkRelease;
  4637. begin
  4638. TestCommit('Commit WORK TRANSACTION T RELEASE');
  4639. AssertIdentifierName('Transaction name','T',Commit.TransactionName);
  4640. AssertEquals('work',True,Commit.Work);
  4641. AssertEquals('release',True,Commit.Release);
  4642. AssertEquals('No Retain',False,Commit.Retain);
  4643. end;
  4644. procedure TTestCommitParser.TestCommitRetain;
  4645. begin
  4646. TestCommit('Commit RETAIN');
  4647. AssertNull('No transaction name',Commit.TransactionName);
  4648. AssertEquals('No work',False,Commit.Work);
  4649. AssertEquals('No release',False,Commit.Release);
  4650. AssertEquals('Retain',True,Commit.Retain);
  4651. end;
  4652. procedure TTestCommitParser.TestCommitRetainSnapShot;
  4653. begin
  4654. TestCommit('Commit RETAIN SNAPSHOT');
  4655. AssertNull('No transaction name',Commit.TransactionName);
  4656. AssertEquals('No work',False,Commit.Work);
  4657. AssertEquals('No release',False,Commit.Release);
  4658. AssertEquals('Retain',True,Commit.Retain);
  4659. end;
  4660. procedure TTestCommitParser.TestCommitWorkRetain;
  4661. begin
  4662. TestCommit('Commit WORK RETAIN');
  4663. AssertNull('No transaction name',Commit.TransactionName);
  4664. AssertEquals('work',True,Commit.Work);
  4665. AssertEquals('No release',False,Commit.Release);
  4666. AssertEquals('Retain',True,Commit.Retain);
  4667. end;
  4668. procedure TTestCommitParser.TestCommitReleaseRetain;
  4669. begin
  4670. TestCommit('Commit RELEASE RETAIN');
  4671. AssertNull('No transaction name',Commit.TransactionName);
  4672. AssertEquals('no work',False,Commit.Work);
  4673. AssertEquals('release',True,Commit.Release);
  4674. AssertEquals('Retain',True,Commit.Retain);
  4675. end;
  4676. procedure TTestCommitParser.TestCommitWorkReleaseRetain;
  4677. begin
  4678. TestCommit('Commit WORK RELEASE RETAIN');
  4679. AssertNull('No transaction name',Commit.TransactionName);
  4680. AssertEquals('work',True,Commit.Work);
  4681. AssertEquals('release',True,Commit.Release);
  4682. AssertEquals('Retain',True,Commit.Retain);
  4683. end;
  4684. procedure TTestCommitParser.TestCommitTransactionRetain;
  4685. begin
  4686. TestCommit('Commit TRANSACTION T RETAIN');
  4687. AssertIdentifierName('Transaction name','T',Commit.TransactionName);
  4688. AssertEquals('No work',False,Commit.Work);
  4689. AssertEquals('No release',False,Commit.Release);
  4690. AssertEquals('Retain',True,Commit.Retain);
  4691. end;
  4692. procedure TTestCommitParser.TestCommitTransactionWorkRetain;
  4693. begin
  4694. TestCommit('Commit WORK TRANSACTION T RETAIN');
  4695. AssertIdentifierName('Transaction name','T',Commit.TransactionName);
  4696. AssertEquals('work',True,Commit.Work);
  4697. AssertEquals('No release',False,Commit.Release);
  4698. AssertEquals('Retain',True,Commit.Retain);
  4699. end;
  4700. procedure TTestCommitParser.TestCommitTransactionReleaseRetain;
  4701. begin
  4702. TestCommit('Commit TRANSACTION T RELEASE RETAIN');
  4703. AssertIdentifierName('Transaction name','T',Commit.TransactionName);
  4704. AssertEquals('no work',False,Commit.Work);
  4705. AssertEquals('release',True,Commit.Release);
  4706. AssertEquals('Retain',True,Commit.Retain);
  4707. end;
  4708. procedure TTestCommitParser.TestCommitTransactionWorkReleaseRetain;
  4709. begin
  4710. TestCommit('Commit WORK TRANSACTION T RELEASE RETAIN');
  4711. AssertIdentifierName('Transaction name','T',Commit.TransactionName);
  4712. AssertEquals('work',True,Commit.Work);
  4713. AssertEquals('release',True,Commit.Release);
  4714. AssertEquals('Retain',True,Commit.Retain);
  4715. end;
  4716. { TTestExecuteProcedureParser }
  4717. function TTestExecuteProcedureParser.TestExecute(const ASource: String
  4718. ): TSQLExecuteProcedureStatement;
  4719. begin
  4720. CreateParser(ASource);
  4721. FToFree:=Parser.Parse;
  4722. Result:=TSQLExecuteProcedureStatement(CheckClass(FToFree,TSQLExecuteProcedureStatement));
  4723. FExecute:=Result;
  4724. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  4725. end;
  4726. procedure TTestExecuteProcedureParser.TestExecuteError(const ASource: String);
  4727. begin
  4728. FErrSource:=ASource;
  4729. AssertException(ESQLParser,@TestParseError);
  4730. end;
  4731. procedure TTestExecuteProcedureParser.TestExecuteSimple;
  4732. begin
  4733. TestExecute('EXECUTE PROCEDURE A');
  4734. AssertIdentifierName('Correct procedure name','A',Execute.ProcedureName);
  4735. AssertNull('No transaction name',Execute.TransactionName);
  4736. AssertEquals('No arguments',0,Execute.Params.Count);
  4737. AssertEquals('No return values',0,Execute.Returning.Count);
  4738. end;
  4739. procedure TTestExecuteProcedureParser.TestExecuteSimpleTransaction;
  4740. begin
  4741. TestExecute('EXECUTE PROCEDURE TRANSACTION B A');
  4742. AssertIdentifierName('Correct procedure name','A',Execute.ProcedureName);
  4743. AssertIdentifierName('Correct transaction name','B',Execute.TransactionName);
  4744. AssertEquals('No arguments',0,Execute.Params.Count);
  4745. AssertEquals('No return values',0,Execute.Returning.Count);
  4746. end;
  4747. procedure TTestExecuteProcedureParser.TestExecuteSimpleReturningValues;
  4748. begin
  4749. TestExecute('EXECUTE PROCEDURE A RETURNING_VALUES :B');
  4750. AssertIdentifierName('Correct procedure name','A',Execute.ProcedureName);
  4751. AssertNull('No transaction name',Execute.TransactionName);
  4752. AssertEquals('No arguments',0,Execute.Params.Count);
  4753. AssertEquals('1 return value',1,Execute.Returning.Count);
  4754. AssertIdentifierName('return value','B',Execute.Returning[0]);
  4755. end;
  4756. procedure TTestExecuteProcedureParser.TestExecuteSimpleReturning2Values;
  4757. begin
  4758. TestExecute('EXECUTE PROCEDURE A RETURNING_VALUES :B,:C');
  4759. AssertIdentifierName('Correct procedure name','A',Execute.ProcedureName);
  4760. AssertNull('No transaction name',Execute.TransactionName);
  4761. AssertEquals('No arguments',0,Execute.Params.Count);
  4762. AssertEquals('2 return values',2,Execute.Returning.Count);
  4763. AssertIdentifierName('return value','B',Execute.Returning[0]);
  4764. AssertIdentifierName('return value','C',Execute.Returning[1]);
  4765. end;
  4766. procedure TTestExecuteProcedureParser.TestExecuteOneArg;
  4767. Var
  4768. I : TSQLIdentifierExpression;
  4769. begin
  4770. TestExecute('EXECUTE PROCEDURE A (B)');
  4771. AssertIdentifierName('Correct procedure name','A',Execute.ProcedureName);
  4772. AssertNull('No transaction name',Execute.TransactionName);
  4773. AssertEquals('One argument',1,Execute.Params.Count);
  4774. I:=TSQLIdentifierExpression(CheckClass(Execute.Params[0],TSQLIdentifierExpression));
  4775. AssertIdentifierName('Correct argument','B',I.Identifier);
  4776. AssertEquals('No return values',0,Execute.Returning.Count);
  4777. end;
  4778. procedure TTestExecuteProcedureParser.TestExecuteOneArgNB;
  4779. Var
  4780. I : TSQLIdentifierExpression;
  4781. begin
  4782. TestExecute('EXECUTE PROCEDURE A B');
  4783. AssertIdentifierName('Correct procedure name','A',Execute.ProcedureName);
  4784. AssertNull('No transaction name',Execute.TransactionName);
  4785. AssertEquals('One argument',1,Execute.Params.Count);
  4786. I:=TSQLIdentifierExpression(CheckClass(Execute.Params[0],TSQLIdentifierExpression));
  4787. AssertIdentifierName('Correct argument','B',I.Identifier);
  4788. AssertEquals('No return values',0,Execute.Returning.Count);
  4789. end;
  4790. procedure TTestExecuteProcedureParser.TestExecuteTwoArgs;
  4791. Var
  4792. I : TSQLIdentifierExpression;
  4793. begin
  4794. TestExecute('EXECUTE PROCEDURE A (B,C)');
  4795. AssertIdentifierName('Correct procedure name','A',Execute.ProcedureName);
  4796. AssertNull('No transaction name',Execute.TransactionName);
  4797. AssertEquals('Two arguments',2,Execute.Params.Count);
  4798. I:=TSQLIdentifierExpression(CheckClass(Execute.Params[0],TSQLIdentifierExpression));
  4799. AssertIdentifierName('Correct argument','B',I.Identifier);
  4800. I:=TSQLIdentifierExpression(CheckClass(Execute.Params[1],TSQLIdentifierExpression));
  4801. AssertIdentifierName('Correct argument','C',I.Identifier);
  4802. AssertEquals('No return values',0,Execute.Returning.Count);
  4803. end;
  4804. procedure TTestExecuteProcedureParser.TestExecuteTwoArgsNB;
  4805. Var
  4806. I : TSQLIdentifierExpression;
  4807. begin
  4808. TestExecute('EXECUTE PROCEDURE A B, C');
  4809. AssertIdentifierName('Correct procedure name','A',Execute.ProcedureName);
  4810. AssertNull('No transaction name',Execute.TransactionName);
  4811. AssertEquals('Two arguments',2,Execute.Params.Count);
  4812. I:=TSQLIdentifierExpression(CheckClass(Execute.Params[0],TSQLIdentifierExpression));
  4813. AssertIdentifierName('Correct argument','B',I.Identifier);
  4814. I:=TSQLIdentifierExpression(CheckClass(Execute.Params[1],TSQLIdentifierExpression));
  4815. AssertIdentifierName('Correct argument','C',I.Identifier);
  4816. AssertEquals('No return values',0,Execute.Returning.Count);
  4817. end;
  4818. procedure TTestExecuteProcedureParser.TestExecuteOneArgSelect;
  4819. Var
  4820. S : TSQLSelectExpression;
  4821. begin
  4822. TestExecute('EXECUTE PROCEDURE A ((SELECT B FROM C))');
  4823. AssertIdentifierName('Correct procedure name','A',Execute.ProcedureName);
  4824. AssertNull('No transaction name',Execute.TransactionName);
  4825. AssertEquals('One argument',1,Execute.Params.Count);
  4826. S:=TSQLSelectExpression(CheckClass(Execute.Params[0],TSQLSelectExpression));
  4827. AssertField(S.Select.Fields[0],'B','');
  4828. AssertTable(S.Select.Tables[0],'C','');
  4829. AssertEquals('No return values',0,Execute.Returning.Count);
  4830. end;
  4831. procedure TTestExecuteProcedureParser.TestExecuteOneArgSelectNB;
  4832. Var
  4833. S : TSQLSelectExpression;
  4834. begin
  4835. TestExecute('EXECUTE PROCEDURE A (SELECT B FROM C)');
  4836. AssertIdentifierName('Correct procedure name','A',Execute.ProcedureName);
  4837. AssertNull('No transaction name',Execute.TransactionName);
  4838. AssertEquals('One argument',1,Execute.Params.Count);
  4839. S:=TSQLSelectExpression(CheckClass(Execute.Params[0],TSQLSelectExpression));
  4840. AssertField(S.Select.Fields[0],'B','');
  4841. AssertTable(S.Select.Tables[0],'C','');
  4842. AssertEquals('No return values',0,Execute.Returning.Count);
  4843. end;
  4844. procedure TTestExecuteProcedureParser.TestExecuteTwoArgsSelect;
  4845. Var
  4846. S : TSQLSelectExpression;
  4847. I : TSQLIdentifierExpression;
  4848. begin
  4849. TestExecute('EXECUTE PROCEDURE A ((SELECT B FROM C),D)');
  4850. AssertIdentifierName('Correct procedure name','A',Execute.ProcedureName);
  4851. AssertNull('No transaction name',Execute.TransactionName);
  4852. AssertEquals('Two arguments',2,Execute.Params.Count);
  4853. S:=TSQLSelectExpression(CheckClass(Execute.Params[0],TSQLSelectExpression));
  4854. AssertField(S.Select.Fields[0],'B','');
  4855. AssertTable(S.Select.Tables[0],'C','');
  4856. I:=TSQLIdentifierExpression(CheckClass(Execute.Params[1],TSQLIdentifierExpression));
  4857. AssertIdentifierName('Correct argument','D',I.Identifier);
  4858. AssertEquals('No return values',0,Execute.Returning.Count);
  4859. end;
  4860. procedure TTestExecuteProcedureParser.TestExecuteTwoArgsSelectNB;
  4861. Var
  4862. S : TSQLSelectExpression;
  4863. I : TSQLIdentifierExpression;
  4864. begin
  4865. TestExecute('EXECUTE PROCEDURE A (SELECT B FROM C),D');
  4866. AssertIdentifierName('Correct procedure name','A',Execute.ProcedureName);
  4867. AssertNull('No transaction name',Execute.TransactionName);
  4868. AssertEquals('Two arguments',2,Execute.Params.Count);
  4869. S:=TSQLSelectExpression(CheckClass(Execute.Params[0],TSQLSelectExpression));
  4870. AssertField(S.Select.Fields[0],'B','');
  4871. AssertTable(S.Select.Tables[0],'C','');
  4872. I:=TSQLIdentifierExpression(CheckClass(Execute.Params[1],TSQLIdentifierExpression));
  4873. AssertIdentifierName('Correct argument','D',I.Identifier);
  4874. AssertEquals('No return values',0,Execute.Returning.Count);
  4875. end;
  4876. procedure TTestExecuteProcedureParser.TestExecuteOneArgSelectErr;
  4877. begin
  4878. TestExecuteError('EXECUTE PROCEDURE A ((SELECT B FROM C), 2')
  4879. end;
  4880. procedure TTestExecuteProcedureParser.TestExecuteOneArgSelectErr2;
  4881. begin
  4882. TestExecuteError('EXECUTE PROCEDURE A (SELECT B FROM C), 2)')
  4883. end;
  4884. procedure TTestExecuteProcedureParser.TestExecuteOneArgSelectErr3;
  4885. begin
  4886. TestExecuteError('EXECUTE PROCEDURE A B)')
  4887. end;
  4888. procedure TTestExecuteProcedureParser.TestExecuteOneArgSelectErr4;
  4889. begin
  4890. TestExecuteError('EXECUTE PROCEDURE A B,C)')
  4891. end;
  4892. { EXECUTE PROCEDURE DELETE_EMPLOYEE2 1, 2;
  4893. EXECUTE PROCEDURE DELETE_EMPLOYEE2 (1, 2);
  4894. EXECUTE PROCEDURE DELETE_EMPLOYEE2 ((SELECT A FROM A), 2);
  4895. EXECUTE PROCEDURE DELETE_EMPLOYEE2 (SELECT A FROM A), 2;
  4896. }
  4897. { TTestConnectParser }
  4898. function TTestConnectParser.TestConnect(const ASource: String
  4899. ): TSQLConnectStatement;
  4900. begin
  4901. CreateParser(ASource);
  4902. FToFree:=Parser.Parse;
  4903. Result:=TSQLConnectStatement(CheckClass(FToFree,TSQLConnectStatement));
  4904. FConnect:=Result;
  4905. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  4906. end;
  4907. procedure TTestConnectParser.TestConnectError(const ASource: String);
  4908. begin
  4909. FErrSource:=ASource;
  4910. AssertException(ESQLParser,@TestParseError);
  4911. end;
  4912. procedure TTestConnectParser.TestConnectSimple;
  4913. begin
  4914. TestConnect('CONNECT ''/my/database/file''');
  4915. AssertEquals('Database name','/my/database/file',Connect.DatabaseName);
  4916. AssertEquals('User name','',Connect.UserName);
  4917. AssertEquals('Password','',Connect.Password);
  4918. AssertEquals('Role','',Connect.Role);
  4919. AssertEquals('Cache',0,Connect.Cache);
  4920. end;
  4921. procedure TTestConnectParser.TestConnectUser;
  4922. begin
  4923. TestConnect('CONNECT ''/my/database/file'' USER ''me''');
  4924. AssertEquals('Database name','/my/database/file',Connect.DatabaseName);
  4925. AssertEquals('User name','me',Connect.UserName);
  4926. AssertEquals('Password','',Connect.Password);
  4927. AssertEquals('Role','',Connect.Role);
  4928. AssertEquals('Cache',0,Connect.Cache);
  4929. end;
  4930. procedure TTestConnectParser.TestConnectPassword;
  4931. begin
  4932. TestConnect('CONNECT ''/my/database/file'' PASSWORD ''secret''');
  4933. AssertEquals('Database name','/my/database/file',Connect.DatabaseName);
  4934. AssertEquals('User name','',Connect.UserName);
  4935. AssertEquals('Password','secret',Connect.Password);
  4936. AssertEquals('Role','',Connect.Role);
  4937. AssertEquals('Cache',0,Connect.Cache);
  4938. end;
  4939. procedure TTestConnectParser.TestConnectUserPassword;
  4940. begin
  4941. TestConnect('CONNECT ''/my/database/file'' USER ''me'' PASSWORD ''secret''');
  4942. AssertEquals('Database name','/my/database/file',Connect.DatabaseName);
  4943. AssertEquals('User name','me',Connect.UserName);
  4944. AssertEquals('Password','secret',Connect.Password);
  4945. AssertEquals('Role','',Connect.Role);
  4946. AssertEquals('Cache',0,Connect.Cache);
  4947. end;
  4948. procedure TTestConnectParser.TestConnectUserPasswordRole;
  4949. begin
  4950. TestConnect('CONNECT ''/my/database/file'' USER ''me'' PASSWORD ''secret'' ROLE ''admin''');
  4951. AssertEquals('Database name','/my/database/file',Connect.DatabaseName);
  4952. AssertEquals('User name','me',Connect.UserName);
  4953. AssertEquals('Password','secret',Connect.Password);
  4954. AssertEquals('Role','admin',Connect.Role);
  4955. AssertEquals('Cache',0,Connect.Cache);
  4956. end;
  4957. procedure TTestConnectParser.TestConnectUserPasswordRoleCache;
  4958. begin
  4959. TestConnect('CONNECT ''/my/database/file'' USER ''me'' PASSWORD ''secret'' ROLE ''admin'' CACHE 2048');
  4960. AssertEquals('Database name','/my/database/file',Connect.DatabaseName);
  4961. AssertEquals('User name','me',Connect.UserName);
  4962. AssertEquals('Password','secret',Connect.Password);
  4963. AssertEquals('Role','admin',Connect.Role);
  4964. AssertEquals('Cache',2048,Connect.Cache);
  4965. end;
  4966. procedure TTestConnectParser.TestConnectSimpleCache;
  4967. begin
  4968. TestConnect('CONNECT ''/my/database/file'' CACHE 2048');
  4969. AssertEquals('Database name','/my/database/file',Connect.DatabaseName);
  4970. AssertEquals('User name','',Connect.UserName);
  4971. AssertEquals('Password','',Connect.Password);
  4972. AssertEquals('Role','',Connect.Role);
  4973. AssertEquals('Cache',2048,Connect.Cache);
  4974. end;
  4975. { TTestCreateDatabaseParser }
  4976. function TTestCreateDatabaseParser.TestCreate(const ASource: String
  4977. ): TSQLCreateDatabaseStatement;
  4978. begin
  4979. CreateParser(ASource);
  4980. FToFree:=Parser.Parse;
  4981. Result:=TSQLCreateDatabaseStatement(CheckClass(FToFree,TSQLCreateDatabaseStatement));
  4982. FCreateDB:=Result;
  4983. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  4984. end;
  4985. procedure TTestCreateDatabaseParser.TestCreateError(const ASource: String);
  4986. begin
  4987. FerrSource:=ASource;
  4988. AssertException(ESQLParser,@TestParseError);
  4989. end;
  4990. procedure TTestCreateDatabaseParser.TestSimple;
  4991. begin
  4992. TestCreate('CREATE DATABASE ''/my/database/file''');
  4993. AssertEquals('Not schema',False,CreateDB.UseSchema);
  4994. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  4995. AssertEquals('Username','',CreateDB.UserName);
  4996. AssertEquals('Password','',CreateDB.Password);
  4997. AssertNull('Character set',CreateDB.CharSet);
  4998. AssertEquals('Page size',0,CreateDB.PageSize);
  4999. AssertEquals('Length',0,CreateDB.Length);
  5000. AssertEquals('Secondary files',0,CreateDB.SecondaryFiles.Count);
  5001. end;
  5002. procedure TTestCreateDatabaseParser.TestSimpleSchema;
  5003. begin
  5004. TestCreate('CREATE SCHEMA ''/my/database/file''');
  5005. AssertEquals('schema',True,CreateDB.UseSchema);
  5006. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5007. AssertEquals('Username','',CreateDB.UserName);
  5008. AssertEquals('Password','',CreateDB.Password);
  5009. AssertNull('Character set',CreateDB.CharSet);
  5010. AssertEquals('Page size',0,CreateDB.PageSize);
  5011. AssertEquals('Length',0,CreateDB.Length);
  5012. AssertEquals('Secondary files',0,CreateDB.SecondaryFiles.Count);
  5013. end;
  5014. procedure TTestCreateDatabaseParser.TestSimpleUSer;
  5015. begin
  5016. TestCreate('CREATE DATABASE ''/my/database/file'' USER ''me''');
  5017. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5018. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5019. AssertEquals('Username','me',CreateDB.UserName);
  5020. AssertEquals('Password','',CreateDB.Password);
  5021. AssertNull('Character set',CreateDB.CharSet);
  5022. AssertEquals('Page size',0,CreateDB.PageSize);
  5023. AssertEquals('Length',0,CreateDB.Length);
  5024. AssertEquals('Secondary files',0,CreateDB.SecondaryFiles.Count);
  5025. end;
  5026. procedure TTestCreateDatabaseParser.TestSimpleUSerPassword;
  5027. begin
  5028. TestCreate('CREATE DATABASE ''/my/database/file'' USER ''me'' PASSWORD ''SECRET''');
  5029. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5030. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5031. AssertEquals('Username','me',CreateDB.UserName);
  5032. AssertEquals('Password','SECRET',CreateDB.Password);
  5033. AssertNull('Character set',CreateDB.CharSet);
  5034. AssertEquals('Page size',0,CreateDB.PageSize);
  5035. AssertEquals('Length',0,CreateDB.Length);
  5036. AssertEquals('Secondary files',0,CreateDB.SecondaryFiles.Count);
  5037. end;
  5038. procedure TTestCreateDatabaseParser.TestSimplePassword;
  5039. begin
  5040. TestCreate('CREATE DATABASE ''/my/database/file'' PASSWORD ''SECRET''');
  5041. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5042. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5043. AssertEquals('Username','',CreateDB.UserName);
  5044. AssertEquals('Password','SECRET',CreateDB.Password);
  5045. AssertNull('Character set',CreateDB.CharSet);
  5046. AssertEquals('Page size',0,CreateDB.PageSize);
  5047. AssertEquals('Length',0,CreateDB.Length);
  5048. AssertEquals('Secondary files',0,CreateDB.SecondaryFiles.Count);
  5049. end;
  5050. procedure TTestCreateDatabaseParser.TestPageSize;
  5051. begin
  5052. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE = 2048');
  5053. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5054. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5055. AssertEquals('Username','',CreateDB.UserName);
  5056. AssertEquals('Password','',CreateDB.Password);
  5057. AssertNull('Character set',CreateDB.CharSet);
  5058. AssertEquals('Page size',2048,CreateDB.PageSize);
  5059. AssertEquals('Length',0,CreateDB.Length);
  5060. AssertEquals('Secondary files',0,CreateDB.SecondaryFiles.Count);
  5061. end;
  5062. procedure TTestCreateDatabaseParser.TestPageSize2;
  5063. begin
  5064. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048');
  5065. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5066. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5067. AssertEquals('Username','',CreateDB.UserName);
  5068. AssertEquals('Password','',CreateDB.Password);
  5069. AssertNull('Character set',CreateDB.CharSet);
  5070. AssertEquals('Page size',2048,CreateDB.PageSize);
  5071. AssertEquals('Length',0,CreateDB.Length);
  5072. AssertEquals('Secondary files',0,CreateDB.SecondaryFiles.Count);
  5073. end;
  5074. procedure TTestCreateDatabaseParser.TestPageSizeLength;
  5075. begin
  5076. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH = 2000');
  5077. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5078. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5079. AssertEquals('Username','',CreateDB.UserName);
  5080. AssertEquals('Password','',CreateDB.Password);
  5081. AssertNull('Character set',CreateDB.CharSet);
  5082. AssertEquals('Page size',2048,CreateDB.PageSize);
  5083. AssertEquals('Length',2000,CreateDB.Length);
  5084. AssertEquals('Secondary files',0,CreateDB.SecondaryFiles.Count);
  5085. end;
  5086. procedure TTestCreateDatabaseParser.TestPageSizeLength2;
  5087. begin
  5088. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000');
  5089. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5090. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5091. AssertEquals('Username','',CreateDB.UserName);
  5092. AssertEquals('Password','',CreateDB.Password);
  5093. AssertNull('Character set',CreateDB.CharSet);
  5094. AssertEquals('Page size',2048,CreateDB.PageSize);
  5095. AssertEquals('Length',2000,CreateDB.Length);
  5096. AssertEquals('Secondary files',0,CreateDB.SecondaryFiles.Count);
  5097. end;
  5098. procedure TTestCreateDatabaseParser.TestPageSizeLength3;
  5099. begin
  5100. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000 PAGES');
  5101. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5102. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5103. AssertEquals('Username','',CreateDB.UserName);
  5104. AssertEquals('Password','',CreateDB.Password);
  5105. AssertNull('Character set',CreateDB.CharSet);
  5106. AssertEquals('Page size',2048,CreateDB.PageSize);
  5107. AssertEquals('Length',2000,CreateDB.Length);
  5108. AssertEquals('Secondary files',0,CreateDB.SecondaryFiles.Count);
  5109. end;
  5110. procedure TTestCreateDatabaseParser.TestPageSizeLength4;
  5111. begin
  5112. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000 PAGE');
  5113. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5114. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5115. AssertEquals('Username','',CreateDB.UserName);
  5116. AssertEquals('Password','',CreateDB.Password);
  5117. AssertNull('Character set',CreateDB.CharSet);
  5118. AssertEquals('Page size',2048,CreateDB.PageSize);
  5119. AssertEquals('Length',2000,CreateDB.Length);
  5120. AssertEquals('Secondary files',0,CreateDB.SecondaryFiles.Count);
  5121. end;
  5122. procedure TTestCreateDatabaseParser.TestCharset;
  5123. begin
  5124. TestCreate('CREATE DATABASE ''/my/database/file'' DEFAULT CHARACTER SET UTF8');
  5125. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5126. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5127. AssertEquals('Username','',CreateDB.UserName);
  5128. AssertEquals('Password','',CreateDB.Password);
  5129. AssertIDentifierName('Character set','UTF8',CreateDB.CharSet);
  5130. AssertEquals('Page size',0,CreateDB.PageSize);
  5131. AssertEquals('Length',0,CreateDB.Length);
  5132. AssertEquals('Secondary files',0,CreateDB.SecondaryFiles.Count);
  5133. end;
  5134. procedure TTestCreateDatabaseParser.TestSecondaryFile1;
  5135. begin
  5136. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000 FILE ''/my/database/file2''');
  5137. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5138. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5139. AssertEquals('Username','',CreateDB.UserName);
  5140. AssertEquals('Password','',CreateDB.Password);
  5141. AssertNull('Character set',CreateDB.CharSet);
  5142. AssertEquals('Page size',2048,CreateDB.PageSize);
  5143. AssertEquals('Length',2000,CreateDB.Length);
  5144. AssertEquals('Secondary files',1,CreateDB.SecondaryFiles.Count);
  5145. AssertSecondaryFile(CreateDB.SecondaryFiles[0],'/my/database/file2',0,0);
  5146. end;
  5147. procedure TTestCreateDatabaseParser.TestSecondaryFile2;
  5148. begin
  5149. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000 FILE ''/my/database/file2'' LENGTH 1000');
  5150. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5151. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5152. AssertEquals('Username','',CreateDB.UserName);
  5153. AssertEquals('Password','',CreateDB.Password);
  5154. AssertNull('Character set',CreateDB.CharSet);
  5155. AssertEquals('Page size',2048,CreateDB.PageSize);
  5156. AssertEquals('Length',2000,CreateDB.Length);
  5157. AssertEquals('Secondary files',1,CreateDB.SecondaryFiles.Count);
  5158. AssertSecondaryFile(CreateDB.SecondaryFiles[0],'/my/database/file2',1000,0);
  5159. end;
  5160. procedure TTestCreateDatabaseParser.TestSecondaryFile3;
  5161. begin
  5162. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000 FILE ''/my/database/file2'' LENGTH = 1000');
  5163. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5164. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5165. AssertEquals('Username','',CreateDB.UserName);
  5166. AssertEquals('Password','',CreateDB.Password);
  5167. AssertNull('Character set',CreateDB.CharSet);
  5168. AssertEquals('Page size',2048,CreateDB.PageSize);
  5169. AssertEquals('Length',2000,CreateDB.Length);
  5170. AssertEquals('Secondary files',1,CreateDB.SecondaryFiles.Count);
  5171. AssertSecondaryFile(CreateDB.SecondaryFiles[0],'/my/database/file2',1000,0);
  5172. end;
  5173. procedure TTestCreateDatabaseParser.TestSecondaryFile4;
  5174. begin
  5175. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000 FILE ''/my/database/file2'' LENGTH = 1000 PAGE');
  5176. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5177. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5178. AssertEquals('Username','',CreateDB.UserName);
  5179. AssertEquals('Password','',CreateDB.Password);
  5180. AssertNull('Character set',CreateDB.CharSet);
  5181. AssertEquals('Page size',2048,CreateDB.PageSize);
  5182. AssertEquals('Length',2000,CreateDB.Length);
  5183. AssertEquals('Secondary files',1,CreateDB.SecondaryFiles.Count);
  5184. AssertSecondaryFile(CreateDB.SecondaryFiles[0],'/my/database/file2',1000,0);
  5185. end;
  5186. procedure TTestCreateDatabaseParser.TestSecondaryFile5;
  5187. begin
  5188. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000 FILE ''/my/database/file2'' LENGTH = 1000 PAGES');
  5189. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5190. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5191. AssertEquals('Username','',CreateDB.UserName);
  5192. AssertEquals('Password','',CreateDB.Password);
  5193. AssertNull('Character set',CreateDB.CharSet);
  5194. AssertEquals('Page size',2048,CreateDB.PageSize);
  5195. AssertEquals('Length',2000,CreateDB.Length);
  5196. AssertEquals('Secondary files',1,CreateDB.SecondaryFiles.Count);
  5197. AssertSecondaryFile(CreateDB.SecondaryFiles[0],'/my/database/file2',1000,0);
  5198. end;
  5199. procedure TTestCreateDatabaseParser.TestSecondaryFile6;
  5200. begin
  5201. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000 FILE ''/my/database/file2'' STARTING 3000 ');
  5202. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5203. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5204. AssertEquals('Username','',CreateDB.UserName);
  5205. AssertEquals('Password','',CreateDB.Password);
  5206. AssertNull('Character set',CreateDB.CharSet);
  5207. AssertEquals('Page size',2048,CreateDB.PageSize);
  5208. AssertEquals('Length',2000,CreateDB.Length);
  5209. AssertEquals('Secondary files',1,CreateDB.SecondaryFiles.Count);
  5210. AssertSecondaryFile(CreateDB.SecondaryFiles[0],'/my/database/file2',0,3000);
  5211. end;
  5212. procedure TTestCreateDatabaseParser.TestSecondaryFile7;
  5213. begin
  5214. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000 FILE ''/my/database/file2'' STARTING AT 3000 ');
  5215. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5216. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5217. AssertEquals('Username','',CreateDB.UserName);
  5218. AssertEquals('Password','',CreateDB.Password);
  5219. AssertNull('Character set',CreateDB.CharSet);
  5220. AssertEquals('Page size',2048,CreateDB.PageSize);
  5221. AssertEquals('Length',2000,CreateDB.Length);
  5222. AssertEquals('Secondary files',1,CreateDB.SecondaryFiles.Count);
  5223. AssertSecondaryFile(CreateDB.SecondaryFiles[0],'/my/database/file2',0,3000);
  5224. end;
  5225. procedure TTestCreateDatabaseParser.TestSecondaryFile9;
  5226. begin
  5227. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000 FILE ''/my/database/file2'' LENGTH 201 STARTING AT PAGE 3000 ');
  5228. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5229. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5230. AssertEquals('Username','',CreateDB.UserName);
  5231. AssertEquals('Password','',CreateDB.Password);
  5232. AssertNull('Character set',CreateDB.CharSet);
  5233. AssertEquals('Page size',2048,CreateDB.PageSize);
  5234. AssertEquals('Length',2000,CreateDB.Length);
  5235. AssertEquals('Secondary files',1,CreateDB.SecondaryFiles.Count);
  5236. AssertSecondaryFile(CreateDB.SecondaryFiles[0],'/my/database/file2',201,3000);
  5237. end;
  5238. procedure TTestCreateDatabaseParser.TestSecondaryFile10;
  5239. begin
  5240. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000 FILE ''/my/database/file2'' STARTING AT PAGE 3000 LENGTH 201');
  5241. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5242. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5243. AssertEquals('Username','',CreateDB.UserName);
  5244. AssertEquals('Password','',CreateDB.Password);
  5245. AssertNull('Character set',CreateDB.CharSet);
  5246. AssertEquals('Page size',2048,CreateDB.PageSize);
  5247. AssertEquals('Length',2000,CreateDB.Length);
  5248. AssertEquals('Secondary files',1,CreateDB.SecondaryFiles.Count);
  5249. AssertSecondaryFile(CreateDB.SecondaryFiles[0],'/my/database/file2',201,3000);
  5250. end;
  5251. procedure TTestCreateDatabaseParser.TestSecondaryFile8;
  5252. begin
  5253. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000 FILE ''/my/database/file2'' STARTING AT PAGE 3000 ');
  5254. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5255. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5256. AssertEquals('Username','',CreateDB.UserName);
  5257. AssertEquals('Password','',CreateDB.Password);
  5258. AssertNull('Character set',CreateDB.CharSet);
  5259. AssertEquals('Page size',2048,CreateDB.PageSize);
  5260. AssertEquals('Length',2000,CreateDB.Length);
  5261. AssertEquals('Secondary files',1,CreateDB.SecondaryFiles.Count);
  5262. AssertSecondaryFile(CreateDB.SecondaryFiles[0],'/my/database/file2',0,3000);
  5263. end;
  5264. procedure TTestCreateDatabaseParser.TestSecondaryFileS;
  5265. begin
  5266. TestCreate('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000 FILE ''/my/database/file2'' FILE ''/my/database/file3'' ');
  5267. AssertEquals('Not schema',False,CreateDB.UseSchema);
  5268. AssertEquals('Database file','/my/database/file',CreateDB.FileName);
  5269. AssertEquals('Username','',CreateDB.UserName);
  5270. AssertEquals('Password','',CreateDB.Password);
  5271. AssertNull('Character set',CreateDB.CharSet);
  5272. AssertEquals('Page size',2048,CreateDB.PageSize);
  5273. AssertEquals('Length',2000,CreateDB.Length);
  5274. AssertEquals('Secondary files',2,CreateDB.SecondaryFiles.Count);
  5275. AssertSecondaryFile(CreateDB.SecondaryFiles[0],'/my/database/file2',0,0);
  5276. AssertSecondaryFile(CreateDB.SecondaryFiles[1],'/my/database/file3',0,0);
  5277. end;
  5278. procedure TTestCreateDatabaseParser.TestSecondaryFileError1;
  5279. begin
  5280. TestCreateError('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000 FILE ''/my/database/file2'' LENGTH 3 LENGTH 2');
  5281. end;
  5282. procedure TTestCreateDatabaseParser.TestSecondaryFileError2;
  5283. begin
  5284. TestCreateError('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000 FILE ''/my/database/file2'' STARTING 3 STARTING 2');
  5285. end;
  5286. procedure TTestCreateDatabaseParser.TestSecondaryFileError3;
  5287. begin
  5288. TestCreateError('CREATE DATABASE ''/my/database/file'' PAGE_SIZE 2048 LENGTH 2000 FILE ''/my/database/file2'' STARTING 3 LENGTH 2 STARTING 2');
  5289. end;
  5290. { TTestAlterDatabaseParser }
  5291. function TTestAlterDatabaseParser.TestAlter(const ASource: String
  5292. ): TSQLAlterDatabaseStatement;
  5293. begin
  5294. CreateParser(ASource);
  5295. FToFree:=Parser.Parse;
  5296. Result:=TSQLAlterDatabaseStatement(CheckClass(FToFree,TSQLAlterDatabaseStatement));
  5297. FAlterDB:=Result;
  5298. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  5299. end;
  5300. procedure TTestAlterDatabaseParser.TestAlterError(const ASource: String);
  5301. begin
  5302. FerrSource:=ASource;
  5303. AssertException(ESQLParser,@TestParseError);
  5304. end;
  5305. procedure TTestAlterDatabaseParser.TestSimple;
  5306. begin
  5307. TestAlter('ALTER DATABASE ADD FILE ''/my/file''');
  5308. AssertEquals('Operation count',1,AlterDB.Operations.Count);
  5309. AssertSecondaryFile(AlterDB.Operations[0],'/my/file',0,0);
  5310. end;
  5311. procedure TTestAlterDatabaseParser.TestStarting;
  5312. begin
  5313. TestAlter('ALTER DATABASE ADD FILE ''/my/file'' STARTING AT 100');
  5314. AssertEquals('Operation count',1,AlterDB.Operations.Count);
  5315. AssertSecondaryFile(AlterDB.Operations[0],'/my/file',0,100);
  5316. end;
  5317. procedure TTestAlterDatabaseParser.TestStartingLength;
  5318. begin
  5319. TestAlter('ALTER DATABASE ADD FILE ''/my/file'' STARTING AT 100 LENGTH 200');
  5320. AssertEquals('Operation count',1,AlterDB.Operations.Count);
  5321. AssertSecondaryFile(AlterDB.Operations[0],'/my/file',200,100);
  5322. end;
  5323. procedure TTestAlterDatabaseParser.TestFiles;
  5324. begin
  5325. TestAlter('ALTER DATABASE ADD FILE ''/my/file2'' ADD FILE ''/my/file3'' ');
  5326. AssertEquals('Operation count',2,AlterDB.Operations.Count);
  5327. AssertSecondaryFile(AlterDB.Operations[0],'/my/file2',0,0);
  5328. AssertSecondaryFile(AlterDB.Operations[1],'/my/file3',0,0);
  5329. end;
  5330. procedure TTestAlterDatabaseParser.TestFiles2;
  5331. begin
  5332. TestAlter('ALTER DATABASE ADD FILE ''/my/file2'' FILE ''/my/file3'' ');
  5333. AssertEquals('Operation count',2,AlterDB.Operations.Count);
  5334. AssertSecondaryFile(AlterDB.Operations[0],'/my/file2',0,0);
  5335. AssertSecondaryFile(AlterDB.Operations[1],'/my/file3',0,0);
  5336. end;
  5337. procedure TTestAlterDatabaseParser.TestFilesError;
  5338. begin
  5339. TestAlterError('ALTER DATABASE FILE ''/my/file2'' FILE ''/my/file3'' ');
  5340. end;
  5341. procedure TTestAlterDatabaseParser.TestError;
  5342. begin
  5343. TestAlterError('ALTER DATABASE ');
  5344. end;
  5345. procedure TTestAlterDatabaseParser.TestLength;
  5346. begin
  5347. TestAlter('ALTER DATABASE ADD FILE ''/my/file'' LENGTH 200');
  5348. AssertEquals('Operation count',1,AlterDB.Operations.Count);
  5349. AssertSecondaryFile(AlterDB.Operations[0],'/my/file',200,0);
  5350. end;
  5351. { TTestCreateViewParser }
  5352. function TTestCreateViewParser.TestCreate(const ASource: String
  5353. ): TSQLCreateViewStatement;
  5354. begin
  5355. CreateParser(ASource);
  5356. FToFree:=Parser.Parse;
  5357. Result:=TSQLCreateViewStatement(CheckClass(FToFree,TSQLCreateViewStatement));
  5358. FView:=Result;
  5359. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  5360. end;
  5361. procedure TTestCreateViewParser.TestCreateError(const ASource: String);
  5362. begin
  5363. FerrSource:=ASource;
  5364. AssertException(ESQLParser,@TestParseError);
  5365. end;
  5366. procedure TTestCreateViewParser.TestSimple;
  5367. Var
  5368. S : TSQLSelectStatement;
  5369. begin
  5370. TestCreate('CREATE VIEW A AS SELECT B FROM C');
  5371. AssertIdentifierName('View name','A',View.ObjectName);
  5372. AssertNotNull('field list created',View.Fields);
  5373. AssertEquals('No fields in list',0,View.Fields.Count);
  5374. S:=TSQLSelectStatement(CheckClass(View.select,TSQLSelectStatement));
  5375. AssertEquals('1 Field',1,S.Fields.Count);
  5376. AssertField(S.Fields[0],'B','');
  5377. AssertEquals('1 table',1,S.Tables.Count);
  5378. AssertTable(S.Tables[0],'C','');
  5379. AssertEquals('No with check option',False,View.WithCheckOption);
  5380. end;
  5381. procedure TTestCreateViewParser.TestFieldList;
  5382. Var
  5383. S : TSQLSelectStatement;
  5384. begin
  5385. TestCreate('CREATE VIEW A (D) AS SELECT B FROM C');
  5386. AssertIdentifierName('View name','A',View.ObjectName);
  5387. AssertNotNull('field list created',View.Fields);
  5388. AssertEquals('1 field in list',1,View.Fields.Count);
  5389. AssertIdentifierName('Field name','D',View.Fields[0]);
  5390. S:=TSQLSelectStatement(CheckClass(View.select,TSQLSelectStatement));
  5391. AssertEquals('1 Field',1,S.Fields.Count);
  5392. AssertField(S.Fields[0],'B','');
  5393. AssertEquals('1 table',1,S.Tables.Count);
  5394. AssertTable(S.Tables[0],'C','');
  5395. AssertEquals('No with check option',False,View.WithCheckOption);
  5396. end;
  5397. procedure TTestCreateViewParser.TestFieldList2;
  5398. Var
  5399. S : TSQLSelectStatement;
  5400. begin
  5401. TestCreate('CREATE VIEW A (B,C) AS SELECT D,E FROM F');
  5402. AssertIdentifierName('View name','A',View.ObjectName);
  5403. AssertNotNull('field list created',View.Fields);
  5404. AssertEquals('2 fields in list',2,View.Fields.Count);
  5405. AssertIdentifierName('Field name','B',View.Fields[0]);
  5406. AssertIdentifierName('Field name','C',View.Fields[1]);
  5407. S:=TSQLSelectStatement(CheckClass(View.select,TSQLSelectStatement));
  5408. AssertEquals('2 Fields in select',2,S.Fields.Count);
  5409. AssertField(S.Fields[0],'D','');
  5410. AssertField(S.Fields[1],'E','');
  5411. AssertEquals('1 table',1,S.Tables.Count);
  5412. AssertTable(S.Tables[0],'F','');
  5413. AssertEquals('No with check option',False,View.WithCheckOption);
  5414. end;
  5415. procedure TTestCreateViewParser.TestSimpleWithCheckoption;
  5416. Var
  5417. S : TSQLSelectStatement;
  5418. begin
  5419. TestCreate('CREATE VIEW A AS SELECT B FROM C WITH CHECK OPTION');
  5420. AssertIdentifierName('View name','A',View.ObjectName);
  5421. AssertNotNull('field list created',View.Fields);
  5422. AssertEquals('No fields in list',0,View.Fields.Count);
  5423. S:=TSQLSelectStatement(CheckClass(View.select,TSQLSelectStatement));
  5424. AssertEquals('1 Field',1,S.Fields.Count);
  5425. AssertField(S.Fields[0],'B','');
  5426. AssertEquals('1 table',1,S.Tables.Count);
  5427. AssertTable(S.Tables[0],'C','');
  5428. AssertEquals('With check option',True,View.WithCheckOption);
  5429. end;
  5430. { TTestCreateShadowParser }
  5431. function TTestCreateShadowParser.TestCreate(const ASource: String
  5432. ): TSQLCreateShadowStatement;
  5433. begin
  5434. CreateParser(ASource);
  5435. FToFree:=Parser.Parse;
  5436. Result:=TSQLCreateShadowStatement(CheckClass(FToFree,TSQLCreateShadowStatement));
  5437. FShadow:=Result;
  5438. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  5439. end;
  5440. procedure TTestCreateShadowParser.TestCreateError(const ASource: String);
  5441. begin
  5442. FerrSource:=ASource;
  5443. AssertException(ESQLParser,@TestParseError);
  5444. end;
  5445. procedure TTestCreateShadowParser.TestSimple;
  5446. begin
  5447. TestCreate('CREATE SHADOW 1 ''/my/file''');
  5448. AssertEquals('Not manual',False,Shadow.Manual);
  5449. AssertEquals('Not conditional',False,Shadow.COnditional);
  5450. AssertEquals('Filename','/my/file',Shadow.FileName);
  5451. AssertEquals('No length',0,Shadow.Length);
  5452. AssertEquals('No secondary files',0,Shadow.SecondaryFiles.Count);
  5453. end;
  5454. procedure TTestCreateShadowParser.TestLength;
  5455. begin
  5456. TestCreate('CREATE SHADOW 1 ''/my/file'' LENGTH 2');
  5457. AssertEquals('Not manual',False,Shadow.Manual);
  5458. AssertEquals('Not conditional',False,Shadow.COnditional);
  5459. AssertEquals('Filename','/my/file',Shadow.FileName);
  5460. AssertEquals('No length',2,Shadow.Length);
  5461. AssertEquals('No secondary files',0,Shadow.SecondaryFiles.Count);
  5462. end;
  5463. procedure TTestCreateShadowParser.TestLength2;
  5464. begin
  5465. TestCreate('CREATE SHADOW 1 ''/my/file'' LENGTH = 2');
  5466. AssertEquals('Not manual',False,Shadow.Manual);
  5467. AssertEquals('Not conditional',False,Shadow.COnditional);
  5468. AssertEquals('Filename','/my/file',Shadow.FileName);
  5469. AssertEquals('No length',2,Shadow.Length);
  5470. AssertEquals('No secondary files',0,Shadow.SecondaryFiles.Count);
  5471. end;
  5472. procedure TTestCreateShadowParser.TestLength3;
  5473. begin
  5474. TestCreate('CREATE SHADOW 1 ''/my/file'' LENGTH = 2 PAGE');
  5475. AssertEquals('Not manual',False,Shadow.Manual);
  5476. AssertEquals('Not conditional',False,Shadow.COnditional);
  5477. AssertEquals('Filename','/my/file',Shadow.FileName);
  5478. AssertEquals('No length',2,Shadow.Length);
  5479. AssertEquals('No secondary files',0,Shadow.SecondaryFiles.Count);
  5480. end;
  5481. procedure TTestCreateShadowParser.TestLength4;
  5482. begin
  5483. TestCreate('CREATE SHADOW 1 ''/my/file'' LENGTH = 2 PAGES');
  5484. AssertEquals('Not manual',False,Shadow.Manual);
  5485. AssertEquals('Not conditional',False,Shadow.COnditional);
  5486. AssertEquals('Filename','/my/file',Shadow.FileName);
  5487. AssertEquals('No length',2,Shadow.Length);
  5488. AssertEquals('No secondary files',0,Shadow.SecondaryFiles.Count);
  5489. end;
  5490. procedure TTestCreateShadowParser.TestSecondaryFile1;
  5491. begin
  5492. TestCreate('CREATE SHADOW 1 ''/my/file'' LENGTH 2 FILE ''/my/file2''');
  5493. AssertEquals('Not manual',False,Shadow.Manual);
  5494. AssertEquals('Not conditional',False,Shadow.COnditional);
  5495. AssertEquals('Filename','/my/file',Shadow.FileName);
  5496. AssertEquals('No length',2,Shadow.Length);
  5497. AssertEquals('1 secondary file',1,Shadow.SecondaryFiles.Count);
  5498. AssertSecondaryFile(Shadow.SecondaryFiles[0],'/my/file2',0,0);
  5499. end;
  5500. procedure TTestCreateShadowParser.TestSecondaryFile2;
  5501. begin
  5502. TestCreate('CREATE SHADOW 1 ''/my/file'' LENGTH 2 FILE ''/my/file2'' LENGTH 1000');
  5503. AssertEquals('Not manual',False,Shadow.Manual);
  5504. AssertEquals('Not conditional',False,Shadow.COnditional);
  5505. AssertEquals('Filename','/my/file',Shadow.FileName);
  5506. AssertEquals('No length',2,Shadow.Length);
  5507. AssertEquals('1 secondary file',1,Shadow.SecondaryFiles.Count);
  5508. AssertSecondaryFile(Shadow.SecondaryFiles[0],'/my/file2',1000,0);
  5509. end;
  5510. procedure TTestCreateShadowParser.TestSecondaryFile3;
  5511. begin
  5512. TestCreate('CREATE SHADOW 1 ''/my/file'' LENGTH 2 FILE ''/my/file2'' LENGTH = 1000');
  5513. AssertEquals('Not manual',False,Shadow.Manual);
  5514. AssertEquals('Not conditional',False,Shadow.COnditional);
  5515. AssertEquals('Filename','/my/file',Shadow.FileName);
  5516. AssertEquals('No length',2,Shadow.Length);
  5517. AssertEquals('1 secondary file',1,Shadow.SecondaryFiles.Count);
  5518. AssertSecondaryFile(Shadow.SecondaryFiles[0],'/my/file2',1000,0);
  5519. end;
  5520. procedure TTestCreateShadowParser.TestSecondaryFile4;
  5521. begin
  5522. TestCreate('CREATE SHADOW 1 ''/my/file'' LENGTH 2 FILE ''/my/file2'' LENGTH = 1000 PAGE');
  5523. AssertEquals('Not manual',False,Shadow.Manual);
  5524. AssertEquals('Not conditional',False,Shadow.COnditional);
  5525. AssertEquals('Filename','/my/file',Shadow.FileName);
  5526. AssertEquals('No length',2,Shadow.Length);
  5527. AssertEquals('1 secondary file',1,Shadow.SecondaryFiles.Count);
  5528. AssertSecondaryFile(Shadow.SecondaryFiles[0],'/my/file2',1000,0);
  5529. end;
  5530. procedure TTestCreateShadowParser.TestSecondaryFile5;
  5531. begin
  5532. TestCreate('CREATE SHADOW 1 ''/my/file'' LENGTH 2 FILE ''/my/file2'' LENGTH = 1000 PAGES');
  5533. AssertEquals('Not manual',False,Shadow.Manual);
  5534. AssertEquals('Not conditional',False,Shadow.COnditional);
  5535. AssertEquals('Filename','/my/file',Shadow.FileName);
  5536. AssertEquals('No length',2,Shadow.Length);
  5537. AssertEquals('1 secondary file',1,Shadow.SecondaryFiles.Count);
  5538. AssertSecondaryFile(Shadow.SecondaryFiles[0],'/my/file2',1000,0);
  5539. end;
  5540. procedure TTestCreateShadowParser.TestSecondaryFile6;
  5541. begin
  5542. TestCreate('CREATE SHADOW 1 ''/my/file'' LENGTH 2 FILE ''/my/file2'' STARTING 3000');
  5543. AssertEquals('Not manual',False,Shadow.Manual);
  5544. AssertEquals('Not conditional',False,Shadow.COnditional);
  5545. AssertEquals('Filename','/my/file',Shadow.FileName);
  5546. AssertEquals('No length',2,Shadow.Length);
  5547. AssertEquals('1 secondary file',1,Shadow.SecondaryFiles.Count);
  5548. AssertSecondaryFile(Shadow.SecondaryFiles[0],'/my/file2',0,3000);
  5549. end;
  5550. procedure TTestCreateShadowParser.TestSecondaryFile7;
  5551. begin
  5552. TestCreate('CREATE SHADOW 1 ''/my/file'' LENGTH 2 FILE ''/my/file2'' STARTING AT 3000');
  5553. AssertEquals('Not manual',False,Shadow.Manual);
  5554. AssertEquals('Not conditional',False,Shadow.COnditional);
  5555. AssertEquals('Filename','/my/file',Shadow.FileName);
  5556. AssertEquals('No length',2,Shadow.Length);
  5557. AssertEquals('1 secondary file',1,Shadow.SecondaryFiles.Count);
  5558. AssertSecondaryFile(Shadow.SecondaryFiles[0],'/my/file2',0,3000);
  5559. end;
  5560. procedure TTestCreateShadowParser.TestSecondaryFile8;
  5561. begin
  5562. TestCreate('CREATE SHADOW 1 ''/my/file'' LENGTH 2 FILE ''/my/file2'' STARTING AT PAGE 3000');
  5563. AssertEquals('Not manual',False,Shadow.Manual);
  5564. AssertEquals('Not conditional',False,Shadow.COnditional);
  5565. AssertEquals('Filename','/my/file',Shadow.FileName);
  5566. AssertEquals('No length',2,Shadow.Length);
  5567. AssertEquals('1 secondary file',1,Shadow.SecondaryFiles.Count);
  5568. AssertSecondaryFile(Shadow.SecondaryFiles[0],'/my/file2',0,3000);
  5569. end;
  5570. procedure TTestCreateShadowParser.TestSecondaryFileS;
  5571. begin
  5572. TestCreate('CREATE SHADOW 1 ''/my/file'' LENGTH 2 FILE ''/my/file2'' FILE ''/my/file3''');
  5573. AssertEquals('Not manual',False,Shadow.Manual);
  5574. AssertEquals('Not conditional',False,Shadow.COnditional);
  5575. AssertEquals('Filename','/my/file',Shadow.FileName);
  5576. AssertEquals('No length',2,Shadow.Length);
  5577. AssertEquals('2 secondary file',2,Shadow.SecondaryFiles.Count);
  5578. AssertSecondaryFile(Shadow.SecondaryFiles[0],'/my/file2',0,0);
  5579. AssertSecondaryFile(Shadow.SecondaryFiles[1],'/my/file3',0,0);
  5580. end;
  5581. { TTestProcedureStatement }
  5582. function TTestProcedureStatement.TestStatement(const ASource: String
  5583. ): TSQLStatement;
  5584. begin
  5585. CreateParser(ASource);
  5586. Parser.GetNextToken;
  5587. FToFree:=Parser.ParseProcedureStatements;
  5588. If not (FToFree is TSQLStatement) then
  5589. Fail('Not a TSQLStatement');
  5590. Result:=TSQLStatement(FToFree);
  5591. FSTatement:=Result;
  5592. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  5593. end;
  5594. procedure TTestProcedureStatement.TestParseStatementError;
  5595. begin
  5596. CreateParser(FErrSource);
  5597. FToFree:=Parser.ParseProcedureStatements;
  5598. end;
  5599. procedure TTestProcedureStatement.TestStatementError(const ASource: String);
  5600. begin
  5601. FerrSource:=ASource;
  5602. AssertException(ESQLParser,@TestParseStatementError);
  5603. end;
  5604. procedure TTestProcedureStatement.TestException;
  5605. Var
  5606. E : TSQLExceptionStatement;
  5607. begin
  5608. E:=TSQLExceptionStatement(CheckClass(TestStatement('EXCEPTION MYE'),TSQLExceptionStatement));
  5609. AssertIdentifierName('Exception name','MYE',E.ExceptionName);
  5610. end;
  5611. procedure TTestProcedureStatement.TestExceptionError;
  5612. begin
  5613. TestStatementError('EXCEPTION ''MYE''');
  5614. end;
  5615. procedure TTestProcedureStatement.TestExit;
  5616. begin
  5617. CheckClass(TestStatement('EXIT'),TSQLExitStatement);
  5618. end;
  5619. procedure TTestProcedureStatement.TestSuspend;
  5620. begin
  5621. CheckClass(TestStatement('Suspend'),TSQLSuspendStatement);
  5622. end;
  5623. procedure TTestProcedureStatement.TestEmptyBlock;
  5624. Var
  5625. B : TSQLStatementBlock;
  5626. begin
  5627. B:=TSQLStatementBlock(CheckClass(TestStatement('BEGIN END'),TSQLStatementBlock));
  5628. AssertEquals('No statements',0,B.Statements.Count)
  5629. end;
  5630. procedure TTestProcedureStatement.TestExitBlock;
  5631. Var
  5632. B : TSQLStatementBlock;
  5633. begin
  5634. B:=TSQLStatementBlock(CheckClass(TestStatement('BEGIN EXIT; END'),TSQLStatementBlock));
  5635. AssertEquals('1 statement',1,B.Statements.Count);
  5636. CheckClass(B.Statements[0],TSQLExitStatement);
  5637. end;
  5638. procedure TTestProcedureStatement.TestExitBlockError;
  5639. begin
  5640. TestStatementError('BEGIN EXIT END')
  5641. end;
  5642. procedure TTestProcedureStatement.TestPostEvent;
  5643. Var
  5644. P : TSQLPostEventStatement;
  5645. begin
  5646. P:=TSQLPostEventStatement(CheckClass(TestStatement('POST_EVENT ''MYEVENT'''),TSQLPostEventStatement));
  5647. AssertEquals('Correct event name','MYEVENT' , P.EventName);
  5648. AssertNull('No event column',P.ColName);
  5649. end;
  5650. procedure TTestProcedureStatement.TestPostEventColName;
  5651. Var
  5652. P : TSQLPostEventStatement;
  5653. begin
  5654. P:=TSQLPostEventStatement(CheckClass(TestStatement('POST_EVENT MyColName'),TSQLPostEventStatement));
  5655. AssertEquals('Correct event name','' , P.EventName);
  5656. AssertIdentifierName('event column','MyColName',P.ColName);
  5657. end;
  5658. procedure TTestProcedureStatement.TestPostError;
  5659. begin
  5660. TestStatementError('POST_EVENT 1');
  5661. end;
  5662. procedure TTestProcedureStatement.TestAssignSimple;
  5663. Var
  5664. A : TSQLAssignStatement;
  5665. E : TSQLLiteralExpression;
  5666. I : TSQLIntegerLiteral;
  5667. begin
  5668. A:=TSQLAssignStatement(CheckClass(TestStatement('A=1'),TSQLAssignStatement));
  5669. AssertIdentifierName('Variable name','A',A.Variable);
  5670. E:=TSQLLiteralExpression(CheckClass(A.Expression,TSQLLiteralExpression));
  5671. I:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  5672. AssertEquals('Correct value',1,I.Value);
  5673. end;
  5674. procedure TTestProcedureStatement.TestAssignSimpleNew;
  5675. Var
  5676. A : TSQLAssignStatement;
  5677. E : TSQLLiteralExpression;
  5678. I : TSQLIntegerLiteral;
  5679. begin
  5680. A:=TSQLAssignStatement(CheckClass(TestStatement('NEW.A=1'),TSQLAssignStatement));
  5681. AssertIdentifierName('Variable name','NEW.A',A.Variable);
  5682. E:=TSQLLiteralExpression(CheckClass(A.Expression,TSQLLiteralExpression));
  5683. I:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  5684. AssertEquals('Correct value',1,I.Value);
  5685. end;
  5686. procedure TTestProcedureStatement.TestAssignSelect;
  5687. Var
  5688. A : TSQLAssignStatement;
  5689. S : TSQLSelectExpression;
  5690. begin
  5691. A:=TSQLAssignStatement(CheckClass(TestStatement('A=(SELECT B FROM C)'),TSQLAssignStatement));
  5692. AssertIdentifierName('Variable name','A',A.Variable);
  5693. S:=TSQLSelectExpression(CheckClass(A.Expression,TSQLSelectExpression));
  5694. AssertEquals('Field count',1,S.Select.Fields.Count);
  5695. AssertEquals('Table count',1,S.Select.Tables.Count);
  5696. AssertField(S.Select.Fields[0],'B','');
  5697. AssertTable(S.Select.Tables[0],'C','');
  5698. end;
  5699. procedure TTestProcedureStatement.TestBlockAssignSimple;
  5700. Var
  5701. A : TSQLAssignStatement;
  5702. E : TSQLLiteralExpression;
  5703. I : TSQLIntegerLiteral;
  5704. B : TSQLStatementBlock;
  5705. begin
  5706. B:=TSQLStatementBlock(CheckClass(TestStatement('BEGIN A=1; EXIT; END'),TSQLStatementBlock));
  5707. AssertEquals('2 statements',2,B.Statements.Count);
  5708. CheckClass(B.Statements[1],TSQLExitStatement);
  5709. A:=TSQLAssignStatement(CheckClass(B.Statements[0],TSQLAssignStatement));
  5710. AssertIdentifierName('Variable name','A',A.Variable);
  5711. E:=TSQLLiteralExpression(CheckClass(A.Expression,TSQLLiteralExpression));
  5712. I:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  5713. AssertEquals('Correct value',1,I.Value);
  5714. end;
  5715. procedure TTestProcedureStatement.TestIf;
  5716. Var
  5717. I : TSQLIfStatement;
  5718. C : TSQLBinaryExpression;
  5719. E : TSQLLiteralExpression;
  5720. A : TSQLIdentifierExpression;
  5721. LI : TSQLIntegerLiteral;
  5722. begin
  5723. I:=TSQLIfStatement(CheckClass(TestStatement('IF (A=1) THEN EXIT'),TSQLIfStatement));
  5724. C:=TSQLBinaryExpression(CheckClass(I.Condition,TSQLBinaryExpression));
  5725. AssertEquals('Equals',boEq,C.Operation);
  5726. E:=TSQLLiteralExpression(CheckClass(C.Right,TSQLLiteralExpression));
  5727. LI:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  5728. AssertEquals('Correct value',1,LI.Value);
  5729. A:=TSQLIdentifierExpression(CheckClass(C.Left,TSQLIdentifierExpression));
  5730. AssertIdentifierName('Variable name','A',A.Identifier);
  5731. CheckClass(I.TrueBranch,TSQLExitStatement);
  5732. end;
  5733. procedure TTestProcedureStatement.TestIfBlock;
  5734. Var
  5735. I : TSQLIfStatement;
  5736. C : TSQLBinaryExpression;
  5737. E : TSQLLiteralExpression;
  5738. A : TSQLIdentifierExpression;
  5739. LI : TSQLIntegerLiteral;
  5740. B : TSQLStatementBlock;
  5741. begin
  5742. I:=TSQLIfStatement(CheckClass(TestStatement('IF (A=1) THEN BEGIN EXIT; END'),TSQLIfStatement));
  5743. C:=TSQLBinaryExpression(CheckClass(I.Condition,TSQLBinaryExpression));
  5744. AssertEquals('Equals',boEq,C.Operation);
  5745. E:=TSQLLiteralExpression(CheckClass(C.Right,TSQLLiteralExpression));
  5746. LI:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  5747. AssertEquals('Correct value',1,LI.Value);
  5748. A:=TSQLIdentifierExpression(CheckClass(C.Left,TSQLIdentifierExpression));
  5749. AssertIdentifierName('Variable name','A',A.Identifier);
  5750. B:=TSQLStatementBlock(CheckClass(I.TrueBranch,TSQLStatementBlock));
  5751. AssertEquals('1 statement',1,B.Statements.Count);
  5752. CheckClass(B.Statements[0],TSQLExitStatement);
  5753. end;
  5754. procedure TTestProcedureStatement.TestIfElse;
  5755. Var
  5756. I : TSQLIfStatement;
  5757. C : TSQLBinaryExpression;
  5758. E : TSQLLiteralExpression;
  5759. A : TSQLIdentifierExpression;
  5760. LI : TSQLIntegerLiteral;
  5761. begin
  5762. I:=TSQLIfStatement(CheckClass(TestStatement('IF (A=1) THEN EXIT; ELSE SUSPEND'),TSQLIfStatement));
  5763. C:=TSQLBinaryExpression(CheckClass(I.Condition,TSQLBinaryExpression));
  5764. AssertEquals('Equals',boEq,C.Operation);
  5765. E:=TSQLLiteralExpression(CheckClass(C.Right,TSQLLiteralExpression));
  5766. LI:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  5767. AssertEquals('Correct value',1,LI.Value);
  5768. A:=TSQLIdentifierExpression(CheckClass(C.Left,TSQLIdentifierExpression));
  5769. AssertIdentifierName('Variable name','A',A.Identifier);
  5770. CheckClass(I.TrueBranch,TSQLExitStatement);
  5771. CheckClass(I.FalseBranch,TSQLSuspendStatement);
  5772. end;
  5773. procedure TTestProcedureStatement.TestIfBlockElse;
  5774. Var
  5775. I : TSQLIfStatement;
  5776. C : TSQLBinaryExpression;
  5777. E : TSQLLiteralExpression;
  5778. A : TSQLIdentifierExpression;
  5779. LI : TSQLIntegerLiteral;
  5780. B : TSQLStatementBlock;
  5781. begin
  5782. I:=TSQLIfStatement(CheckClass(TestStatement('IF (A=1) THEN BEGIN EXIT; END ELSE SUSPEND'),TSQLIfStatement));
  5783. C:=TSQLBinaryExpression(CheckClass(I.Condition,TSQLBinaryExpression));
  5784. AssertEquals('Equals',boEq,C.Operation);
  5785. E:=TSQLLiteralExpression(CheckClass(C.Right,TSQLLiteralExpression));
  5786. LI:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  5787. AssertEquals('Correct value',1,LI.Value);
  5788. A:=TSQLIdentifierExpression(CheckClass(C.Left,TSQLIdentifierExpression));
  5789. AssertIdentifierName('Variable name','A',A.Identifier);
  5790. B:=TSQLStatementBlock(CheckClass(I.TrueBranch,TSQLStatementBlock));
  5791. AssertEquals('1 statement',1,B.Statements.Count);
  5792. CheckClass(B.Statements[0],TSQLExitStatement);
  5793. CheckClass(I.FalseBranch,TSQLSuspendStatement);
  5794. end;
  5795. procedure TTestProcedureStatement.TestIfElseError;
  5796. begin
  5797. TestStatementError('IF (A=B) THEN EXIT ELSE SUSPEND');
  5798. TestStatementError('IF (A=B) THEN BEGIN EXIT; END; ELSE SUSPEND');
  5799. end;
  5800. procedure TTestProcedureStatement.TestIfBlockElseBlock;
  5801. Var
  5802. I : TSQLIfStatement;
  5803. C : TSQLBinaryExpression;
  5804. E : TSQLLiteralExpression;
  5805. A : TSQLIdentifierExpression;
  5806. LI : TSQLIntegerLiteral;
  5807. B : TSQLStatementBlock;
  5808. begin
  5809. I:=TSQLIfStatement(CheckClass(TestStatement('IF (A=1) THEN BEGIN EXIT; END ELSE BEGIN SUSPEND; END'),TSQLIfStatement));
  5810. C:=TSQLBinaryExpression(CheckClass(I.Condition,TSQLBinaryExpression));
  5811. AssertEquals('Equals',boEq,C.Operation);
  5812. E:=TSQLLiteralExpression(CheckClass(C.Right,TSQLLiteralExpression));
  5813. LI:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  5814. AssertEquals('Correct value',1,LI.Value);
  5815. A:=TSQLIdentifierExpression(CheckClass(C.Left,TSQLIdentifierExpression));
  5816. AssertIdentifierName('Variable name','A',A.Identifier);
  5817. B:=TSQLStatementBlock(CheckClass(I.TrueBranch,TSQLStatementBlock));
  5818. AssertEquals('1 statement',1,B.Statements.Count);
  5819. CheckClass(B.Statements[0],TSQLExitStatement);
  5820. B:=TSQLStatementBlock(CheckClass(I.FalseBranch,TSQLStatementBlock));
  5821. AssertEquals('1 statement',1,B.Statements.Count);
  5822. CheckClass(B.Statements[0],TSQLSuspendStatement);
  5823. end;
  5824. procedure TTestProcedureStatement.TestIfErrorBracketLeft;
  5825. begin
  5826. TestStatementError('IF A=1) THEN EXIT');
  5827. end;
  5828. procedure TTestProcedureStatement.TestIfErrorBracketRight;
  5829. begin
  5830. TestStatementError('IF (A=1 THEN EXIT');
  5831. end;
  5832. procedure TTestProcedureStatement.TestIfErrorNoThen;
  5833. begin
  5834. TestStatementError('IF (A=1) EXIT');
  5835. end;
  5836. procedure TTestProcedureStatement.TestIfErrorSemicolonElse;
  5837. begin
  5838. TestStatementError('IF (A=1) THEN EXIT; ELSE SUSPEND');
  5839. end;
  5840. procedure TTestProcedureStatement.TestWhile;
  5841. Var
  5842. W : TSQLWhileStatement;
  5843. C : TSQLBinaryExpression;
  5844. E : TSQLLiteralExpression;
  5845. A : TSQLIdentifierExpression;
  5846. LI : TSQLIntegerLiteral;
  5847. SA : TSQLAssignStatement;
  5848. begin
  5849. W:=TSQLWhileStatement(CheckClass(TestStatement('WHILE (A>1) DO A=A-1'),TSQLWhileStatement));
  5850. C:=TSQLBinaryExpression(CheckClass(W.Condition,TSQLBinaryExpression));
  5851. AssertEquals('Equals',boGT,C.Operation);
  5852. E:=TSQLLiteralExpression(CheckClass(C.Right,TSQLLiteralExpression));
  5853. LI:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  5854. AssertEquals('Correct value',1,LI.Value);
  5855. A:=TSQLIdentifierExpression(CheckClass(C.Left,TSQLIdentifierExpression));
  5856. AssertIdentifierName('Variable name','A',A.Identifier);
  5857. SA:=TSQLAssignStatement(CheckClass(W.Statement,TSQLAssignStatement));
  5858. AssertIdentifierName('Variable name','A',SA.Variable);
  5859. // Check assignment expression
  5860. C:=TSQLBinaryExpression(CheckClass(SA.Expression,TSQLBinaryExpression));
  5861. AssertEquals('Equals',boAdd,C.Operation);
  5862. // Left operand
  5863. A:=TSQLIdentifierExpression(CheckClass(C.Left,TSQLIdentifierExpression));
  5864. AssertIdentifierName('Variable name','A',A.Identifier);
  5865. // Right operand
  5866. E:=TSQLLiteralExpression(CheckClass(C.Right,TSQLLiteralExpression));
  5867. LI:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  5868. AssertEquals('Correct value',-1,LI.Value);
  5869. end;
  5870. procedure TTestProcedureStatement.TestWhileBlock;
  5871. Var
  5872. W : TSQLWhileStatement;
  5873. C : TSQLBinaryExpression;
  5874. E : TSQLLiteralExpression;
  5875. A : TSQLIdentifierExpression;
  5876. LI : TSQLIntegerLiteral;
  5877. SA : TSQLAssignStatement;
  5878. B : TSQLStatementBlock;
  5879. begin
  5880. W:=TSQLWhileStatement(CheckClass(TestStatement('WHILE (A>1) DO BEGIN A=A-1; END'),TSQLWhileStatement));
  5881. C:=TSQLBinaryExpression(CheckClass(W.Condition,TSQLBinaryExpression));
  5882. AssertEquals('Equals',boGT,C.Operation);
  5883. E:=TSQLLiteralExpression(CheckClass(C.Right,TSQLLiteralExpression));
  5884. LI:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  5885. AssertEquals('Correct value',1,LI.Value);
  5886. A:=TSQLIdentifierExpression(CheckClass(C.Left,TSQLIdentifierExpression));
  5887. AssertIdentifierName('Variable name','A',A.Identifier);
  5888. B:=TSQLStatementBlock(CheckClass(W.Statement,TSQLStatementBlock));
  5889. AssertEquals('One statement',1,B.Statements.Count);
  5890. SA:=TSQLAssignStatement(CheckClass(B.Statements[0],TSQLAssignStatement));
  5891. AssertIdentifierName('Variable name','A',SA.Variable);
  5892. // Check assignment expression
  5893. C:=TSQLBinaryExpression(CheckClass(SA.Expression,TSQLBinaryExpression));
  5894. AssertEquals('Equals',boAdd,C.Operation);
  5895. // Left operand
  5896. A:=TSQLIdentifierExpression(CheckClass(C.Left,TSQLIdentifierExpression));
  5897. AssertIdentifierName('Variable name','A',A.Identifier);
  5898. // Right operand
  5899. E:=TSQLLiteralExpression(CheckClass(C.Right,TSQLLiteralExpression));
  5900. LI:=TSQLIntegerLiteral(CheckClass(E.Literal,TSQLIntegerLiteral));
  5901. AssertEquals('Correct value',-1,LI.Value);
  5902. end;
  5903. procedure TTestProcedureStatement.TestWhileErrorBracketLeft;
  5904. begin
  5905. TestStatementError('WHILE A>1) DO A=A-1');
  5906. end;
  5907. procedure TTestProcedureStatement.TestWhileErrorBracketRight;
  5908. begin
  5909. TestStatementError('WHILE (A>1 DO A=A-1');
  5910. end;
  5911. procedure TTestProcedureStatement.TestWhileErrorNoDo;
  5912. begin
  5913. TestStatementError('WHILE (A>1) A=A-1');
  5914. end;
  5915. procedure TTestProcedureStatement.TestWhenAny;
  5916. Var
  5917. W : TSQLWhenStatement;
  5918. begin
  5919. W:=TSQLWhenStatement(CheckClass(TestStatement('WHEN ANY DO EXIT'),TSQLWhenStatement));
  5920. AssertEquals('No error codes',0,W.Errors.Count);
  5921. AssertEquals('Any error',True,W.AnyError);
  5922. CheckClass(W.Statement,TSQLExitStatement);
  5923. end;
  5924. procedure TTestProcedureStatement.TestWhenSQLCode;
  5925. Var
  5926. W : TSQLWhenStatement;
  5927. E : TSQLWhenSQLError;
  5928. begin
  5929. W:=TSQLWhenStatement(CheckClass(TestStatement('WHEN SQLCODE 1 DO EXIT'),TSQLWhenStatement));
  5930. AssertEquals('Not Any error',False,W.AnyError);
  5931. AssertEquals('1 error code',1,W.Errors.Count);
  5932. CheckClass(W.Statement,TSQLExitStatement);
  5933. E:=TSQLWhenSQLError(CheckClass(W.Errors[0],TSQLWhenSQLError));
  5934. AssertEquals('Correct SQL Code',1,E.ErrorCode);
  5935. end;
  5936. procedure TTestProcedureStatement.TestWhenGDSCode;
  5937. Var
  5938. W : TSQLWhenStatement;
  5939. E : TSQLWhenGDSError;
  5940. begin
  5941. W:=TSQLWhenStatement(CheckClass(TestStatement('WHEN GDSCODE 1 DO EXIT'),TSQLWhenStatement));
  5942. AssertEquals('Not Any error',False,W.AnyError);
  5943. AssertEquals('1 error code',1,W.Errors.Count);
  5944. CheckClass(W.Statement,TSQLExitStatement);
  5945. E:=TSQLWhenGDSError(CheckClass(W.Errors[0],TSQLWhenGDSError));
  5946. AssertEquals('Correct SQL Code',1,E.GDSErrorNumber);
  5947. end;
  5948. procedure TTestProcedureStatement.TestWhenException;
  5949. Var
  5950. W : TSQLWhenStatement;
  5951. E : TSQLWhenException;
  5952. begin
  5953. W:=TSQLWhenStatement(CheckClass(TestStatement('WHEN EXCEPTION MYE DO EXIT'),TSQLWhenStatement));
  5954. AssertEquals('Not Any error',False,W.AnyError);
  5955. AssertEquals('1 error code',1,W.Errors.Count);
  5956. CheckClass(W.Statement,TSQLExitStatement);
  5957. E:=TSQLWhenException(CheckClass(W.Errors[0],TSQLWhenException));
  5958. AssertIdentifierName('Correct SQL Code','MYE',E.ExceptionName);
  5959. end;
  5960. procedure TTestProcedureStatement.TestWhenExceptionGDS;
  5961. Var
  5962. W : TSQLWhenStatement;
  5963. E : TSQLWhenException;
  5964. G : TSQLWhenGDSError;
  5965. begin
  5966. W:=TSQLWhenStatement(CheckClass(TestStatement('WHEN EXCEPTION MYE, GDSCODE 1 DO EXIT'),TSQLWhenStatement));
  5967. AssertEquals('Not Any error',False,W.AnyError);
  5968. AssertEquals('2 error code',2,W.Errors.Count);
  5969. CheckClass(W.Statement,TSQLExitStatement);
  5970. E:=TSQLWhenException(CheckClass(W.Errors[0],TSQLWhenException));
  5971. AssertIdentifierName('Correct SQL Code','MYE',E.ExceptionName);
  5972. G:=TSQLWhenGDSError(CheckClass(W.Errors[1],TSQLWhenGDSError));
  5973. AssertEquals('Correct SQL Code',1,G.GDSErrorNumber);
  5974. end;
  5975. procedure TTestProcedureStatement.TestWhenAnyBlock;
  5976. Var
  5977. W : TSQLWhenStatement;
  5978. B : TSQLStatementBlock;
  5979. begin
  5980. W:=TSQLWhenStatement(CheckClass(TestStatement('WHEN ANY DO BEGIN EXIT; END'),TSQLWhenStatement));
  5981. AssertEquals('No error codes',0,W.Errors.Count);
  5982. AssertEquals('Any error',True,W.AnyError);
  5983. B:=TSQLStatementBlock(CheckClass(W.Statement,TSQLStatementBlock));
  5984. AssertEquals('One statement',1,B.Statements.Count);
  5985. CheckClass(B.Statements[0],TSQLExitStatement);
  5986. end;
  5987. procedure TTestProcedureStatement.TestWhenErrorAny;
  5988. begin
  5989. TestStatementError('WHEN ANY, EXCEPTION MY DO EXIT');
  5990. end;
  5991. procedure TTestProcedureStatement.TestWhenErrorNoDo;
  5992. begin
  5993. TestStatementError('WHEN ANY EXIT');
  5994. end;
  5995. procedure TTestProcedureStatement.TestWhenErrorExceptionInt;
  5996. begin
  5997. TestStatementError('WHEN EXCEPTION 1 DO EXIT');
  5998. end;
  5999. procedure TTestProcedureStatement.TestWhenErrorExceptionString;
  6000. begin
  6001. TestStatementError('WHEN EXCEPTION ''1'' DO EXIT');
  6002. end;
  6003. procedure TTestProcedureStatement.TestWhenErrorSqlCode;
  6004. begin
  6005. TestStatementError('WHEN SQLCODE A DO EXIT');
  6006. end;
  6007. procedure TTestProcedureStatement.TestWhenErrorGDSCode;
  6008. begin
  6009. TestStatementError('WHEN GDSCODE A DO EXIT');
  6010. end;
  6011. procedure TTestProcedureStatement.TestExecuteStatement;
  6012. Var
  6013. E : TSQLExecuteProcedureStatement;
  6014. begin
  6015. E:=TSQLExecuteProcedureStatement(CheckClass(TestStatement('EXECUTE PROCEDURE A'),TSQLExecuteProcedureStatement));
  6016. AssertIDentifierName('Correct procedure','A',E.ProcedureName);
  6017. end;
  6018. procedure TTestProcedureStatement.TestExecuteStatementReturningValues;
  6019. Var
  6020. E : TSQLExecuteProcedureStatement;
  6021. begin
  6022. E:=TSQLExecuteProcedureStatement(CheckClass(TestStatement('EXECUTE PROCEDURE A RETURNING_VALUES B'),TSQLExecuteProcedureStatement));
  6023. AssertIDentifierName('Correct procedure','A',E.ProcedureName);
  6024. AssertEquals('Returning 1 value',1,E.Returning.Count);
  6025. AssertIDentifierName('Correct return value','B',E.Returning[0]);
  6026. end;
  6027. procedure TTestProcedureStatement.TestExecuteStatementReturningValuesColon;
  6028. Var
  6029. E : TSQLExecuteProcedureStatement;
  6030. begin
  6031. E:=TSQLExecuteProcedureStatement(CheckClass(TestStatement('EXECUTE PROCEDURE A RETURNING_VALUES :B'),TSQLExecuteProcedureStatement));
  6032. AssertIDentifierName('Correct procedure','A',E.ProcedureName);
  6033. AssertEquals('Returning 1 value',1,E.Returning.Count);
  6034. AssertIDentifierName('Correct return value','B',E.Returning[0]);
  6035. end;
  6036. procedure TTestProcedureStatement.TestExecuteStatementReturningValuesBrackets;
  6037. Var
  6038. E : TSQLExecuteProcedureStatement;
  6039. begin
  6040. E:=TSQLExecuteProcedureStatement(CheckClass(TestStatement('EXECUTE PROCEDURE A RETURNING_VALUES (:B)'),TSQLExecuteProcedureStatement));
  6041. AssertIDentifierName('Correct procedure','A',E.ProcedureName);
  6042. AssertEquals('Returning 1 value',1,E.Returning.Count);
  6043. AssertIDentifierName('Correct return value','B',E.Returning[0]);
  6044. end;
  6045. procedure TTestProcedureStatement.TestForSimple;
  6046. Var
  6047. F : TSQLForStatement;
  6048. P : TSQLPostEventStatement;
  6049. begin
  6050. F:=TSQLForStatement(CheckClass(TestStatement('FOR SELECT A FROM B INTO :C DO POST_EVENT C'),TSQLForStatement));
  6051. AssertEquals('Field count',1,F.Select.Fields.Count);
  6052. AssertEquals('Table count',1,F.Select.Tables.Count);
  6053. AssertField(F.Select.Fields[0],'A','');
  6054. AssertTable(F.Select.Tables[0],'B','');
  6055. AssertEquals('Into Fieldlist count',1,F.FieldList.Count);
  6056. AssertIdentifierName('Correct field name','C',F.FieldList[0]);
  6057. P:=TSQLPostEventStatement(CheckClass(F.Statement,TSQLPostEventStatement));
  6058. AssertIdentifierName('Event name','C',P.ColName);
  6059. end;
  6060. procedure TTestProcedureStatement.TestForSimpleNoColon;
  6061. Var
  6062. F : TSQLForStatement;
  6063. P : TSQLPostEventStatement;
  6064. begin
  6065. F:=TSQLForStatement(CheckClass(TestStatement('FOR SELECT A FROM B INTO C DO POST_EVENT C'),TSQLForStatement));
  6066. AssertEquals('Field count',1,F.Select.Fields.Count);
  6067. AssertEquals('Table count',1,F.Select.Tables.Count);
  6068. AssertField(F.Select.Fields[0],'A','');
  6069. AssertTable(F.Select.Tables[0],'B','');
  6070. AssertEquals('Into Fieldlist count',1,F.FieldList.Count);
  6071. AssertIdentifierName('Correct field name','C',F.FieldList[0]);
  6072. P:=TSQLPostEventStatement(CheckClass(F.Statement,TSQLPostEventStatement));
  6073. AssertIdentifierName('Event name','C',P.ColName);
  6074. end;
  6075. procedure TTestProcedureStatement.TestForSimple2fields;
  6076. Var
  6077. F : TSQLForStatement;
  6078. P : TSQLPostEventStatement;
  6079. begin
  6080. F:=TSQLForStatement(CheckClass(TestStatement('FOR SELECT A,B FROM C INTO :D,:E DO POST_EVENT D'),TSQLForStatement));
  6081. AssertEquals('Field count',2,F.Select.Fields.Count);
  6082. AssertEquals('Table count',1,F.Select.Tables.Count);
  6083. AssertField(F.Select.Fields[0],'A','');
  6084. AssertField(F.Select.Fields[1],'B','');
  6085. AssertTable(F.Select.Tables[0],'C','');
  6086. AssertEquals('Into Fieldlist count',2,F.FieldList.Count);
  6087. AssertIdentifierName('Correct field name','D',F.FieldList[0]);
  6088. AssertIdentifierName('Correct field name','E',F.FieldList[1]);
  6089. P:=TSQLPostEventStatement(CheckClass(F.Statement,TSQLPostEventStatement));
  6090. AssertIdentifierName('Event name','D',P.ColName);
  6091. end;
  6092. procedure TTestProcedureStatement.TestForBlock;
  6093. Var
  6094. F : TSQLForStatement;
  6095. P : TSQLPostEventStatement;
  6096. B : TSQLStatementBlock;
  6097. begin
  6098. F:=TSQLForStatement(CheckClass(TestStatement('FOR SELECT A FROM B INTO :C DO BEGIN POST_EVENT C; END'),TSQLForStatement));
  6099. AssertEquals('Field count',1,F.Select.Fields.Count);
  6100. AssertEquals('Table count',1,F.Select.Tables.Count);
  6101. AssertField(F.Select.Fields[0],'A','');
  6102. AssertTable(F.Select.Tables[0],'B','');
  6103. AssertEquals('Into Fieldlist count',1,F.FieldList.Count);
  6104. AssertIdentifierName('Correct field name','C',F.FieldList[0]);
  6105. B:=TSQLStatementBlock(CheckClass(F.Statement,TSQLStatementBlock));
  6106. AssertEquals('One statement',1,B.Statements.Count);
  6107. P:=TSQLPostEventStatement(CheckClass(B.Statements[0],TSQLPostEventStatement));
  6108. AssertIdentifierName('Event name','C',P.ColName);
  6109. end;
  6110. { TTestCreateProcedureParser }
  6111. function TTestCreateProcedureParser.TestCreate(const ASource: String
  6112. ): TSQLCreateProcedureStatement;
  6113. begin
  6114. CreateParser(ASource);
  6115. FToFree:=Parser.Parse;
  6116. Result:=TSQLCreateProcedureStatement(CheckClass(FToFree,TSQLCreateProcedureStatement));
  6117. FSTatement:=Result;
  6118. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  6119. end;
  6120. procedure TTestCreateProcedureParser.TestCreateError(const ASource: String
  6121. );
  6122. begin
  6123. FErrSource:=ASource;
  6124. AssertException(ESQLParser,@TestParseError);
  6125. end;
  6126. procedure TTestCreateProcedureParser.TestEmptyProcedure;
  6127. begin
  6128. TestCreate('CREATE PROCEDURE A AS BEGIN END');
  6129. AssertIdentifierName('Correct procedure name','A',Statement.ObjectName);
  6130. AssertEquals('No arguments',0,Statement.InputVariables.Count);
  6131. AssertEquals('No return values',0,Statement.OutputVariables.Count);
  6132. AssertEquals('No local variables',0,Statement.LocalVariables.Count);
  6133. AssertEquals('No statements',0,Statement.Statements.Count);
  6134. end;
  6135. procedure TTestCreateProcedureParser.TestExitProcedure;
  6136. begin
  6137. TestCreate('CREATE PROCEDURE A AS BEGIN EXIT; END');
  6138. AssertIdentifierName('Correct procedure name','A',Statement.ObjectName);
  6139. AssertEquals('No arguments',0,Statement.InputVariables.Count);
  6140. AssertEquals('No return values',0,Statement.OutputVariables.Count);
  6141. AssertEquals('No local variables',0,Statement.LocalVariables.Count);
  6142. AssertEquals('One statement',1,Statement.Statements.Count);
  6143. CheckClass(Statement.Statements[0],TSQLExitStatement);
  6144. end;
  6145. procedure TTestCreateProcedureParser.TestProcedureOneArgument;
  6146. Var
  6147. P : TSQLProcedureParamDef;
  6148. begin
  6149. TestCreate('CREATE PROCEDURE A (P INT) AS BEGIN END');
  6150. AssertIdentifierName('Correct procedure name','A',Statement.ObjectName);
  6151. AssertEquals('1 arguments',1,Statement.InputVariables.Count);
  6152. P:=TSQLProcedureParamDef(CheckClass(Statement.InputVariables[0],TSQLProcedureParamDef));
  6153. AssertIdentifierName('Correct parameter name','P',P.ParamName);
  6154. AssertNotNull('Have type definition',P.ParamType);
  6155. AssertEquals('Correct type',sdtInteger,P.ParamType.DataType);
  6156. AssertEquals('No return values',0,Statement.OutputVariables.Count);
  6157. AssertEquals('No local variables',0,Statement.LocalVariables.Count);
  6158. AssertEquals('No statements',0,Statement.Statements.Count);
  6159. end;
  6160. procedure TTestCreateProcedureParser.TestProcedureTwoArguments;
  6161. Var
  6162. P : TSQLProcedureParamDef;
  6163. begin
  6164. TestCreate('CREATE PROCEDURE A (P INT,Q CHAR(4)) AS BEGIN END');
  6165. AssertIdentifierName('Correct procedure name','A',Statement.ObjectName);
  6166. AssertEquals('Two arguments',2,Statement.InputVariables.Count);
  6167. P:=TSQLProcedureParamDef(CheckClass(Statement.InputVariables[0],TSQLProcedureParamDef));
  6168. AssertIdentifierName('Correct parameter name','P',P.ParamName);
  6169. AssertNotNull('Have type definition',P.ParamType);
  6170. AssertEquals('Correct type',sdtInteger,P.ParamType.DataType);
  6171. AssertEquals('No return values',0,Statement.OutputVariables.Count);
  6172. P:=TSQLProcedureParamDef(CheckClass(Statement.InputVariables[1],TSQLProcedureParamDef));
  6173. AssertIdentifierName('Correct parameter name','Q',P.ParamName);
  6174. AssertNotNull('Have type definition',P.ParamType);
  6175. AssertEquals('Correct type',sdtChar,P.ParamType.DataType);
  6176. AssertEquals('Correct length',4,P.ParamType.Len);
  6177. //
  6178. AssertEquals('No local variables',0,Statement.LocalVariables.Count);
  6179. AssertEquals('No statements',0,Statement.Statements.Count);
  6180. end;
  6181. procedure TTestCreateProcedureParser.TestProcedureOneReturnValue;
  6182. Var
  6183. P : TSQLProcedureParamDef;
  6184. begin
  6185. TestCreate('CREATE PROCEDURE A RETURNS (P INT) AS BEGIN END');
  6186. AssertIdentifierName('Correct procedure name','A',Statement.ObjectName);
  6187. AssertEquals('1 return value',1,Statement.OutputVariables.Count);
  6188. P:=TSQLProcedureParamDef(CheckClass(Statement.OutputVariables[0],TSQLProcedureParamDef));
  6189. AssertIdentifierName('Correct parameter name','P',P.ParamName);
  6190. AssertNotNull('Have type definition',P.ParamType);
  6191. AssertEquals('Correct type',sdtInteger,P.ParamType.DataType);
  6192. AssertEquals('No input values',0,Statement.InputVariables.Count);
  6193. AssertEquals('No local variables',0,Statement.LocalVariables.Count);
  6194. AssertEquals('No statements',0,Statement.Statements.Count);
  6195. end;
  6196. procedure TTestCreateProcedureParser.TestProcedureTwoReturnValues;
  6197. Var
  6198. P : TSQLProcedureParamDef;
  6199. begin
  6200. TestCreate('CREATE PROCEDURE A RETURNS (P INT, Q CHAR(5)) AS BEGIN END');
  6201. AssertIdentifierName('Correct procedure name','A',Statement.ObjectName);
  6202. AssertEquals('2 return values',2,Statement.OutputVariables.Count);
  6203. P:=TSQLProcedureParamDef(CheckClass(Statement.OutputVariables[0],TSQLProcedureParamDef));
  6204. AssertIdentifierName('Correct parameter name','P',P.ParamName);
  6205. AssertNotNull('Have type definition',P.ParamType);
  6206. AssertEquals('Correct type',sdtInteger,P.ParamType.DataType);
  6207. P:=TSQLProcedureParamDef(CheckClass(Statement.OutputVariables[1],TSQLProcedureParamDef));
  6208. AssertIdentifierName('Correct parameter name','Q',P.ParamName);
  6209. AssertNotNull('Have type definition',P.ParamType);
  6210. AssertEquals('Correct type',sdtChar,P.ParamType.DataType);
  6211. AssertEquals('Correct length',5,P.ParamType.Len);
  6212. AssertEquals('No input values',0,Statement.InputVariables.Count);
  6213. AssertEquals('No local variables',0,Statement.LocalVariables.Count);
  6214. AssertEquals('No statements',0,Statement.Statements.Count);
  6215. end;
  6216. procedure TTestCreateProcedureParser.TestProcedureOneLocalVariable;
  6217. Var
  6218. P : TSQLProcedureParamDef;
  6219. begin
  6220. TestCreate('CREATE PROCEDURE A AS DECLARE VARIABLE P INT; BEGIN END');
  6221. AssertIdentifierName('Correcte procedure naam','A',Statement.ObjectName);
  6222. AssertEquals('0 return values',0,Statement.OutputVariables.Count);
  6223. AssertEquals('1 local variable',1,Statement.LocalVariables.Count);
  6224. P:=TSQLProcedureParamDef(CheckClass(Statement.LocalVariables[0],TSQLProcedureParamDef));
  6225. AssertIdentifierName('Correct parameter name','P',P.ParamName);
  6226. AssertNotNull('Have type definition',P.ParamType);
  6227. AssertEquals('Correct type',sdtInteger,P.ParamType.DataType);
  6228. AssertEquals('No input values',0,Statement.InputVariables.Count);
  6229. AssertEquals('No statements',0,Statement.Statements.Count);
  6230. end;
  6231. procedure TTestCreateProcedureParser.TestProcedureTwoLocalVariable;
  6232. Var
  6233. P : TSQLProcedureParamDef;
  6234. begin
  6235. TestCreate('CREATE PROCEDURE A AS DECLARE VARIABLE P INT; DECLARE VARIABLE Q CHAR(5); BEGIN END');
  6236. AssertIdentifierName('Correcte procedure naam','A',Statement.ObjectName);
  6237. AssertEquals('0 return values',0,Statement.OutputVariables.Count);
  6238. AssertEquals('2 local variable',2,Statement.LocalVariables.Count);
  6239. P:=TSQLProcedureParamDef(CheckClass(Statement.LocalVariables[0],TSQLProcedureParamDef));
  6240. AssertIdentifierName('Correct parameter name','P',P.ParamName);
  6241. AssertNotNull('Have type definition',P.ParamType);
  6242. AssertEquals('Correct type',sdtInteger,P.ParamType.DataType);
  6243. P:=TSQLProcedureParamDef(CheckClass(Statement.LocalVariables[1],TSQLProcedureParamDef));
  6244. AssertIdentifierName('Correct parameter name','Q',P.ParamName);
  6245. AssertNotNull('Have type definition',P.ParamType);
  6246. AssertEquals('Correct type',sdtChar,P.ParamType.DataType);
  6247. AssertEquals('Correct length',5,P.ParamType.Len);
  6248. AssertEquals('No input values',0,Statement.InputVariables.Count);
  6249. AssertEquals('No statements',0,Statement.Statements.Count);
  6250. end;
  6251. procedure TTestCreateProcedureParser.TestProcedureInputOutputLocal;
  6252. Var
  6253. P : TSQLProcedureParamDef;
  6254. begin
  6255. TestCreate('CREATE PROCEDURE A (P INT) RETURNS (Q CHAR(5)) AS DECLARE VARIABLE R VARCHAR(5); BEGIN END');
  6256. AssertIdentifierName('Correcte procedure naam','A',Statement.ObjectName);
  6257. // Input
  6258. AssertEquals('1 input value',1,Statement.InputVariables.Count);
  6259. P:=TSQLProcedureParamDef(CheckClass(Statement.InputVariables[0],TSQLProcedureParamDef));
  6260. AssertIdentifierName('Correct parameter name','P',P.ParamName);
  6261. AssertNotNull('Have type definition',P.ParamType);
  6262. AssertEquals('Correct type',sdtInteger,P.ParamType.DataType);
  6263. // Output
  6264. AssertEquals('1 return values',1,Statement.OutputVariables.Count);
  6265. P:=TSQLProcedureParamDef(CheckClass(Statement.OutputVariables[0],TSQLProcedureParamDef));
  6266. AssertIdentifierName('Correct parameter name','Q',P.ParamName);
  6267. AssertNotNull('Have type definition',P.ParamType);
  6268. AssertEquals('Correct type',sdtChar,P.ParamType.DataType);
  6269. AssertEquals('Correct length',5,P.ParamType.Len);
  6270. // Local
  6271. AssertEquals('1 local variable',1,Statement.LocalVariables.Count);
  6272. P:=TSQLProcedureParamDef(CheckClass(Statement.LocalVariables[0],TSQLProcedureParamDef));
  6273. AssertIdentifierName('Correct parameter name','R',P.ParamName);
  6274. AssertNotNull('Have type definition',P.ParamType);
  6275. AssertEquals('Correct type',sdtvarChar,P.ParamType.DataType);
  6276. AssertEquals('Correct length',5,P.ParamType.Len);
  6277. AssertEquals('No statements',0,Statement.Statements.Count);
  6278. end;
  6279. { TTestCreateTriggerParser }
  6280. function TTestCreateTriggerParser.TestCreate(const ASource: String
  6281. ): TSQLCreateTriggerStatement;
  6282. begin
  6283. CreateParser(ASource);
  6284. FToFree:=Parser.Parse;
  6285. Result:=TSQLCreateTriggerStatement(CheckClass(FToFree,TSQLCreateTriggerStatement));
  6286. FSTatement:=Result;
  6287. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  6288. end;
  6289. function TTestCreateTriggerParser.TestAlter(const ASource: String
  6290. ): TSQLAlterTriggerStatement;
  6291. begin
  6292. CreateParser(ASource);
  6293. FToFree:=Parser.Parse;
  6294. Result:=TSQLAlterTriggerStatement(CheckClass(FToFree,TSQLAlterTriggerStatement));
  6295. FSTatement:=Result;
  6296. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  6297. end;
  6298. procedure TTestCreateTriggerParser.TestCreateError(const ASource: String);
  6299. begin
  6300. FErrSource:=ASource;
  6301. AssertException(ESQLParser,@TestParseError);
  6302. end;
  6303. procedure TTestCreateTriggerParser.TestEmptyTrigger;
  6304. begin
  6305. TestCreate('CREATE TRIGGER A FOR B BEFORE UPDATE AS BEGIN END');
  6306. AssertIdentifierName('Correct trigger name','A',Statement.ObjectName);
  6307. AssertIdentifierName('Correct table','B',Statement.TableName);
  6308. AssertEquals('No variables',0,Statement.LocalVariables.Count);
  6309. AssertEquals('No Statements',0,Statement.Statements.Count);
  6310. AssertEquals('No position',0,Statement.Position);
  6311. AssertEquals('No active/inactive',tsNone,Statement.State);
  6312. AssertEquals('Before moment',tmBefore,Statement.Moment);
  6313. AssertEquals('Update operation',[toUpdate],Statement.Operations);
  6314. end;
  6315. procedure TTestCreateTriggerParser.TestExitTrigger;
  6316. begin
  6317. TestCreate('CREATE TRIGGER A FOR B BEFORE UPDATE AS BEGIN EXIT; END');
  6318. AssertIdentifierName('Correct trigger name','A',Statement.ObjectName);
  6319. AssertIdentifierName('Correct table','B',Statement.TableName);
  6320. AssertEquals('No variables',0,Statement.LocalVariables.Count);
  6321. AssertEquals('1 Statements',1,Statement.Statements.Count);
  6322. AssertEquals('No position',0,Statement.Position);
  6323. AssertEquals('No active/inactive',tsNone,Statement.State);
  6324. AssertEquals('Before moment',tmBefore,Statement.Moment);
  6325. AssertEquals('Update operation',[toUpdate],Statement.Operations);
  6326. CheckClass(Statement.Statements[0],TSQLExitStatement);
  6327. end;
  6328. procedure TTestCreateTriggerParser.TestEmptyTriggerAfterUpdate;
  6329. begin
  6330. TestCreate('CREATE TRIGGER A FOR B AFTER UPDATE AS BEGIN END');
  6331. AssertIdentifierName('Correct trigger name','A',Statement.ObjectName);
  6332. AssertIdentifierName('Correct table','B',Statement.TableName);
  6333. AssertEquals('No variables',0,Statement.LocalVariables.Count);
  6334. AssertEquals('No Statements',0,Statement.Statements.Count);
  6335. AssertEquals('No position',0,Statement.Position);
  6336. AssertEquals('No active/inactive',tsNone,Statement.State);
  6337. AssertEquals('Before moment',tmAfter,Statement.Moment);
  6338. AssertEquals('Update operation',[toUpdate],Statement.Operations);
  6339. end;
  6340. procedure TTestCreateTriggerParser.TestEmptyTriggerBeforeDelete;
  6341. begin
  6342. TestCreate('CREATE TRIGGER A FOR B BEFORE DELETE AS BEGIN END');
  6343. AssertIdentifierName('Correct trigger name','A',Statement.ObjectName);
  6344. AssertIdentifierName('Correct table','B',Statement.TableName);
  6345. AssertEquals('No variables',0,Statement.LocalVariables.Count);
  6346. AssertEquals('No Statements',0,Statement.Statements.Count);
  6347. AssertEquals('No position',0,Statement.Position);
  6348. AssertEquals('No active/inactive',tsNone,Statement.State);
  6349. AssertEquals('Before moment',tmBefore,Statement.Moment);
  6350. AssertEquals('Delete operation',[toDelete],Statement.Operations);
  6351. end;
  6352. procedure TTestCreateTriggerParser.TestEmptyTriggerBeforeInsert;
  6353. begin
  6354. TestCreate('CREATE TRIGGER A FOR B BEFORE INSERT AS BEGIN END');
  6355. AssertIdentifierName('Correct trigger name','A',Statement.ObjectName);
  6356. AssertIdentifierName('Correct table','B',Statement.TableName);
  6357. AssertEquals('No variables',0,Statement.LocalVariables.Count);
  6358. AssertEquals('No Statements',0,Statement.Statements.Count);
  6359. AssertEquals('No position',0,Statement.Position);
  6360. AssertEquals('No active/inactive',tsNone,Statement.State);
  6361. AssertEquals('Before moment',tmBefore,Statement.Moment);
  6362. AssertEquals('Insert operation',[toInsert],Statement.Operations);
  6363. end;
  6364. procedure TTestCreateTriggerParser.TestEmptyTriggerBeforeInsertPosition1;
  6365. begin
  6366. TestCreate('CREATE TRIGGER A FOR B BEFORE INSERT POSITION 1 AS BEGIN END');
  6367. AssertIdentifierName('Correct trigger name','A',Statement.ObjectName);
  6368. AssertIdentifierName('Correct table','B',Statement.TableName);
  6369. AssertEquals('No variables',0,Statement.LocalVariables.Count);
  6370. AssertEquals('No Statements',0,Statement.Statements.Count);
  6371. AssertEquals('position 1',1,Statement.Position);
  6372. AssertEquals('No active/inactive',tsNone,Statement.State);
  6373. AssertEquals('Before moment',tmBefore,Statement.Moment);
  6374. AssertEquals('Insert operation',[toInsert],Statement.Operations);
  6375. end;
  6376. procedure TTestCreateTriggerParser.TestEmptyTriggerBeforeInsertPosition1inActive;
  6377. begin
  6378. TestCreate('CREATE TRIGGER A FOR B INACTIVE BEFORE INSERT POSITION 1 AS BEGIN END');
  6379. AssertIdentifierName('Correct trigger name','A',Statement.ObjectName);
  6380. AssertIdentifierName('Correct table','B',Statement.TableName);
  6381. AssertEquals('No variables',0,Statement.LocalVariables.Count);
  6382. AssertEquals('No Statements',0,Statement.Statements.Count);
  6383. AssertEquals('position 1',1,Statement.Position);
  6384. AssertEquals('inactive',tsInactive,Statement.State);
  6385. AssertEquals('Before moment',tmBefore,Statement.Moment);
  6386. AssertEquals('Insert operation',[toInsert],Statement.Operations);
  6387. end;
  6388. procedure TTestCreateTriggerParser.TestEmptyTriggerBeforeInsertPosition1Active;
  6389. begin
  6390. TestCreate('CREATE TRIGGER A FOR B ACTIVE BEFORE INSERT POSITION 1 AS BEGIN END');
  6391. AssertIdentifierName('Correct trigger name','A',Statement.ObjectName);
  6392. AssertIdentifierName('Correct table','B',Statement.TableName);
  6393. AssertEquals('No variables',0,Statement.LocalVariables.Count);
  6394. AssertEquals('No Statements',0,Statement.Statements.Count);
  6395. AssertEquals('position 1',1,Statement.Position);
  6396. AssertEquals('Active',tsActive,Statement.State);
  6397. AssertEquals('Before moment',tmBefore,Statement.Moment);
  6398. AssertEquals('Insert operation',[toInsert],Statement.Operations);
  6399. end;
  6400. procedure TTestCreateTriggerParser.TestTriggerOneLocalVariable;
  6401. Var
  6402. P : TSQLProcedureParamDef;
  6403. begin
  6404. TestCreate('CREATE TRIGGER A FOR B ACTIVE BEFORE INSERT POSITION 1 AS DECLARE VARIABLE P INT; BEGIN END');
  6405. AssertIdentifierName('Correcte procedure naam','A',Statement.ObjectName);
  6406. AssertIdentifierName('Correct table','B',Statement.TableName);
  6407. AssertEquals('No Statements',0,Statement.Statements.Count);
  6408. AssertEquals('position 1',1,Statement.Position);
  6409. AssertEquals('Active',tsActive,Statement.State);
  6410. AssertEquals('Before moment',tmBefore,Statement.Moment);
  6411. AssertEquals('Insert operation',[toInsert],Statement.Operations);
  6412. AssertEquals('1 local variable',1,Statement.LocalVariables.Count);
  6413. P:=TSQLProcedureParamDef(CheckClass(Statement.LocalVariables[0],TSQLProcedureParamDef));
  6414. AssertIdentifierName('Correct parameter name','P',P.ParamName);
  6415. AssertNotNull('Have type definition',P.ParamType);
  6416. AssertEquals('Correct type',sdtInteger,P.ParamType.DataType);
  6417. end;
  6418. procedure TTestCreateTriggerParser.TestTriggerTwoLocalVariables;
  6419. Var
  6420. P : TSQLProcedureParamDef;
  6421. begin
  6422. TestCreate('CREATE TRIGGER A FOR B ACTIVE BEFORE INSERT POSITION 1 AS DECLARE VARIABLE P INT; DECLARE VARIABLE Q INT; BEGIN END');
  6423. AssertIdentifierName('Correcte procedure naam','A',Statement.ObjectName);
  6424. AssertIdentifierName('Correct table','B',Statement.TableName);
  6425. AssertEquals('No Statements',0,Statement.Statements.Count);
  6426. AssertEquals('position 1',1,Statement.Position);
  6427. AssertEquals('Active',tsActive,Statement.State);
  6428. AssertEquals('Before moment',tmBefore,Statement.Moment);
  6429. AssertEquals('Insert operation',[toInsert],Statement.Operations);
  6430. AssertEquals('2 local variables',2,Statement.LocalVariables.Count);
  6431. P:=TSQLProcedureParamDef(CheckClass(Statement.LocalVariables[0],TSQLProcedureParamDef));
  6432. AssertIdentifierName('Correct parameter name','P',P.ParamName);
  6433. AssertNotNull('Have type definition',P.ParamType);
  6434. AssertEquals('Correct type',sdtInteger,P.ParamType.DataType);
  6435. P:=TSQLProcedureParamDef(CheckClass(Statement.LocalVariables[1],TSQLProcedureParamDef));
  6436. AssertIdentifierName('Correct parameter name','Q',P.ParamName);
  6437. AssertNotNull('Have type definition',P.ParamType);
  6438. AssertEquals('Correct type',sdtInteger,P.ParamType.DataType);
  6439. end;
  6440. procedure TTestCreateTriggerParser.TestAlterTrigger;
  6441. begin
  6442. TestAlter('ALTER TRIGGER A BEFORE UPDATE AS BEGIN END');
  6443. AssertIdentifierName('Correct trigger name','A',Statement.ObjectName);
  6444. AssertNull('Correct table',Statement.TableName);
  6445. AssertEquals('No variables',0,Statement.LocalVariables.Count);
  6446. AssertEquals('No Statements',0,Statement.Statements.Count);
  6447. AssertEquals('No position',0,Statement.Position);
  6448. AssertEquals('No active/inactive',tsNone,Statement.State);
  6449. AssertEquals('Before moment',tmBefore,Statement.Moment);
  6450. AssertEquals('Update operation',[toUpdate],Statement.Operations);
  6451. end;
  6452. { TTestDeclareExternalFunctionParser }
  6453. function TTestDeclareExternalFunctionParser.TestCreate(const ASource: String
  6454. ): TSQLDeclareExternalFunctionStatement;
  6455. begin
  6456. CreateParser(ASource);
  6457. FToFree:=Parser.Parse;
  6458. Result:=TSQLDeclareExternalFunctionStatement(CheckClass(FToFree,TSQLDeclareExternalFunctionStatement));
  6459. FSTatement:=Result;
  6460. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  6461. end;
  6462. procedure TTestDeclareExternalFunctionParser.TestCreateError(
  6463. const ASource: String);
  6464. begin
  6465. FErrSource:=ASource;
  6466. AssertException(ESQLParser,@TestParseError);
  6467. end;
  6468. procedure TTestDeclareExternalFunctionParser.TestEmptyfunction;
  6469. begin
  6470. TestCreate('DECLARE EXTERNAL FUNCTION A RETURNS INT ENTRY_POINT ''A'' MODULE_NAME ''B''');
  6471. AssertIdentifierName('Correct function','A',Statement.ObjectName);
  6472. AssertEquals('Correct entry point','A',Statement.EntryPoint);
  6473. AssertEquals('Correct module name','B',Statement.ModuleName);
  6474. AssertEquals('No arguments',0,Statement.Arguments.Count);
  6475. AssertNotNull('Have return type',Statement.ReturnType);
  6476. AssertEquals('No FreeIt',False,Statement.FreeIt);
  6477. AssertEquals('Correct return type',sdtInteger,Statement.ReturnType.DataType);
  6478. end;
  6479. procedure TTestDeclareExternalFunctionParser.TestEmptyfunctionByValue;
  6480. begin
  6481. TestCreate('DECLARE EXTERNAL FUNCTION A RETURNS INT BY VALUE ENTRY_POINT ''A'' MODULE_NAME ''B''');
  6482. AssertIdentifierName('Correct function','A',Statement.ObjectName);
  6483. AssertEquals('Correct entry point','A',Statement.EntryPoint);
  6484. AssertEquals('Correct module name','B',Statement.ModuleName);
  6485. AssertEquals('No arguments',0,Statement.Arguments.Count);
  6486. AssertNotNull('Have return type',Statement.ReturnType);
  6487. AssertEquals('No FreeIt',False,Statement.FreeIt);
  6488. AssertEquals('Correct return type',sdtInteger,Statement.ReturnType.DataType);
  6489. AssertEquals('By Value',True,Statement.ReturnType.ByValue);
  6490. end;
  6491. procedure TTestDeclareExternalFunctionParser.TestCStringfunction;
  6492. begin
  6493. TestCreate('DECLARE EXTERNAL FUNCTION A RETURNS CSTRING (50) ENTRY_POINT ''A'' MODULE_NAME ''B''');
  6494. AssertIdentifierName('Correct function','A',Statement.ObjectName);
  6495. AssertEquals('Correct entry point','A',Statement.EntryPoint);
  6496. AssertEquals('Correct module name','B',Statement.ModuleName);
  6497. AssertEquals('No arguments',0,Statement.Arguments.Count);
  6498. AssertNotNull('Have return type',Statement.ReturnType);
  6499. AssertEquals('No FreeIt',False,Statement.FreeIt);
  6500. AssertEquals('Correct return type',sdtCstring,Statement.ReturnType.DataType);
  6501. AssertEquals('Correct return length',50,Statement.ReturnType.Len);
  6502. end;
  6503. procedure TTestDeclareExternalFunctionParser.TestCStringFreeItfunction;
  6504. begin
  6505. TestCreate('DECLARE EXTERNAL FUNCTION A RETURNS CSTRING (50) FREE_IT ENTRY_POINT ''A'' MODULE_NAME ''B''');
  6506. AssertIdentifierName('Correct function','A',Statement.ObjectName);
  6507. AssertEquals('Correct entry point','A',Statement.EntryPoint);
  6508. AssertEquals('Correct module name','B',Statement.ModuleName);
  6509. AssertEquals('No arguments',0,Statement.Arguments.Count);
  6510. AssertNotNull('Have return type',Statement.ReturnType);
  6511. AssertEquals('FreeIt',True,Statement.FreeIt);
  6512. AssertEquals('Correct return type',sdtCstring,Statement.ReturnType.DataType);
  6513. AssertEquals('Correct return length',50,Statement.ReturnType.Len);
  6514. end;
  6515. procedure TTestDeclareExternalFunctionParser.TestOneArgumentFunction;
  6516. Var
  6517. T : TSQLTypeDefinition;
  6518. begin
  6519. TestCreate('DECLARE EXTERNAL FUNCTION A INT RETURNS INT ENTRY_POINT ''A'' MODULE_NAME ''B''');
  6520. AssertIdentifierName('Correct function','A',Statement.ObjectName);
  6521. AssertEquals('Correct entry point','A',Statement.EntryPoint);
  6522. AssertEquals('Correct module name','B',Statement.ModuleName);
  6523. AssertEquals('1 argument',1,Statement.Arguments.Count);
  6524. T:=TSQLTypeDefinition(CheckClass(Statement.Arguments[0],TSQLTypeDefinition));
  6525. AssertEquals('Correct return type',sdtInteger,T.DataType);
  6526. AssertNotNull('Have return type',Statement.ReturnType);
  6527. AssertEquals('No FreeIt',False,Statement.FreeIt);
  6528. AssertEquals('Correct return type',sdtInteger,Statement.ReturnType.DataType);
  6529. end;
  6530. procedure TTestDeclareExternalFunctionParser.TestTwoArgumentsFunction;
  6531. Var
  6532. T : TSQLTypeDefinition;
  6533. begin
  6534. TestCreate('DECLARE EXTERNAL FUNCTION A INT, CSTRING(10) RETURNS INT ENTRY_POINT ''A'' MODULE_NAME ''B''');
  6535. AssertIdentifierName('Correct function','A',Statement.ObjectName);
  6536. AssertEquals('Correct entry point','A',Statement.EntryPoint);
  6537. AssertEquals('Correct module name','B',Statement.ModuleName);
  6538. AssertEquals('2 arguments',2,Statement.Arguments.Count);
  6539. T:=TSQLTypeDefinition(CheckClass(Statement.Arguments[0],TSQLTypeDefinition));
  6540. AssertEquals('Correct argument type',sdtInteger,T.DataType);
  6541. T:=TSQLTypeDefinition(CheckClass(Statement.Arguments[1],TSQLTypeDefinition));
  6542. AssertEquals('Correct return type',sdtCstring,T.DataType);
  6543. AssertEquals('Correct argument length',10,T.Len);
  6544. AssertNotNull('Have return type',Statement.ReturnType);
  6545. AssertEquals('No FreeIt',False,Statement.FreeIt);
  6546. AssertEquals('Correct return type',sdtInteger,Statement.ReturnType.DataType);
  6547. end;
  6548. { TTestGrantParser }
  6549. function TTestGrantParser.TestGrant(const ASource: String): TSQLGrantStatement;
  6550. begin
  6551. CreateParser(ASource);
  6552. FToFree:=Parser.Parse;
  6553. If not (FToFree is TSQLGrantStatement) then
  6554. Fail(Format('Wrong parse result class. Expected TSQLGrantStatement, got %s',[FTofree.ClassName]));
  6555. Result:=TSQLGrantStatement(Ftofree);
  6556. FSTatement:=Result;
  6557. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  6558. end;
  6559. procedure TTestGrantParser.TestGrantError(const ASource: String);
  6560. begin
  6561. FErrSource:=ASource;
  6562. AssertException(ESQLParser,@TestParseError);
  6563. end;
  6564. procedure TTestGrantParser.TestSimple;
  6565. Var
  6566. t : TSQLTableGrantStatement;
  6567. G : TSQLUSerGrantee;
  6568. begin
  6569. TestGrant('GRANT SELECT ON A TO B');
  6570. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6571. AssertIdentifierName('Table name','A',T.TableName);
  6572. AssertEquals('One grantee', 1,T.Grantees.Count);
  6573. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  6574. AssertEquals('Grantee B','B',G.Name);
  6575. AssertEquals('One permission',1,T.Privileges.Count);
  6576. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  6577. AssertEquals('No grant option',False,T.GrantOption);
  6578. end;
  6579. procedure TTestGrantParser.Test2Operations;
  6580. Var
  6581. t : TSQLTableGrantStatement;
  6582. G : TSQLUSerGrantee;
  6583. begin
  6584. TestGrant('GRANT SELECT,INSERT ON A TO B');
  6585. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6586. AssertIdentifierName('Table name','A',T.TableName);
  6587. AssertEquals('One grantee', 1,T.Grantees.Count);
  6588. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  6589. AssertEquals('Grantee B','B',G.Name);
  6590. AssertEquals('Two permissions',2,T.Privileges.Count);
  6591. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  6592. CheckClass(T.Privileges[1],TSQLINSERTPrivilege);
  6593. AssertEquals('No grant option',False,T.GrantOption);
  6594. end;
  6595. procedure TTestGrantParser.TestDeletePrivilege;
  6596. Var
  6597. t : TSQLTableGrantStatement;
  6598. G : TSQLUSerGrantee;
  6599. begin
  6600. TestGrant('GRANT DELETE ON A TO B');
  6601. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6602. AssertIdentifierName('Table name','A',T.TableName);
  6603. AssertEquals('One grantee', 1,T.Grantees.Count);
  6604. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  6605. AssertEquals('Grantee B','B',G.Name);
  6606. AssertEquals('One permission',1,T.Privileges.Count);
  6607. CheckClass(T.Privileges[0],TSQLDeletePrivilege);
  6608. AssertEquals('No grant option',False,T.GrantOption);
  6609. end;
  6610. procedure TTestGrantParser.TestUpdatePrivilege;
  6611. Var
  6612. t : TSQLTableGrantStatement;
  6613. G : TSQLUSerGrantee;
  6614. begin
  6615. TestGrant('GRANT UPDATE ON A TO B');
  6616. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6617. AssertIdentifierName('Table name','A',T.TableName);
  6618. AssertEquals('One grantee', 1,T.Grantees.Count);
  6619. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  6620. AssertEquals('Grantee B','B',G.Name);
  6621. AssertEquals('One permission',1,T.Privileges.Count);
  6622. CheckClass(T.Privileges[0],TSQLUPDATEPrivilege);
  6623. AssertEquals('No grant option',False,T.GrantOption);
  6624. end;
  6625. procedure TTestGrantParser.TestInsertPrivilege;
  6626. Var
  6627. t : TSQLTableGrantStatement;
  6628. G : TSQLUSerGrantee;
  6629. begin
  6630. TestGrant('GRANT INSERT ON A TO B');
  6631. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6632. AssertIdentifierName('Table name','A',T.TableName);
  6633. AssertEquals('One grantee', 1,T.Grantees.Count);
  6634. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  6635. AssertEquals('Grantee B','B',G.Name);
  6636. AssertEquals('One permission',1,T.Privileges.Count);
  6637. CheckClass(T.Privileges[0],TSQLInsertPrivilege);
  6638. AssertEquals('No grant option',False,T.GrantOption);
  6639. end;
  6640. procedure TTestGrantParser.TestReferencePrivilege;
  6641. Var
  6642. t : TSQLTableGrantStatement;
  6643. G : TSQLUSerGrantee;
  6644. begin
  6645. TestGrant('GRANT REFERENCES ON A TO B');
  6646. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6647. AssertIdentifierName('Table name','A',T.TableName);
  6648. AssertEquals('One grantee', 1,T.Grantees.Count);
  6649. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  6650. AssertEquals('Grantee B','B',G.Name);
  6651. AssertEquals('One permission',1,T.Privileges.Count);
  6652. CheckClass(T.Privileges[0],TSQLReferencePrivilege);
  6653. AssertEquals('No grant option',False,T.GrantOption);
  6654. end;
  6655. procedure TTestGrantParser.TestAllPrivileges;
  6656. Var
  6657. t : TSQLTableGrantStatement;
  6658. G : TSQLUSerGrantee;
  6659. begin
  6660. TestGrant('GRANT ALL ON A TO B');
  6661. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6662. AssertIdentifierName('Table name','A',T.TableName);
  6663. AssertEquals('One grantee', 1,T.Grantees.Count);
  6664. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  6665. AssertEquals('Grantee B','B',G.Name);
  6666. AssertEquals('One permission',1,T.Privileges.Count);
  6667. CheckClass(T.Privileges[0],TSQLAllPrivilege);
  6668. AssertEquals('No grant option',False,T.GrantOption);
  6669. end;
  6670. procedure TTestGrantParser.TestAllPrivileges2;
  6671. Var
  6672. t : TSQLTableGrantStatement;
  6673. G : TSQLUSerGrantee;
  6674. begin
  6675. TestGrant('GRANT ALL PRIVILEGES ON A TO B');
  6676. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6677. AssertIdentifierName('Table name','A',T.TableName);
  6678. AssertEquals('One grantee', 1,T.Grantees.Count);
  6679. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  6680. AssertEquals('Grantee B','B',G.Name);
  6681. AssertEquals('One permission',1,T.Privileges.Count);
  6682. CheckClass(T.Privileges[0],TSQLAllPrivilege);
  6683. AssertEquals('No grant option',False,T.GrantOption);
  6684. end;
  6685. procedure TTestGrantParser.TestUpdateColPrivilege;
  6686. Var
  6687. t : TSQLTableGrantStatement;
  6688. G : TSQLUSerGrantee;
  6689. U : TSQLUPDATEPrivilege;
  6690. begin
  6691. TestGrant('GRANT UPDATE (C) ON A TO B');
  6692. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6693. AssertIdentifierName('Table name','A',T.TableName);
  6694. AssertEquals('One grantee', 1,T.Grantees.Count);
  6695. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  6696. AssertEquals('Grantee B','B',G.Name);
  6697. AssertEquals('One permission',1,T.Privileges.Count);
  6698. U:=TSQLUPDATEPrivilege(CheckClass(T.Privileges[0],TSQLUPDATEPrivilege));
  6699. AssertEquals('1 column',1,U.Columns.Count);
  6700. AssertIdentifierName('Column C','C',U.Columns[0]);
  6701. AssertEquals('No grant option',False,T.GrantOption);
  6702. end;
  6703. procedure TTestGrantParser.TestUpdate2ColsPrivilege;
  6704. Var
  6705. t : TSQLTableGrantStatement;
  6706. G : TSQLUSerGrantee;
  6707. U : TSQLUPDATEPrivilege;
  6708. begin
  6709. TestGrant('GRANT UPDATE (C,D) ON A TO B');
  6710. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6711. AssertIdentifierName('Table name','A',T.TableName);
  6712. AssertEquals('One grantee', 1,T.Grantees.Count);
  6713. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  6714. AssertEquals('Grantee B','B',G.Name);
  6715. AssertEquals('One permission',1,T.Privileges.Count);
  6716. U:=TSQLUPDATEPrivilege(CheckClass(T.Privileges[0],TSQLUPDATEPrivilege));
  6717. AssertEquals('2 column',2,U.Columns.Count);
  6718. AssertIdentifierName('Column C','C',U.Columns[0]);
  6719. AssertIdentifierName('Column D','D',U.Columns[1]);
  6720. AssertEquals('No grant option',False,T.GrantOption);
  6721. end;
  6722. procedure TTestGrantParser.TestReferenceColPrivilege;
  6723. Var
  6724. t : TSQLTableGrantStatement;
  6725. G : TSQLUSerGrantee;
  6726. U : TSQLReferencePrivilege;
  6727. begin
  6728. TestGrant('GRANT REFERENCES (C) ON A TO B');
  6729. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6730. AssertIdentifierName('Table name','A',T.TableName);
  6731. AssertEquals('One grantee', 1,T.Grantees.Count);
  6732. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  6733. AssertEquals('Grantee B','B',G.Name);
  6734. AssertEquals('One permission',1,T.Privileges.Count);
  6735. U:=TSQLReferencePrivilege(CheckClass(T.Privileges[0],TSQLReferencePrivilege));
  6736. AssertEquals('1 column',1,U.Columns.Count);
  6737. AssertIdentifierName('Column C','C',U.Columns[0]);
  6738. AssertEquals('No grant option',False,T.GrantOption);
  6739. end;
  6740. procedure TTestGrantParser.TestReference2ColsPrivilege;
  6741. Var
  6742. t : TSQLTableGrantStatement;
  6743. G : TSQLUSerGrantee;
  6744. U : TSQLReferencePrivilege;
  6745. begin
  6746. TestGrant('GRANT REFERENCES (C,D) ON A TO B');
  6747. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6748. AssertIdentifierName('Table name','A',T.TableName);
  6749. AssertEquals('One grantee', 1,T.Grantees.Count);
  6750. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  6751. AssertEquals('Grantee B','B',G.Name);
  6752. AssertEquals('One permission',1,T.Privileges.Count);
  6753. U:=TSQLReferencePrivilege(CheckClass(T.Privileges[0],TSQLReferencePrivilege));
  6754. AssertEquals('2 column',2,U.Columns.Count);
  6755. AssertIdentifierName('Column C','C',U.Columns[0]);
  6756. AssertIdentifierName('Column D','D',U.Columns[1]);
  6757. AssertEquals('No grant option',False,T.GrantOption);
  6758. end;
  6759. procedure TTestGrantParser.TestUserPrivilege;
  6760. Var
  6761. t : TSQLTableGrantStatement;
  6762. G : TSQLUSerGrantee;
  6763. begin
  6764. TestGrant('GRANT SELECT ON A TO USER B');
  6765. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6766. AssertIdentifierName('Table name','A',T.TableName);
  6767. AssertEquals('One grantee', 1,T.Grantees.Count);
  6768. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  6769. AssertEquals('Grantee B','B',G.Name);
  6770. AssertEquals('One permission',1,T.Privileges.Count);
  6771. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  6772. AssertEquals('No grant option',False,T.GrantOption);
  6773. end;
  6774. procedure TTestGrantParser.TestUserPrivilegeWithGrant;
  6775. Var
  6776. t : TSQLTableGrantStatement;
  6777. G : TSQLUSerGrantee;
  6778. begin
  6779. TestGrant('GRANT SELECT ON A TO USER B WITH GRANT OPTION');
  6780. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6781. AssertIdentifierName('Table name','A',T.TableName);
  6782. AssertEquals('One grantee', 1,T.Grantees.Count);
  6783. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  6784. AssertEquals('Grantee B','B',G.Name);
  6785. AssertEquals('One permission',1,T.Privileges.Count);
  6786. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  6787. AssertEquals('With grant option',True,T.GrantOption);
  6788. end;
  6789. procedure TTestGrantParser.TestGroupPrivilege;
  6790. Var
  6791. t : TSQLTableGrantStatement;
  6792. G : TSQLGroupGrantee;
  6793. begin
  6794. TestGrant('GRANT SELECT ON A TO GROUP B');
  6795. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6796. AssertIdentifierName('Table name','A',T.TableName);
  6797. AssertEquals('One grantee', 1,T.Grantees.Count);
  6798. G:=TSQLGroupGrantee(CheckClass(T.Grantees[0],TSQLGroupGrantee));
  6799. AssertEquals('Grantee B','B',G.Name);
  6800. AssertEquals('One permission',1,T.Privileges.Count);
  6801. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  6802. AssertEquals('No grant option',False,T.GrantOption);
  6803. end;
  6804. procedure TTestGrantParser.TestProcedurePrivilege;
  6805. Var
  6806. t : TSQLTableGrantStatement;
  6807. G : TSQLProcedureGrantee;
  6808. begin
  6809. TestGrant('GRANT SELECT ON A TO PROCEDURE B');
  6810. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6811. AssertIdentifierName('Table name','A',T.TableName);
  6812. AssertEquals('One grantee', 1,T.Grantees.Count);
  6813. G:=TSQLProcedureGrantee(CheckClass(T.Grantees[0],TSQLProcedureGrantee));
  6814. AssertEquals('Grantee B','B',G.Name);
  6815. AssertEquals('One permission',1,T.Privileges.Count);
  6816. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  6817. AssertEquals('No grant option',False,T.GrantOption);
  6818. end;
  6819. procedure TTestGrantParser.TestViewPrivilege;
  6820. Var
  6821. t : TSQLTableGrantStatement;
  6822. G : TSQLViewGrantee;
  6823. begin
  6824. TestGrant('GRANT SELECT ON A TO VIEW B');
  6825. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6826. AssertIdentifierName('Table name','A',T.TableName);
  6827. AssertEquals('One grantee', 1,T.Grantees.Count);
  6828. G:=TSQLViewGrantee(CheckClass(T.Grantees[0],TSQLViewGrantee));
  6829. AssertEquals('Grantee B','B',G.Name);
  6830. AssertEquals('One permission',1,T.Privileges.Count);
  6831. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  6832. AssertEquals('No grant option',False,T.GrantOption);
  6833. end;
  6834. procedure TTestGrantParser.TestTriggerPrivilege;
  6835. Var
  6836. t : TSQLTableGrantStatement;
  6837. G : TSQLTriggerGrantee;
  6838. begin
  6839. TestGrant('GRANT SELECT ON A TO TRIGGER B');
  6840. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6841. AssertIdentifierName('Table name','A',T.TableName);
  6842. AssertEquals('One grantee', 1,T.Grantees.Count);
  6843. G:=TSQLTriggerGrantee(CheckClass(T.Grantees[0],TSQLTriggerGrantee));
  6844. AssertEquals('Grantee B','B',G.Name);
  6845. AssertEquals('One permission',1,T.Privileges.Count);
  6846. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  6847. AssertEquals('No grant option',False,T.GrantOption);
  6848. end;
  6849. procedure TTestGrantParser.TestPublicPrivilege;
  6850. Var
  6851. t : TSQLTableGrantStatement;
  6852. begin
  6853. TestGrant('GRANT SELECT ON A TO PUBLIC');
  6854. T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
  6855. AssertIdentifierName('Table name','A',T.TableName);
  6856. AssertEquals('One grantee', 1,T.Grantees.Count);
  6857. (CheckClass(T.Grantees[0],TSQLPublicGrantee));
  6858. AssertEquals('One permission',1,T.Privileges.Count);
  6859. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  6860. AssertEquals('No grant option',False,T.GrantOption);
  6861. end;
  6862. procedure TTestGrantParser.TestExecuteToUser;
  6863. Var
  6864. P : TSQLProcedureGrantStatement;
  6865. U : TSQLUserGrantee;
  6866. begin
  6867. TestGrant('GRANT EXECUTE ON PROCEDURE A TO B');
  6868. P:=TSQLProcedureGrantStatement(CheckClass(Statement,TSQLProcedureGrantStatement));
  6869. AssertIdentifierName('Procedure name','A',P.ProcedureName);
  6870. AssertEquals('One grantee', 1,P.Grantees.Count);
  6871. U:=TSQLUserGrantee(CheckClass(P.Grantees[0],TSQLUserGrantee));
  6872. AssertEquals('User name','B',U.Name);
  6873. AssertEquals('No grant option',False,P.GrantOption);
  6874. end;
  6875. procedure TTestGrantParser.TestExecuteToProcedure;
  6876. Var
  6877. P : TSQLProcedureGrantStatement;
  6878. U : TSQLProcedureGrantee;
  6879. begin
  6880. TestGrant('GRANT EXECUTE ON PROCEDURE A TO PROCEDURE B');
  6881. P:=TSQLProcedureGrantStatement(CheckClass(Statement,TSQLProcedureGrantStatement));
  6882. AssertIdentifierName('Procedure name','A',P.ProcedureName);
  6883. AssertEquals('One grantee', 1,P.Grantees.Count);
  6884. U:=TSQLProcedureGrantee(CheckClass(P.Grantees[0],TSQLProcedureGrantee));
  6885. AssertEquals('Procedure grantee name','B',U.Name);
  6886. AssertEquals('No grant option',False,P.GrantOption);
  6887. end;
  6888. procedure TTestGrantParser.TestRoleToUser;
  6889. Var
  6890. R : TSQLRoleGrantStatement;
  6891. U : TSQLUserGrantee;
  6892. begin
  6893. TestGrant('GRANT A TO B');
  6894. R:=TSQLRoleGrantStatement(CheckClass(Statement,TSQLRoleGrantStatement));
  6895. AssertEquals('One role', 1,R.Roles.Count);
  6896. AssertIdentifierName('Role name','A',R.Roles[0]);
  6897. AssertEquals('One grantee', 1,R.Grantees.Count);
  6898. U:=TSQLUserGrantee(CheckClass(R.Grantees[0],TSQLUserGrantee));
  6899. AssertEquals('Procedure grantee name','B',U.Name);
  6900. AssertEquals('No admin option',False,R.AdminOption);
  6901. end;
  6902. procedure TTestGrantParser.TestRoleToUserWithAdmin;
  6903. Var
  6904. R : TSQLRoleGrantStatement;
  6905. U : TSQLUserGrantee;
  6906. begin
  6907. TestGrant('GRANT A TO B WITH ADMIN OPTION');
  6908. R:=TSQLRoleGrantStatement(CheckClass(Statement,TSQLRoleGrantStatement));
  6909. AssertEquals('One role', 1,R.Roles.Count);
  6910. AssertIdentifierName('Role name','A',R.Roles[0]);
  6911. AssertEquals('One grantee', 1,R.Grantees.Count);
  6912. U:=TSQLUserGrantee(CheckClass(R.Grantees[0],TSQLUserGrantee));
  6913. AssertEquals('Procedure grantee name','B',U.Name);
  6914. AssertEquals('Admin option',True,R.AdminOption);
  6915. end;
  6916. procedure TTestGrantParser.TestRoleToPublic;
  6917. Var
  6918. R : TSQLRoleGrantStatement;
  6919. begin
  6920. TestGrant('GRANT A TO PUBLIC');
  6921. R:=TSQLRoleGrantStatement(CheckClass(Statement,TSQLRoleGrantStatement));
  6922. AssertEquals('One role', 1,R.Roles.Count);
  6923. AssertIdentifierName('Role name','A',R.Roles[0]);
  6924. AssertEquals('One grantee', 1,R.Grantees.Count);
  6925. CheckClass(R.Grantees[0],TSQLPublicGrantee);
  6926. AssertEquals('No admin option',False,R.AdminOption);
  6927. end;
  6928. procedure TTestGrantParser.Test2RolesToUser;
  6929. Var
  6930. R : TSQLRoleGrantStatement;
  6931. U : TSQLUserGrantee;
  6932. begin
  6933. TestGrant('GRANT A,C TO B');
  6934. R:=TSQLRoleGrantStatement(CheckClass(Statement,TSQLRoleGrantStatement));
  6935. AssertEquals('2 roles', 2,R.Roles.Count);
  6936. AssertIdentifierName('Role name','A',R.Roles[0]);
  6937. AssertIdentifierName('Role name','C',R.Roles[1]);
  6938. AssertEquals('One grantee', 1,R.Grantees.Count);
  6939. U:=TSQLUserGrantee(CheckClass(R.Grantees[0],TSQLUserGrantee));
  6940. AssertEquals('Procedure grantee name','B',U.Name);
  6941. AssertEquals('No admin option',False,R.AdminOption);
  6942. end;
  6943. { TTestRevokeParser }
  6944. function TTestRevokeParser.TestRevoke(const ASource: String): TSQLRevokeStatement;
  6945. begin
  6946. CreateParser(ASource);
  6947. FToFree:=Parser.Parse;
  6948. If not (FToFree is TSQLRevokeStatement) then
  6949. Fail(Format('Wrong parse result class. Expected TSQLRevokeStatement, got %s',[FTofree.ClassName]));
  6950. Result:=TSQLRevokeStatement(Ftofree);
  6951. FSTatement:=Result;
  6952. AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
  6953. end;
  6954. procedure TTestRevokeParser.TestRevokeError(const ASource: String);
  6955. begin
  6956. FErrSource:=ASource;
  6957. AssertException(ESQLParser,@TestParseError);
  6958. end;
  6959. procedure TTestRevokeParser.TestSimple;
  6960. Var
  6961. t : TSQLTableRevokeStatement;
  6962. G : TSQLUSerGrantee;
  6963. begin
  6964. TestRevoke('Revoke SELECT ON A FROM B');
  6965. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  6966. AssertIdentifierName('Table name','A',T.TableName);
  6967. AssertEquals('One Grantee', 1,T.Grantees.Count);
  6968. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  6969. AssertEquals('Grantee B','B',G.Name);
  6970. AssertEquals('One permission',1,T.Privileges.Count);
  6971. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  6972. AssertEquals('No Revoke option',False,T.GrantOption);
  6973. end;
  6974. procedure TTestRevokeParser.Test2Operations;
  6975. Var
  6976. t : TSQLTableRevokeStatement;
  6977. G : TSQLUSerGrantee;
  6978. begin
  6979. TestRevoke('Revoke SELECT,INSERT ON A FROM B');
  6980. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  6981. AssertIdentifierName('Table name','A',T.TableName);
  6982. AssertEquals('One Grantee', 1,T.Grantees.Count);
  6983. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  6984. AssertEquals('Grantee B','B',G.Name);
  6985. AssertEquals('Two permissions',2,T.Privileges.Count);
  6986. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  6987. CheckClass(T.Privileges[1],TSQLINSERTPrivilege);
  6988. AssertEquals('No Revoke option',False,T.GrantOption);
  6989. end;
  6990. procedure TTestRevokeParser.TestDeletePrivilege;
  6991. Var
  6992. t : TSQLTableRevokeStatement;
  6993. G : TSQLUSerGrantee;
  6994. begin
  6995. TestRevoke('Revoke DELETE ON A FROM B');
  6996. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  6997. AssertIdentifierName('Table name','A',T.TableName);
  6998. AssertEquals('One Grantee', 1,T.Grantees.Count);
  6999. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  7000. AssertEquals('Grantee B','B',G.Name);
  7001. AssertEquals('One permission',1,T.Privileges.Count);
  7002. CheckClass(T.Privileges[0],TSQLDeletePrivilege);
  7003. AssertEquals('No Revoke option',False,T.GrantOption);
  7004. end;
  7005. procedure TTestRevokeParser.TestUpdatePrivilege;
  7006. Var
  7007. t : TSQLTableRevokeStatement;
  7008. G : TSQLUSerGrantee;
  7009. begin
  7010. TestRevoke('Revoke UPDATE ON A FROM B');
  7011. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  7012. AssertIdentifierName('Table name','A',T.TableName);
  7013. AssertEquals('One Grantee', 1,T.Grantees.Count);
  7014. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  7015. AssertEquals('Grantee B','B',G.Name);
  7016. AssertEquals('One permission',1,T.Privileges.Count);
  7017. CheckClass(T.Privileges[0],TSQLUPDATEPrivilege);
  7018. AssertEquals('No Revoke option',False,T.GrantOption);
  7019. end;
  7020. procedure TTestRevokeParser.TestInsertPrivilege;
  7021. Var
  7022. t : TSQLTableRevokeStatement;
  7023. G : TSQLUSerGrantee;
  7024. begin
  7025. TestRevoke('Revoke INSERT ON A FROM B');
  7026. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  7027. AssertIdentifierName('Table name','A',T.TableName);
  7028. AssertEquals('One Grantee', 1,T.Grantees.Count);
  7029. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  7030. AssertEquals('Grantee B','B',G.Name);
  7031. AssertEquals('One permission',1,T.Privileges.Count);
  7032. CheckClass(T.Privileges[0],TSQLInsertPrivilege);
  7033. AssertEquals('No Revoke option',False,T.GrantOption);
  7034. end;
  7035. procedure TTestRevokeParser.TestReferencePrivilege;
  7036. Var
  7037. t : TSQLTableRevokeStatement;
  7038. G : TSQLUSerGrantee;
  7039. begin
  7040. TestRevoke('Revoke REFERENCES ON A FROM B');
  7041. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  7042. AssertIdentifierName('Table name','A',T.TableName);
  7043. AssertEquals('One Grantee', 1,T.Grantees.Count);
  7044. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  7045. AssertEquals('Grantee B','B',G.Name);
  7046. AssertEquals('One permission',1,T.Privileges.Count);
  7047. CheckClass(T.Privileges[0],TSQLReferencePrivilege);
  7048. AssertEquals('No Revoke option',False,T.GrantOption);
  7049. end;
  7050. procedure TTestRevokeParser.TestAllPrivileges;
  7051. Var
  7052. t : TSQLTableRevokeStatement;
  7053. G : TSQLUSerGrantee;
  7054. begin
  7055. TestRevoke('Revoke ALL ON A FROM B');
  7056. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  7057. AssertIdentifierName('Table name','A',T.TableName);
  7058. AssertEquals('One Grantee', 1,T.Grantees.Count);
  7059. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  7060. AssertEquals('Grantee B','B',G.Name);
  7061. AssertEquals('One permission',1,T.Privileges.Count);
  7062. CheckClass(T.Privileges[0],TSQLAllPrivilege);
  7063. AssertEquals('No Revoke option',False,T.GrantOption);
  7064. end;
  7065. procedure TTestRevokeParser.TestAllPrivileges2;
  7066. Var
  7067. t : TSQLTableRevokeStatement;
  7068. G : TSQLUSerGrantee;
  7069. begin
  7070. TestRevoke('Revoke ALL PRIVILEGES ON A FROM B');
  7071. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  7072. AssertIdentifierName('Table name','A',T.TableName);
  7073. AssertEquals('One Grantee', 1,T.Grantees.Count);
  7074. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  7075. AssertEquals('Grantee B','B',G.Name);
  7076. AssertEquals('One permission',1,T.Privileges.Count);
  7077. CheckClass(T.Privileges[0],TSQLAllPrivilege);
  7078. AssertEquals('No Revoke option',False,T.GrantOption);
  7079. end;
  7080. procedure TTestRevokeParser.TestUpdateColPrivilege;
  7081. Var
  7082. t : TSQLTableRevokeStatement;
  7083. G : TSQLUSerGrantee;
  7084. U : TSQLUPDATEPrivilege;
  7085. begin
  7086. TestRevoke('Revoke UPDATE (C) ON A FROM B');
  7087. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  7088. AssertIdentifierName('Table name','A',T.TableName);
  7089. AssertEquals('One Grantee', 1,T.Grantees.Count);
  7090. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  7091. AssertEquals('Grantee B','B',G.Name);
  7092. AssertEquals('One permission',1,T.Privileges.Count);
  7093. U:=TSQLUPDATEPrivilege(CheckClass(T.Privileges[0],TSQLUPDATEPrivilege));
  7094. AssertEquals('1 column',1,U.Columns.Count);
  7095. AssertIdentifierName('Column C','C',U.Columns[0]);
  7096. AssertEquals('No Revoke option',False,T.GrantOption);
  7097. end;
  7098. procedure TTestRevokeParser.TestUpdate2ColsPrivilege;
  7099. Var
  7100. t : TSQLTableRevokeStatement;
  7101. G : TSQLUSerGrantee;
  7102. U : TSQLUPDATEPrivilege;
  7103. begin
  7104. TestRevoke('Revoke UPDATE (C,D) ON A FROM B');
  7105. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  7106. AssertIdentifierName('Table name','A',T.TableName);
  7107. AssertEquals('One Grantee', 1,T.Grantees.Count);
  7108. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  7109. AssertEquals('Grantee B','B',G.Name);
  7110. AssertEquals('One permission',1,T.Privileges.Count);
  7111. U:=TSQLUPDATEPrivilege(CheckClass(T.Privileges[0],TSQLUPDATEPrivilege));
  7112. AssertEquals('2 column',2,U.Columns.Count);
  7113. AssertIdentifierName('Column C','C',U.Columns[0]);
  7114. AssertIdentifierName('Column D','D',U.Columns[1]);
  7115. AssertEquals('No Revoke option',False,T.GrantOption);
  7116. end;
  7117. procedure TTestRevokeParser.TestReferenceColPrivilege;
  7118. Var
  7119. t : TSQLTableRevokeStatement;
  7120. G : TSQLUSerGrantee;
  7121. U : TSQLReferencePrivilege;
  7122. begin
  7123. TestRevoke('Revoke REFERENCES (C) ON A FROM B');
  7124. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  7125. AssertIdentifierName('Table name','A',T.TableName);
  7126. AssertEquals('One Grantee', 1,T.Grantees.Count);
  7127. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  7128. AssertEquals('Grantee B','B',G.Name);
  7129. AssertEquals('One permission',1,T.Privileges.Count);
  7130. U:=TSQLReferencePrivilege(CheckClass(T.Privileges[0],TSQLReferencePrivilege));
  7131. AssertEquals('1 column',1,U.Columns.Count);
  7132. AssertIdentifierName('Column C','C',U.Columns[0]);
  7133. AssertEquals('No Revoke option',False,T.GrantOption);
  7134. end;
  7135. procedure TTestRevokeParser.TestReference2ColsPrivilege;
  7136. Var
  7137. t : TSQLTableRevokeStatement;
  7138. G : TSQLUSerGrantee;
  7139. U : TSQLReferencePrivilege;
  7140. begin
  7141. TestRevoke('Revoke REFERENCES (C,D) ON A FROM B');
  7142. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  7143. AssertIdentifierName('Table name','A',T.TableName);
  7144. AssertEquals('One Grantee', 1,T.Grantees.Count);
  7145. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  7146. AssertEquals('Grantee B','B',G.Name);
  7147. AssertEquals('One permission',1,T.Privileges.Count);
  7148. U:=TSQLReferencePrivilege(CheckClass(T.Privileges[0],TSQLReferencePrivilege));
  7149. AssertEquals('2 column',2,U.Columns.Count);
  7150. AssertIdentifierName('Column C','C',U.Columns[0]);
  7151. AssertIdentifierName('Column D','D',U.Columns[1]);
  7152. AssertEquals('No Revoke option',False,T.GrantOption);
  7153. end;
  7154. procedure TTestRevokeParser.TestUserPrivilege;
  7155. Var
  7156. t : TSQLTableRevokeStatement;
  7157. G : TSQLUSerGrantee;
  7158. begin
  7159. TestRevoke('Revoke SELECT ON A FROM USER B');
  7160. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  7161. AssertIdentifierName('Table name','A',T.TableName);
  7162. AssertEquals('One Grantee', 1,T.Grantees.Count);
  7163. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  7164. AssertEquals('Grantee B','B',G.Name);
  7165. AssertEquals('One permission',1,T.Privileges.Count);
  7166. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  7167. AssertEquals('No Revoke option',False,T.GrantOption);
  7168. end;
  7169. procedure TTestRevokeParser.TestUserPrivilegeWithRevoke;
  7170. Var
  7171. t : TSQLTableRevokeStatement;
  7172. G : TSQLUSerGrantee;
  7173. begin
  7174. TestRevoke('Revoke GRANT OPTION FOR SELECT ON A FROM USER B');
  7175. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  7176. AssertIdentifierName('Table name','A',T.TableName);
  7177. AssertEquals('One Grantee', 1,T.Grantees.Count);
  7178. G:=TSQLUSerGrantee(CheckClass(T.Grantees[0],TSQLUSerGrantee));
  7179. AssertEquals('Grantee B','B',G.Name);
  7180. AssertEquals('One permission',1,T.Privileges.Count);
  7181. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  7182. AssertEquals('With Revoke option',True,T.GrantOption);
  7183. end;
  7184. procedure TTestRevokeParser.TestGroupPrivilege;
  7185. Var
  7186. t : TSQLTableRevokeStatement;
  7187. G : TSQLGroupGrantee;
  7188. begin
  7189. TestRevoke('Revoke SELECT ON A FROM GROUP B');
  7190. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  7191. AssertIdentifierName('Table name','A',T.TableName);
  7192. AssertEquals('One Grantee', 1,T.Grantees.Count);
  7193. G:=TSQLGroupGrantee(CheckClass(T.Grantees[0],TSQLGroupGrantee));
  7194. AssertEquals('Grantee B','B',G.Name);
  7195. AssertEquals('One permission',1,T.Privileges.Count);
  7196. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  7197. AssertEquals('No Revoke option',False,T.GrantOption);
  7198. end;
  7199. procedure TTestRevokeParser.TestProcedurePrivilege;
  7200. Var
  7201. t : TSQLTableRevokeStatement;
  7202. G : TSQLProcedureGrantee;
  7203. begin
  7204. TestRevoke('Revoke SELECT ON A FROM PROCEDURE B');
  7205. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  7206. AssertIdentifierName('Table name','A',T.TableName);
  7207. AssertEquals('One Grantee', 1,T.Grantees.Count);
  7208. G:=TSQLProcedureGrantee(CheckClass(T.Grantees[0],TSQLProcedureGrantee));
  7209. AssertEquals('Grantee B','B',G.Name);
  7210. AssertEquals('One permission',1,T.Privileges.Count);
  7211. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  7212. AssertEquals('No Revoke option',False,T.GrantOption);
  7213. end;
  7214. procedure TTestRevokeParser.TestViewPrivilege;
  7215. Var
  7216. t : TSQLTableRevokeStatement;
  7217. G : TSQLViewGrantee;
  7218. begin
  7219. TestRevoke('Revoke SELECT ON A FROM VIEW B');
  7220. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  7221. AssertIdentifierName('Table name','A',T.TableName);
  7222. AssertEquals('One Grantee', 1,T.Grantees.Count);
  7223. G:=TSQLViewGrantee(CheckClass(T.Grantees[0],TSQLViewGrantee));
  7224. AssertEquals('Grantee B','B',G.Name);
  7225. AssertEquals('One permission',1,T.Privileges.Count);
  7226. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  7227. AssertEquals('No Revoke option',False,T.GrantOption);
  7228. end;
  7229. procedure TTestRevokeParser.TestTriggerPrivilege;
  7230. Var
  7231. t : TSQLTableRevokeStatement;
  7232. G : TSQLTriggerGrantee;
  7233. begin
  7234. TestRevoke('Revoke SELECT ON A FROM TRIGGER B');
  7235. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  7236. AssertIdentifierName('Table name','A',T.TableName);
  7237. AssertEquals('One Grantee', 1,T.Grantees.Count);
  7238. G:=TSQLTriggerGrantee(CheckClass(T.Grantees[0],TSQLTriggerGrantee));
  7239. AssertEquals('Grantee B','B',G.Name);
  7240. AssertEquals('One permission',1,T.Privileges.Count);
  7241. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  7242. AssertEquals('No Revoke option',False,T.GrantOption);
  7243. end;
  7244. procedure TTestRevokeParser.TestPublicPrivilege;
  7245. Var
  7246. t : TSQLTableRevokeStatement;
  7247. begin
  7248. TestRevoke('Revoke SELECT ON A FROM PUBLIC');
  7249. T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
  7250. AssertIdentifierName('Table name','A',T.TableName);
  7251. AssertEquals('One Grantee', 1,T.Grantees.Count);
  7252. (CheckClass(T.Grantees[0],TSQLPublicGrantee));
  7253. AssertEquals('One permission',1,T.Privileges.Count);
  7254. CheckClass(T.Privileges[0],TSQLSelectPrivilege);
  7255. AssertEquals('No Revoke option',False,T.GrantOption);
  7256. end;
  7257. procedure TTestRevokeParser.TestExecuteToUser;
  7258. Var
  7259. P : TSQLProcedureRevokeStatement;
  7260. U : TSQLUserGrantee;
  7261. begin
  7262. TestRevoke('Revoke EXECUTE ON PROCEDURE A FROM B');
  7263. P:=TSQLProcedureRevokeStatement(CheckClass(Statement,TSQLProcedureRevokeStatement));
  7264. AssertIdentifierName('Procedure name','A',P.ProcedureName);
  7265. AssertEquals('One Grantee', 1,P.Grantees.Count);
  7266. U:=TSQLUserGrantee(CheckClass(P.Grantees[0],TSQLUserGrantee));
  7267. AssertEquals('User name','B',U.Name);
  7268. AssertEquals('No Revoke option',False,P.GrantOption);
  7269. end;
  7270. procedure TTestRevokeParser.TestExecuteToProcedure;
  7271. Var
  7272. P : TSQLProcedureRevokeStatement;
  7273. U : TSQLProcedureGrantee;
  7274. begin
  7275. TestRevoke('Revoke EXECUTE ON PROCEDURE A FROM PROCEDURE B');
  7276. P:=TSQLProcedureRevokeStatement(CheckClass(Statement,TSQLProcedureRevokeStatement));
  7277. AssertIdentifierName('Procedure name','A',P.ProcedureName);
  7278. AssertEquals('One Grantee', 1,P.Grantees.Count);
  7279. U:=TSQLProcedureGrantee(CheckClass(P.Grantees[0],TSQLProcedureGrantee));
  7280. AssertEquals('Procedure Grantee name','B',U.Name);
  7281. AssertEquals('No Revoke option',False,P.GrantOption);
  7282. end;
  7283. procedure TTestRevokeParser.TestRoleToUser;
  7284. Var
  7285. R : TSQLRoleRevokeStatement;
  7286. U : TSQLUserGrantee;
  7287. begin
  7288. TestRevoke('Revoke A FROM B');
  7289. R:=TSQLRoleRevokeStatement(CheckClass(Statement,TSQLRoleRevokeStatement));
  7290. AssertEquals('One role', 1,R.Roles.Count);
  7291. AssertIdentifierName('Role name','A',R.Roles[0]);
  7292. AssertEquals('One Grantee', 1,R.Grantees.Count);
  7293. U:=TSQLUserGrantee(CheckClass(R.Grantees[0],TSQLUserGrantee));
  7294. AssertEquals('Procedure Grantee name','B',U.Name);
  7295. AssertEquals('No admin option',False,R.AdminOption);
  7296. end;
  7297. procedure TTestRevokeParser.TestRoleToPublic;
  7298. Var
  7299. R : TSQLRoleRevokeStatement;
  7300. begin
  7301. TestRevoke('Revoke A FROM PUBLIC');
  7302. R:=TSQLRoleRevokeStatement(CheckClass(Statement,TSQLRoleRevokeStatement));
  7303. AssertEquals('One role', 1,R.Roles.Count);
  7304. AssertIdentifierName('Role name','A',R.Roles[0]);
  7305. AssertEquals('One Grantee', 1,R.Grantees.Count);
  7306. CheckClass(R.Grantees[0],TSQLPublicGrantee);
  7307. AssertEquals('No admin option',False,R.AdminOption);
  7308. end;
  7309. procedure TTestRevokeParser.Test2RolesToUser;
  7310. Var
  7311. R : TSQLRoleRevokeStatement;
  7312. U : TSQLUserGrantee;
  7313. begin
  7314. TestRevoke('Revoke A,C FROM B');
  7315. R:=TSQLRoleRevokeStatement(CheckClass(Statement,TSQLRoleRevokeStatement));
  7316. AssertEquals('2 roles', 2,R.Roles.Count);
  7317. AssertIdentifierName('Role name','A',R.Roles[0]);
  7318. AssertIdentifierName('Role name','C',R.Roles[1]);
  7319. AssertEquals('One Grantee', 1,R.Grantees.Count);
  7320. U:=TSQLUserGrantee(CheckClass(R.Grantees[0],TSQLUserGrantee));
  7321. AssertEquals('Procedure Grantee name','B',U.Name);
  7322. AssertEquals('No admin option',False,R.AdminOption);
  7323. end;
  7324. initialization
  7325. RegisterTests([TTestDropParser,
  7326. TTestGeneratorParser,
  7327. TTestRoleParser,
  7328. TTestTypeParser,
  7329. TTestCheckParser,
  7330. TTestDomainParser,
  7331. TTestExceptionParser,
  7332. TTestIndexParser,
  7333. TTestTableParser,
  7334. TTestDeleteParser,
  7335. TTestUpdateParser,
  7336. TTestInsertParser,
  7337. TTestSelectParser,
  7338. TTestRollbackParser,
  7339. TTestCommitParser,
  7340. TTestExecuteProcedureParser,
  7341. TTestConnectParser,
  7342. TTestCreateDatabaseParser,
  7343. TTestAlterDatabaseParser,
  7344. TTestCreateViewParser,
  7345. TTestCreateShadowParser,
  7346. TTestProcedureStatement,
  7347. TTestCreateProcedureParser,
  7348. TTestCreateTriggerParser,
  7349. TTestDeclareExternalFunctionParser,
  7350. TTestGrantParser,
  7351. TTestRevokeParser,
  7352. TTestGlobalParser,
  7353. TTestSetTermParser]);
  7354. end.