tcparser.pas 304 KB

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