tcparser.pas 293 KB

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