tcparser.pas 280 KB

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