tcparser.pas 285 KB

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