tcparser.pas 286 KB

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