tcparser.pas 287 KB

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