tcparser.pas 285 KB

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