tcparser.pas 300 KB

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