tcparser.pas 283 KB

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