tcparser.pas 294 KB

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