tcparser.pas 281 KB

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