tcparser.pas 300 KB

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