tcparser.pas 288 KB

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