tcparser.pas 297 KB

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