tcparser.pas 294 KB

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