tcparser.pas 298 KB

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