tcparser.pas 284 KB

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