tcparser.pas 280 KB

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