tcparser.pas 292 KB

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