2
0

tcparser.pas 304 KB

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