tcparser.pas 287 KB

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