tcparser.pas 296 KB

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