tcparser.pas 282 KB

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