tcparser.pas 304 KB

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