regexpr.pas 200 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946
  1. unit regexpr;
  2. {
  3. TRegExpr class library
  4. Delphi Regular Expressions
  5. Copyright (c) 1999-2004 Andrey V. Sorokin, St.Petersburg, Russia
  6. You can choose to use this Pascal unit in one of the two following licenses:
  7. Option 1>
  8. You may use this software in any kind of development,
  9. including comercial, redistribute, and modify it freely,
  10. under the following restrictions :
  11. 1. This software is provided as it is, without any kind of
  12. warranty given. Use it at Your own risk.The author is not
  13. responsible for any consequences of use of this software.
  14. 2. The origin of this software may not be mispresented, You
  15. must not claim that You wrote the original software. If
  16. You use this software in any kind of product, it would be
  17. appreciated that there in a information box, or in the
  18. documentation would be an acknowledgement like
  19. Partial Copyright (c) 2004 Andrey V. Sorokin
  20. https://sorokin.engineer/
  21. [email protected]
  22. 3. You may not have any income from distributing this source
  23. (or altered version of it) to other developers. When You
  24. use this product in a comercial package, the source may
  25. not be charged seperatly.
  26. 4. Altered versions must be plainly marked as such, and must
  27. not be misrepresented as being the original software.
  28. 5. RegExp Studio application and all the visual components as
  29. well as documentation is not part of the TRegExpr library
  30. and is not free for usage.
  31. https://sorokin.engineer/
  32. [email protected]
  33. Option 2>
  34. The same modified LGPL with static linking exception as the Free Pascal RTL
  35. }
  36. {
  37. program is essentially a linear encoding
  38. of a nondeterministic finite-state machine (aka syntax charts or
  39. "railroad normal form" in parsing technology). Each node is an opcode
  40. plus a "next" pointer, possibly plus an operand. "Next" pointers of
  41. all nodes except BRANCH implement concatenation; a "next" pointer with
  42. a BRANCH on both ends of it connects two alternatives. (Here we
  43. have one of the subtle syntax dependencies: an individual BRANCH (as
  44. opposed to a collection of them) is never concatenated with anything
  45. because of operator precedence.) The operand of some types of node is
  46. a literal string; for others, it is a node leading into a sub-FSM. In
  47. particular, the operand of a BRANCH node is the first node of the branch.
  48. (NB this is *not* a tree structure: the tail of the branch connects
  49. to the thing following the set of BRANCHes.)
  50. }
  51. interface
  52. { off $DEFINE DebugSynRegExpr }
  53. // ======== Determine compiler
  54. // ======== Define base compiler options
  55. {$BOOLEVAL OFF}
  56. {$EXTENDEDSYNTAX ON}
  57. {$LONGSTRINGS ON}
  58. { OPTIMIZATION ON} // Handled by (fp)make options
  59. {$MODE DELPHI} // Delphi-compatible mode in FreePascal
  60. {$INLINE ON}
  61. {$DEFINE COMPAT}
  62. // ======== Define options for TRegExpr engine
  63. { $DEFINE Unicode} // Use WideChar for characters and UnicodeString/WideString for strings
  64. { off $DEFINE UnicodeEx} // Support Unicode >0xFFFF, e.g. emoji, e.g. "." must find 2 WideChars of 1 emoji
  65. {$DEFINE UseWordChars} // Use WordChars property, otherwise fixed list 'a'..'z','A'..'Z','0'..'9','_'
  66. {$DEFINE UseSpaceChars} // Use SpaceChars property, otherwise fixed list
  67. {$DEFINE UseLineSep} // Use LineSeparators property, otherwise fixed line-break chars
  68. {$DEFINE UseFirstCharSet} // Enable optimization, which finds possible first chars of input string
  69. {$DEFINE RegExpPCodeDump} // Enable method Dump() to show opcode as string
  70. {$IFNDEF FPC} // Not supported in FreePascal
  71. {$DEFINE reRealExceptionAddr} // Exceptions will point to appropriate source line, not to Error procedure
  72. {$ENDIF}
  73. {$DEFINE ComplexBraces} // Support braces in complex cases
  74. {$IFNDEF Unicode}
  75. {$UNDEF UnicodeEx}
  76. {$UNDEF FastUnicodeData}
  77. {$ENDIF}
  78. {.$DEFINE Compat} // Enable compatability methods/properties for forked version in Free Pascal 3.0
  79. // ======== Define Pascal-language options
  80. // Define 'UseAsserts' option (do not edit this definitions).
  81. // Asserts used to catch 'strange bugs' in TRegExpr implementation (when something goes
  82. // completely wrong). You can swith asserts on/off with help of {$C+}/{$C-} compiler options.
  83. {$IFDEF D3} {$DEFINE UseAsserts} {$ENDIF}
  84. {$IFDEF FPC} {$DEFINE UseAsserts} {$ENDIF}
  85. // Define 'use subroutine parameters default values' option (do not edit this definition).
  86. {$IFDEF D4} {$DEFINE DefParam} {$ENDIF}
  87. {$IFDEF FPC} {$DEFINE DefParam} {$ENDIF}
  88. // Define 'OverMeth' options, to use method overloading (do not edit this definitions).
  89. {$IFDEF D5} {$DEFINE OverMeth} {$ENDIF}
  90. {$IFDEF FPC} {$DEFINE OverMeth} {$ENDIF}
  91. // Define 'InlineFuncs' options, to use inline keyword (do not edit this definitions).
  92. {$IFDEF D8} {$DEFINE InlineFuncs} {$ENDIF}
  93. {$IFDEF FPC} {$DEFINE InlineFuncs} {$ENDIF}
  94. uses
  95. Classes, // TStrings in Split method
  96. SysUtils, // Exception
  97. {$IFDEF D2009}
  98. {$IFDEF D_XE}
  99. System.Character,
  100. {$ELSE}
  101. Character,
  102. {$ENDIF}
  103. {$ENDIF}
  104. Math;
  105. type
  106. {$IFNDEF FPC}
  107. // Delphi doesn't have PtrInt but has NativeInt
  108. PtrInt = NativeInt;
  109. PtrUInt = NativeInt;
  110. {$ENDIF}
  111. {$IFDEF UniCode}
  112. PRegExprChar = PWideChar;
  113. {$IFDEF FPC}
  114. RegExprString = UnicodeString;
  115. {$ELSE}
  116. {$IFDEF D2009}
  117. RegExprString = UnicodeString;
  118. {$ELSE}
  119. RegExprString = WideString;
  120. {$ENDIF}
  121. {$ENDIF}
  122. REChar = WideChar;
  123. {$ELSE}
  124. PRegExprChar = PChar;
  125. RegExprString = AnsiString;
  126. REChar = Char;
  127. {$ENDIF}
  128. TREOp = REChar; // internal opcode type
  129. PREOp = ^TREOp;
  130. type
  131. TRegExprCharset = set of byte;
  132. const
  133. // Escape char ('\' in common r.e.) used for escaping metachars (\w, \d etc)
  134. EscChar = '\';
  135. // Substitute method: prefix of group reference: $1 .. $9 and $<name>
  136. SubstituteGroupChar = '$';
  137. RegExprModifierI: boolean = False; // default value for ModifierI
  138. RegExprModifierR: boolean = True; // default value for ModifierR
  139. RegExprModifierS: boolean = True; // default value for ModifierS
  140. RegExprModifierG: boolean = True; // default value for ModifierG
  141. RegExprModifierM: boolean = False; // default value for ModifierM
  142. RegExprModifierX: boolean = False; // default value for ModifierX
  143. {$IFDEF UseSpaceChars}
  144. // default value for SpaceChars
  145. RegExprSpaceChars: RegExprString = ' '#$9#$A#$D#$C;
  146. {$ENDIF}
  147. {$IFDEF UseWordChars}
  148. // default value for WordChars
  149. RegExprWordChars: RegExprString = '0123456789'
  150. + 'abcdefghijklmnopqrstuvwxyz'
  151. + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_';
  152. {$ENDIF}
  153. {$IFDEF UseLineSep}
  154. // default value for LineSeparators
  155. RegExprLineSeparators: RegExprString = #$d#$a#$b#$c
  156. {$IFDEF UniCode}
  157. + #$2028#$2029#$85
  158. {$ENDIF};
  159. {$ENDIF}
  160. // Tab and Unicode category "Space Separator":
  161. // https://www.compart.com/en/unicode/category/Zs
  162. RegExprHorzSeparators: RegExprString = #9#$20#$A0
  163. {$IFDEF UniCode}
  164. + #$1680#$2000#$2001#$2002#$2003#$2004#$2005#$2006#$2007#$2008#$2009#$200A#$202F#$205F#$3000
  165. {$ENDIF};
  166. RegExprUsePairedBreak: boolean = True;
  167. RegExprReplaceLineBreak: RegExprString = sLineBreak;
  168. RegExprLookaheadIsAtomic: boolean = False;
  169. RegExprLookbehindIsAtomic: boolean = True;
  170. const
  171. RegexMaxGroups = 90;
  172. // Max number of groups.
  173. // Be carefull - don't use values which overflow OP_CLOSE* opcode
  174. // (in this case you'll get compiler error).
  175. // Big value causes slower work and more stack required.
  176. RegexMaxMaxGroups = 255;
  177. // Max possible value for RegexMaxGroups.
  178. // Don't change it! It's defined by internal TRegExpr design.
  179. {$IFDEF ComplexBraces}
  180. const
  181. LoopStackMax = 10; // max depth of loops stack //###0.925
  182. type
  183. TRegExprLoopStack = array [1 .. LoopStackMax] of integer;
  184. {$ENDIF}
  185. type
  186. TRegExprModifiers = record
  187. I: boolean;
  188. // Case-insensitive.
  189. R: boolean;
  190. // Extended syntax for Russian ranges in [].
  191. // If True, then а-я additionally includes letter 'ё',
  192. // А-Я additionally includes 'Ё', and а-Я includes all Russian letters.
  193. // Turn it off if it interferes with your national alphabet.
  194. S: boolean;
  195. // Dot '.' matches any char, otherwise only [^\n].
  196. G: boolean;
  197. // Greedy. Switching it off switches all operators to non-greedy style,
  198. // so if G=False, then '*' works like '*?', '+' works like '+?' and so on.
  199. M: boolean;
  200. // Treat string as multiple lines. It changes `^' and `$' from
  201. // matching at only the very start/end of the string to the start/end
  202. // of any line anywhere within the string.
  203. X: boolean;
  204. // Allow comments in regex using # char.
  205. end;
  206. function IsModifiersEqual(const A, B: TRegExprModifiers): boolean;
  207. type
  208. TRegExpr = class;
  209. TRegExprReplaceFunction = function(ARegExpr: TRegExpr): RegExprString of object;
  210. TRegExprCharChecker = function(ch: REChar): boolean of object;
  211. TRegExprCharCheckerArray = array[0 .. 30] of TRegExprCharChecker;
  212. TRegExprCharCheckerInfo = record
  213. CharBegin, CharEnd: REChar;
  214. CheckerIndex: integer;
  215. end;
  216. TRegExprCharCheckerInfos = array of TRegExprCharCheckerInfo;
  217. {$IFDEF Compat}
  218. TRegExprInvertCaseFunction = function(const Ch: REChar): REChar of object;
  219. {$ENDIF}
  220. { TRegExpr }
  221. TRegExpr = class
  222. private
  223. GrpStart: array [0 .. RegexMaxGroups - 1] of PRegExprChar; // pointer to group start in InputString
  224. GrpEnd: array [0 .. RegexMaxGroups - 1] of PRegExprChar; // pointer to group end in InputString
  225. GrpIndexes: array [0 .. RegexMaxGroups - 1] of integer; // map global group index to _capturing_ group index
  226. GrpNames: array [0 .. RegexMaxGroups - 1] of RegExprString; // names of groups, if non-empty
  227. GrpAtomic: array [0 .. RegexMaxGroups - 1] of boolean; // group[i] is atomic (filled in Compile)
  228. GrpAtomicDone: array [0 .. RegexMaxGroups - 1] of boolean; // atomic group[i] is "done" (used in Exec* only)
  229. GrpOpCodes: array [0 .. RegexMaxGroups - 1] of PRegExprChar; // pointer to opcode of group[i] (used by OP_SUBCALL*)
  230. GrpSubCalled: array [0 .. RegexMaxGroups - 1] of boolean; // group[i] is called by OP_SUBCALL*
  231. GrpCount: integer;
  232. {$IFDEF ComplexBraces}
  233. LoopStack: TRegExprLoopStack; // state before entering loop
  234. LoopStackIdx: integer; // 0 - out of all loops
  235. {$ENDIF}
  236. // The "internal use only" fields to pass info from compile
  237. // to execute that permits the execute phase to run lots faster on
  238. // simple cases.
  239. regAnchored: REChar; // is the match anchored (at beginning-of-line only)?
  240. // regAnchored permits very fast decisions on suitable starting points
  241. // for a match, cutting down the work a lot. regMust permits fast rejection
  242. // of lines that cannot possibly match. The regMust tests are costly enough
  243. // that regcomp() supplies a regMust only if the r.e. contains something
  244. // potentially expensive (at present, the only such thing detected is * or +
  245. // at the start of the r.e., which can involve a lot of backup). regMustLen is
  246. // supplied because the test in regexec() needs it and regcomp() is computing
  247. // it anyway.
  248. regMust: PRegExprChar; // string (pointer into program) that match must include, or nil
  249. regMustLen: integer; // length of regMust string
  250. regMustString: RegExprString; // string which must occur in match (got from regMust/regMustLen)
  251. regLookahead: boolean; // regex has _some_ lookahead
  252. regLookaheadNeg: boolean; // regex has _nagative_ lookahead
  253. regLookaheadGroup: integer; // index of group for lookahead
  254. regLookbehind: boolean; // regex has positive lookbehind
  255. regNestedCalls: integer; // some attempt to prevent 'catastrophic backtracking' but not used
  256. {$IFDEF UseFirstCharSet}
  257. FirstCharSet: TRegExprCharset;
  258. FirstCharArray: array[byte] of boolean;
  259. {$ENDIF}
  260. // work variables for Exec routines - save stack in recursion
  261. regInput: PRegExprChar; // pointer to currently handling char of input string
  262. fInputStart: PRegExprChar; // pointer to first char of input string
  263. fInputEnd: PRegExprChar; // pointer after last char of input string
  264. fRegexStart: PRegExprChar; // pointer to first char of regex
  265. fRegexEnd: PRegExprChar; // pointer after last char of regex
  266. regCurrentGrp: integer; // index of group handling by OP_OPEN* opcode
  267. // work variables for compiler's routines
  268. regParse: PRegExprChar; // pointer to currently handling char of regex
  269. regNumBrackets: integer; // count of () brackets
  270. regDummy: REChar; // dummy pointer, used to detect 1st/2nd pass of Compile
  271. // if p=@regDummy, it is pass-1: opcode memory is not yet allocated
  272. programm: PRegExprChar; // pointer to opcode, =nil in pass-1
  273. regCode: PRegExprChar; // pointer to last emitted opcode; changing in pass-2, but =@regDummy in pass-1
  274. regCodeSize: integer; // total opcode size in REChars
  275. regCodeWork: PRegExprChar; // pointer to opcode, to first code after MAGIC
  276. regExactlyLen: PLongInt; // pointer to length of substring of OP_EXACTLY* inside opcode
  277. fSecondPass: boolean; // true inside pass-2 of Compile
  278. fExpression: RegExprString; // regex string
  279. fInputString: RegExprString; // input string
  280. fLastError: integer; // Error call sets code of LastError
  281. fLastErrorOpcode: TREOp;
  282. fLastErrorSymbol: REChar;
  283. fModifiers: TRegExprModifiers; // regex modifiers
  284. fCompModifiers: TRegExprModifiers; // compiler's copy of modifiers
  285. fProgModifiers: TRegExprModifiers; // modifiers values from last programm compilation
  286. {$IFDEF UseSpaceChars}
  287. fSpaceChars: RegExprString;
  288. {$ENDIF}
  289. {$IFDEF UseWordChars}
  290. fWordChars: RegExprString;
  291. {$ENDIF}
  292. {$IFDEF UseLineSep}
  293. fLineSeparators: RegExprString;
  294. {$ENDIF}
  295. fUsePairedBreak: boolean;
  296. fReplaceLineEnd: RegExprString; // string to use for "\n" in Substitute method
  297. fSlowChecksSizeMax: integer;
  298. // Exec() param ASlowChecks is set to True, when Length(InputString)<SlowChecksSizeMax
  299. // This ASlowChecks enables to use regMustString optimization
  300. {$IFNDEF UniCode}
  301. fLineSepArray: array[byte] of boolean;
  302. {$ENDIF}
  303. CharCheckers: TRegExprCharCheckerArray;
  304. CharCheckerInfos: TRegExprCharCheckerInfos;
  305. CheckerIndex_Word: byte;
  306. CheckerIndex_NotWord: byte;
  307. CheckerIndex_Digit: byte;
  308. CheckerIndex_NotDigit: byte;
  309. CheckerIndex_Space: byte;
  310. CheckerIndex_NotSpace: byte;
  311. CheckerIndex_HorzSep: byte;
  312. CheckerIndex_NotHorzSep: byte;
  313. CheckerIndex_VertSep: byte;
  314. CheckerIndex_NotVertSep: byte;
  315. CheckerIndex_LowerAZ: byte;
  316. CheckerIndex_UpperAZ: byte;
  317. fHelper: TRegExpr;
  318. fHelperLen: integer;
  319. {$IFDEF Compat}
  320. fUseUnicodeWordDetection: boolean;
  321. fInvertCase: TRegExprInvertCaseFunction;
  322. fEmptyInputRaisesError: boolean;
  323. fUseOsLineEndOnReplace: boolean;
  324. function OldInvertCase(const Ch: REChar): REChar;
  325. function GetLinePairedSeparator: RegExprString;
  326. procedure SetLinePairedSeparator(const AValue: RegExprString);
  327. procedure SetUseOsLineEndOnReplace(AValue: boolean);
  328. {$ENDIF}
  329. function GetUseOsLineEndOnReplace: Boolean;
  330. procedure InitCharCheckers;
  331. function CharChecker_Word(ch: REChar): boolean;
  332. function CharChecker_NotWord(ch: REChar): boolean;
  333. function CharChecker_Space(ch: REChar): boolean;
  334. function CharChecker_NotSpace(ch: REChar): boolean;
  335. function CharChecker_Digit(ch: REChar): boolean;
  336. function CharChecker_NotDigit(ch: REChar): boolean;
  337. function CharChecker_HorzSep(ch: REChar): boolean;
  338. function CharChecker_NotHorzSep(ch: REChar): boolean;
  339. function CharChecker_VertSep(ch: REChar): boolean;
  340. function CharChecker_NotVertSep(ch: REChar): boolean;
  341. function CharChecker_LowerAZ(ch: REChar): boolean;
  342. function CharChecker_UpperAZ(ch: REChar): boolean;
  343. function DumpCheckerIndex(N: byte): RegExprString;
  344. function DumpCategoryChars(ch, ch2: REChar; Positive: boolean): RegExprString;
  345. procedure ClearMatches; {$IFDEF InlineFuncs}inline;{$ENDIF}
  346. procedure ClearInternalIndexes; {$IFDEF InlineFuncs}inline;{$ENDIF}
  347. function FindInCharClass(ABuffer: PRegExprChar; AChar: REChar; AIgnoreCase: boolean): boolean;
  348. procedure GetCharSetFromCharClass(ABuffer: PRegExprChar; AIgnoreCase: boolean; var ARes: TRegExprCharset);
  349. procedure GetCharSetFromSpaceChars(var ARes: TRegExprCharset); {$IFDEF InlineFuncs}inline;{$ENDIF}
  350. procedure GetCharSetFromWordChars(var ARes: TRegExprCharSet); {$IFDEF InlineFuncs}inline;{$ENDIF}
  351. function IsWordChar(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
  352. function IsSpaceChar(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
  353. function IsCustomLineSeparator(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
  354. {$IFDEF UseLineSep}
  355. procedure InitLineSepArray;
  356. {$ENDIF}
  357. procedure FindGroupName(APtr, AEndPtr: PRegExprChar; AEndChar: REChar; var AName: RegExprString);
  358. // Mark programm as having to be [re]compiled
  359. procedure InvalidateProgramm;
  360. // Check if we can use compiled regex, compile it if something changed
  361. function IsProgrammOk: boolean;
  362. procedure SetExpression(const AStr: RegExprString);
  363. function GetModifierStr: RegExprString;
  364. procedure SetModifierStr(const AStr: RegExprString);
  365. function GetModifierG: boolean;
  366. function GetModifierI: boolean;
  367. function GetModifierM: boolean;
  368. function GetModifierR: boolean;
  369. function GetModifierS: boolean;
  370. function GetModifierX: boolean;
  371. procedure SetModifierG(AValue: boolean);
  372. procedure SetModifierI(AValue: boolean);
  373. procedure SetModifierM(AValue: boolean);
  374. procedure SetModifierR(AValue: boolean);
  375. procedure SetModifierS(AValue: boolean);
  376. procedure SetModifierX(AValue: boolean);
  377. // Default handler raises exception ERegExpr with
  378. // Message = ErrorMsg (AErrorID), ErrorCode = AErrorID
  379. // and CompilerErrorPos = value of property CompilerErrorPos.
  380. procedure Error(AErrorID: integer); virtual; // error handler.
  381. { ==================== Compiler section =================== }
  382. // compile a regular expression into internal code
  383. function CompileRegExpr(ARegExp: PRegExprChar): boolean;
  384. // set the next-pointer at the end of a node chain
  385. procedure Tail(p: PRegExprChar; val: PRegExprChar);
  386. // regoptail - regtail on operand of first argument; nop if operandless
  387. procedure OpTail(p: PRegExprChar; val: PRegExprChar);
  388. // regnode - emit a node, return location
  389. function EmitNode(op: TREOp): PRegExprChar;
  390. // emit (if appropriate) a byte of code
  391. procedure EmitC(ch: REChar); {$IFDEF InlineFuncs}inline;{$ENDIF}
  392. // emit LongInt value
  393. procedure EmitInt(AValue: LongInt); {$IFDEF InlineFuncs}inline;{$ENDIF}
  394. // emit back-reference to group
  395. function EmitGroupRef(AIndex: integer; AIgnoreCase: boolean): PRegExprChar;
  396. {$IFDEF FastUnicodeData}
  397. procedure FindCategoryName(var scan: PRegExprChar; var ch1, ch2: REChar);
  398. function EmitCategoryMain(APositive: boolean): PRegExprChar;
  399. {$ENDIF}
  400. // insert an operator in front of already-emitted operand
  401. // Means relocating the operand.
  402. procedure InsertOperator(op: TREOp; opnd: PRegExprChar; sz: integer);
  403. // ###0.90
  404. // regular expression, i.e. main body or parenthesized thing
  405. function ParseReg(InBrackets: boolean; var FlagParse: integer): PRegExprChar;
  406. // one alternative of an | operator
  407. function ParseBranch(var FlagParse: integer): PRegExprChar;
  408. // something followed by possible [*+?]
  409. function ParsePiece(var FlagParse: integer): PRegExprChar;
  410. function HexDig(Ch: REChar): integer;
  411. function UnQuoteChar(var APtr, AEnd: PRegExprChar): REChar;
  412. // the lowest level
  413. function ParseAtom(var FlagParse: integer): PRegExprChar;
  414. // current pos in r.e. - for error hanling
  415. function GetCompilerErrorPos: PtrInt;
  416. {$IFDEF UseFirstCharSet} // ###0.929
  417. procedure FillFirstCharSet(prog: PRegExprChar);
  418. {$ENDIF}
  419. { ===================== Matching section =================== }
  420. // repeatedly match something simple, report how many
  421. function FindRepeated(p: PRegExprChar; AMax: integer): integer;
  422. // dig the "next" pointer out of a node
  423. function regNext(p: PRegExprChar): PRegExprChar;
  424. // recursively matching routine
  425. function MatchPrim(prog: PRegExprChar): boolean;
  426. // match at specific position only, called from ExecPrim
  427. function MatchAtOnePos(APos: PRegExprChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
  428. // Exec for stored InputString
  429. function ExecPrim(AOffset: integer; ATryOnce, ASlowChecks, ABackward: boolean): boolean;
  430. function GetSubExprCount: integer;
  431. function GetMatchPos(Idx: integer): PtrInt;
  432. function GetMatchLen(Idx: integer): PtrInt;
  433. function GetMatch(Idx: integer): RegExprString;
  434. procedure SetInputString(const AInputString: RegExprString);
  435. procedure SetInputRange(AStart, AEnd: PRegExprChar);
  436. {$IFDEF UseLineSep}
  437. procedure SetLineSeparators(const AStr: RegExprString);
  438. {$ENDIF}
  439. procedure SetUsePairedBreak(AValue: boolean);
  440. public
  441. constructor Create; {$IFDEF OverMeth} overload;
  442. constructor Create(const AExpression: RegExprString); overload;
  443. {$ENDIF}
  444. destructor Destroy; override;
  445. class function VersionMajor: integer;
  446. class function VersionMinor: integer;
  447. // match a programm against a string AInputString
  448. // !!! Exec store AInputString into InputString property
  449. // For Delphi 5 and higher available overloaded versions - first without
  450. // parameter (uses already assigned to InputString property value)
  451. // and second that has int parameter and is same as ExecPos
  452. function Exec(const AInputString: RegExprString): boolean;
  453. {$IFDEF OverMeth} overload;
  454. function Exec: boolean; overload;
  455. function Exec(AOffset: integer): boolean; overload;
  456. {$ENDIF}
  457. // find next match:
  458. // ExecNext;
  459. // works the same as
  460. // if MatchLen [0] = 0 then ExecPos (MatchPos [0] + 1)
  461. // else ExecPos (MatchPos [0] + MatchLen [0]);
  462. // but it's more simpler !
  463. // Raises exception if used without preceeding SUCCESSFUL call to
  464. // Exec* (Exec, ExecPos, ExecNext). So You always must use something like
  465. // if Exec (InputString) then repeat { proceed results} until not ExecNext;
  466. function ExecNext(ABackward: boolean {$IFDEF DefParam} = False{$ENDIF}): boolean;
  467. // find match for InputString starting from AOffset position
  468. // (AOffset=1 - first char of InputString)
  469. function ExecPos(AOffset: integer {$IFDEF DefParam} = 1{$ENDIF}): boolean;
  470. {$IFDEF OverMeth} overload;
  471. function ExecPos(AOffset: integer; ATryOnce, ABackward: boolean): boolean; overload;
  472. {$ENDIF}
  473. // Returns ATemplate with '$&' or '$0' replaced by whole r.e.
  474. // occurence and '$1'...'$nn' replaced by subexpression with given index.
  475. // Symbol '$' is used instead of '\' (for future extensions
  476. // and for more Perl-compatibility) and accepts more than one digit.
  477. // If you want to place into template raw '$' or '\', use prefix '\'.
  478. // Example: '1\$ is $2\\rub\\' -> '1$ is <Match[2]>\rub\'
  479. // If you want to place any number after '$' you must enclose it
  480. // with curly braces: '${12}'.
  481. // Example: 'a$12bc' -> 'a<Match[12]>bc'
  482. // 'a${1}2bc' -> 'a<Match[1]>2bc'.
  483. function Substitute(const ATemplate: RegExprString): RegExprString;
  484. // Splits AInputStr to list by positions of all r.e. occurencies.
  485. // Internally calls Exec, ExecNext.
  486. procedure Split(const AInputStr: RegExprString; APieces: TStrings);
  487. function Replace(const AInputStr: RegExprString;
  488. const AReplaceStr: RegExprString;
  489. AUseSubstitution: boolean{$IFDEF DefParam} = False{$ENDIF}) // ###0.946
  490. : RegExprString; {$IFDEF OverMeth} overload;
  491. function Replace(const AInputStr: RegExprString;
  492. AReplaceFunc: TRegExprReplaceFunction): RegExprString; overload;
  493. {$ENDIF}
  494. // Returns AInputStr with r.e. occurencies replaced by AReplaceStr.
  495. // If AUseSubstitution is true, then AReplaceStr will be used
  496. // as template for Substitution methods.
  497. // For example:
  498. // Expression := '({-i}block|var)\s*\(\s*([^ ]*)\s*\)\s*';
  499. // Replace ('BLOCK( test1)', 'def "$1" value "$2"', True);
  500. // will return: def 'BLOCK' value 'test1'
  501. // Replace ('BLOCK( test1)', 'def "$1" value "$2"')
  502. // will return: def "$1" value "$2"
  503. // Internally calls Exec, ExecNext.
  504. // Overloaded version and ReplaceEx operate with callback function,
  505. // so you can implement really complex functionality.
  506. function ReplaceEx(const AInputStr: RegExprString;
  507. AReplaceFunc: TRegExprReplaceFunction): RegExprString;
  508. {$IFDEF Compat}
  509. function ExecPos(AOffset: integer; ATryOnce: boolean): boolean; overload; deprecated 'Use modern form of ExecPos()';
  510. class function InvertCaseFunction(const Ch: REChar): REChar; deprecated 'This has no effect now';
  511. property InvertCase: TRegExprInvertCaseFunction read fInvertCase write fInvertCase; deprecated 'This has no effect now';
  512. property UseUnicodeWordDetection: boolean read fUseUnicodeWordDetection write fUseUnicodeWordDetection; deprecated 'This has no effect, use {$DEFINE Unicode} instead';
  513. property LinePairedSeparator: RegExprString read GetLinePairedSeparator write SetLinePairedSeparator; deprecated 'This has no effect now';
  514. property EmptyInputRaisesError: boolean read fEmptyInputRaisesError write fEmptyInputRaisesError; deprecated 'This has no effect now';
  515. property UseOsLineEndOnReplace: boolean read fUseOsLineEndOnReplace write SetUseOsLineEndOnReplace; deprecated 'Use property ReplaceLineEnd instead';
  516. {$ENDIF}
  517. // Returns ID of last error, 0 if no errors (unusable if
  518. // Error method raises exception) and clear internal status
  519. // into 0 (no errors).
  520. function LastError: integer;
  521. // Returns Error message for error with ID = AErrorID.
  522. function ErrorMsg(AErrorID: integer): RegExprString; virtual;
  523. // Re-compile regex
  524. procedure Compile;
  525. {$IFDEF RegExpPCodeDump}
  526. // Show compiled regex in textual form
  527. function Dump: RegExprString;
  528. // Show single opcode in textual form
  529. function DumpOp(op: TREOp): RegExprString;
  530. {$ENDIF}
  531. function IsCompiled: boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
  532. // Opcode contains only operations for fixed match length: EXACTLY*, ANY*, etc
  533. function IsFixedLength(var op: TREOp; var ALen: integer): boolean;
  534. // Regular expression.
  535. // For optimization, TRegExpr will automatically compiles it into 'P-code'
  536. // (You can see it with help of Dump method) and stores in internal
  537. // structures. Real [re]compilation occures only when it really needed -
  538. // while calling Exec, ExecNext, Substitute, Dump, etc
  539. // and only if Expression or other P-code affected properties was changed
  540. // after last [re]compilation.
  541. // If any errors while [re]compilation occures, Error method is called
  542. // (by default Error raises exception - see below)
  543. property Expression: RegExprString read fExpression write SetExpression;
  544. // Set/get default values of r.e.syntax modifiers. Modifiers in
  545. // r.e. (?ismx-ismx) will replace this default values.
  546. // If you try to set unsupported modifier, Error will be called
  547. // (by defaul Error raises exception ERegExpr).
  548. property ModifierStr: RegExprString read GetModifierStr write SetModifierStr;
  549. property ModifierI: boolean read GetModifierI write SetModifierI;
  550. property ModifierR: boolean read GetModifierR write SetModifierR;
  551. property ModifierS: boolean read GetModifierS write SetModifierS;
  552. property ModifierG: boolean read GetModifierG write SetModifierG;
  553. property ModifierM: boolean read GetModifierM write SetModifierM;
  554. property ModifierX: boolean read GetModifierX write SetModifierX;
  555. // returns current input string (from last Exec call or last assign
  556. // to this property).
  557. // Any assignment to this property clear Match* properties !
  558. property InputString: RegExprString read fInputString write SetInputString;
  559. // Number of subexpressions has been found in last Exec* call.
  560. // If there are no subexpr. but whole expr was found (Exec* returned True),
  561. // then SubExprMatchCount=0, if no subexpressions nor whole
  562. // r.e. found (Exec* returned false) then SubExprMatchCount=-1.
  563. // Note, that some subexpr. may be not found and for such
  564. // subexpr. MathPos=MatchLen=-1 and Match=''.
  565. // For example: Expression := '(1)?2(3)?';
  566. // Exec ('123'): SubExprMatchCount=2, Match[0]='123', [1]='1', [2]='3'
  567. // Exec ('12'): SubExprMatchCount=1, Match[0]='12', [1]='1'
  568. // Exec ('23'): SubExprMatchCount=2, Match[0]='23', [1]='', [2]='3'
  569. // Exec ('2'): SubExprMatchCount=0, Match[0]='2'
  570. // Exec ('7') - return False: SubExprMatchCount=-1
  571. property SubExprMatchCount: integer read GetSubExprCount;
  572. // pos of entrance subexpr. #Idx into tested in last Exec*
  573. // string. First subexpr. has Idx=1, last - MatchCount,
  574. // whole r.e. has Idx=0.
  575. // Returns -1 if in r.e. no such subexpr. or this subexpr.
  576. // not found in input string.
  577. property MatchPos[Idx: integer]: PtrInt read GetMatchPos;
  578. // len of entrance subexpr. #Idx r.e. into tested in last Exec*
  579. // string. First subexpr. has Idx=1, last - MatchCount,
  580. // whole r.e. has Idx=0.
  581. // Returns -1 if in r.e. no such subexpr. or this subexpr.
  582. // not found in input string.
  583. // Remember - MatchLen may be 0 (if r.e. match empty string) !
  584. property MatchLen[Idx: integer]: PtrInt read GetMatchLen;
  585. // == copy (InputString, MatchPos [Idx], MatchLen [Idx])
  586. // Returns '' if in r.e. no such subexpr. or this subexpr.
  587. // not found in input string.
  588. property Match[Idx: integer]: RegExprString read GetMatch;
  589. // get index of group (subexpression) by name, to support named groups
  590. // like in Python: (?P<name>regex)
  591. function MatchIndexFromName(const AName: RegExprString): integer;
  592. function MatchFromName(const AName: RegExprString): RegExprString;
  593. // Returns position in r.e. where compiler stopped.
  594. // Useful for error diagnostics
  595. property CompilerErrorPos: PtrInt read GetCompilerErrorPos;
  596. {$IFDEF UseSpaceChars}
  597. // Contains chars, treated as /s (initially filled with RegExprSpaceChars
  598. // global constant)
  599. property SpaceChars: RegExprString read fSpaceChars write fSpaceChars;
  600. // ###0.927
  601. {$ENDIF}
  602. {$IFDEF UseWordChars}
  603. // Contains chars, treated as /w (initially filled with RegExprWordChars
  604. // global constant)
  605. property WordChars: RegExprString read fWordChars write fWordChars;
  606. // ###0.929
  607. {$ENDIF}
  608. {$IFDEF UseLineSep}
  609. // line separators (like \n in Unix)
  610. property LineSeparators: RegExprString read fLineSeparators write SetLineSeparators; // ###0.941
  611. {$ENDIF}
  612. // support paired line-break CR LF
  613. property UseLinePairedBreak: boolean read fUsePairedBreak write SetUsePairedBreak;
  614. property ReplaceLineEnd: RegExprString read fReplaceLineEnd write fReplaceLineEnd;
  615. property SlowChecksSizeMax: integer read fSlowChecksSizeMax write fSlowChecksSizeMax;
  616. end;
  617. type
  618. ERegExpr = class(Exception)
  619. public
  620. ErrorCode: integer;
  621. CompilerErrorPos: PtrInt;
  622. end;
  623. // true if string AInputString match regular expression ARegExpr
  624. // ! will raise exeption if syntax errors in ARegExpr
  625. function ExecRegExpr(const ARegExpr, AInputStr: RegExprString): boolean;
  626. // Split AInputStr into APieces by r.e. ARegExpr occurencies
  627. procedure SplitRegExpr(const ARegExpr, AInputStr: RegExprString;
  628. APieces: TStrings);
  629. // Returns AInputStr with r.e. occurencies replaced by AReplaceStr
  630. // If AUseSubstitution is true, then AReplaceStr will be used
  631. // as template for Substitution methods.
  632. // For example:
  633. // ReplaceRegExpr ('({-i}block|var)\s*\(\s*([^ ]*)\s*\)\s*',
  634. // 'BLOCK( test1)', 'def "$1" value "$2"', True)
  635. // will return: def 'BLOCK' value 'test1'
  636. // ReplaceRegExpr ('({-i}block|var)\s*\(\s*([^ ]*)\s*\)\s*',
  637. // 'BLOCK( test1)', 'def "$1" value "$2"')
  638. // will return: def "$1" value "$2"
  639. function ReplaceRegExpr(const ARegExpr, AInputStr, AReplaceStr: RegExprString;
  640. AUseSubstitution: boolean{$IFDEF DefParam} = False{$ENDIF}): RegExprString;
  641. {$IFDEF OverMeth}overload; // ###0.947
  642. // Alternate form allowing to set more parameters.
  643. type
  644. TRegexReplaceOption = (
  645. rroModifierI,
  646. rroModifierR,
  647. rroModifierS,
  648. rroModifierG,
  649. rroModifierM,
  650. rroModifierX,
  651. rroUseSubstitution,
  652. rroUseOsLineEnd
  653. );
  654. TRegexReplaceOptions = set of TRegexReplaceOption;
  655. function ReplaceRegExpr(const ARegExpr, AInputStr, AReplaceStr: RegExprString;
  656. Options: TRegexReplaceOptions): RegExprString; overload;
  657. {$ENDIF}
  658. // Replace all metachars with its safe representation,
  659. // for example 'abc$cd.(' converts into 'abc\$cd\.\('
  660. // This function useful for r.e. autogeneration from
  661. // user input
  662. function QuoteRegExprMetaChars(const AStr: RegExprString): RegExprString;
  663. // Makes list of subexpressions found in ARegExpr r.e.
  664. // In ASubExps every item represent subexpression,
  665. // from first to last, in format:
  666. // String - subexpression text (without '()')
  667. // low word of Object - starting position in ARegExpr, including '('
  668. // if exists! (first position is 1)
  669. // high word of Object - length, including starting '(' and ending ')'
  670. // if exist!
  671. // AExtendedSyntax - must be True if modifier /m will be On while
  672. // using the r.e.
  673. // Useful for GUI editors of r.e. etc (You can find example of using
  674. // in TestRExp.dpr project)
  675. // Returns
  676. // 0 Success. No unbalanced brackets was found;
  677. // -1 There are not enough closing brackets ')';
  678. // -(n+1) At position n was found opening '[' without //###0.942
  679. // corresponding closing ']';
  680. // n At position n was found closing bracket ')' without
  681. // corresponding opening '('.
  682. // If Result <> 0, then ASubExpr can contain empty items or illegal ones
  683. function RegExprSubExpressions(const ARegExpr: string; ASubExprs: TStrings;
  684. AExtendedSyntax: boolean{$IFDEF DefParam} = False{$ENDIF}): integer;
  685. implementation
  686. {$IFDEF FastUnicodeData}
  687. uses
  688. regexpr_unicodedata;
  689. {$ENDIF}
  690. const
  691. // TRegExpr.VersionMajor/Minor return values of these constants:
  692. REVersionMajor = 1;
  693. REVersionMinor = 155;
  694. OpKind_End = REChar(1);
  695. OpKind_MetaClass = REChar(2);
  696. OpKind_Range = REChar(3);
  697. OpKind_Char = REChar(4);
  698. OpKind_CategoryYes = REChar(5);
  699. OpKind_CategoryNo = REChar(6);
  700. RegExprAllSet = [0 .. 255];
  701. RegExprWordSet = [Ord('a') .. Ord('z'), Ord('A') .. Ord('Z'), Ord('0') .. Ord('9'), Ord('_')];
  702. RegExprDigitSet = [Ord('0') .. Ord('9')];
  703. RegExprLowerAzSet = [Ord('a') .. Ord('z')];
  704. RegExprUpperAzSet = [Ord('A') .. Ord('Z')];
  705. RegExprAllAzSet = RegExprLowerAzSet + RegExprUpperAzSet;
  706. RegExprSpaceSet = [Ord(' '), $9, $A, $D, $C];
  707. RegExprLineSeparatorsSet = [$d, $a, $b, $c] {$IFDEF UniCode} + [$85] {$ENDIF};
  708. RegExprHorzSeparatorsSet = [9, $20, $A0];
  709. MaxBracesArg = $7FFFFFFF - 1; // max value for {n,m} arguments //###0.933
  710. type
  711. TRENextOff = PtrInt;
  712. // internal Next "pointer" (offset to current p-code) //###0.933
  713. PRENextOff = ^TRENextOff;
  714. // used for extracting Next "pointers" from compiled r.e. //###0.933
  715. TREBracesArg = integer; // type of {m,n} arguments
  716. PREBracesArg = ^TREBracesArg;
  717. TREGroupKind = (
  718. gkNormalGroup,
  719. gkNonCapturingGroup,
  720. gkNamedGroupReference,
  721. gkComment,
  722. gkModifierString,
  723. gkLookahead,
  724. gkLookaheadNeg,
  725. gkLookbehind,
  726. gkLookbehindNeg,
  727. gkRecursion,
  728. gkSubCall
  729. );
  730. // Alexey T.: handling of that define FPC_REQUIRES_PROPER_ALIGNMENT was present even 15 years ago,
  731. // but with it, we have failing of some RegEx tests, on ARM64 CPU.
  732. // If I undefine FPC_REQUIRES_PROPER_ALIGNMENT, all tests run OK on ARM64 again.
  733. {$undef FPC_REQUIRES_PROPER_ALIGNMENT}
  734. const
  735. REOpSz = SizeOf(TREOp) div SizeOf(REChar);
  736. // size of OP_ command in REChars
  737. {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
  738. // add space for aligning pointer
  739. // -1 is the correct max size but also needed for InsertOperator that needs a multiple of pointer size
  740. RENextOffSz = (2 * SizeOf(TRENextOff) div SizeOf(REChar)) - 1;
  741. REBracesArgSz = (2 * SizeOf(TREBracesArg) div SizeOf(REChar));
  742. // add space for aligning pointer
  743. {$ELSE}
  744. RENextOffSz = (SizeOf(TRENextOff) div SizeOf(REChar));
  745. // size of Next pointer in REChars
  746. REBracesArgSz = SizeOf(TREBracesArg) div SizeOf(REChar);
  747. // size of BRACES arguments in REChars
  748. {$ENDIF}
  749. RENumberSz = SizeOf(LongInt) div SizeOf(REChar);
  750. function IsPairedBreak(p: PRegExprChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
  751. const
  752. cBreak = {$IFDEF Unicode} $000D000A; {$ELSE} $0D0A; {$ENDIF}
  753. type
  754. PtrPair = {$IFDEF Unicode} ^LongInt; {$ELSE} ^Word; {$ENDIF}
  755. begin
  756. Result := PtrPair(p)^ = cBreak;
  757. end;
  758. function _FindCharInBuffer(SBegin, SEnd: PRegExprChar; Ch: REChar): PRegExprChar; {$IFDEF InlineFuncs}inline;{$ENDIF}
  759. begin
  760. while SBegin < SEnd do
  761. begin
  762. if SBegin^ = Ch then
  763. begin
  764. Result := SBegin;
  765. Exit;
  766. end;
  767. Inc(SBegin);
  768. end;
  769. Result := nil;
  770. end;
  771. function IsIgnoredChar(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
  772. begin
  773. case AChar of
  774. ' ', #9, #$d, #$a:
  775. Result := True
  776. else
  777. Result := False;
  778. end;
  779. end;
  780. function _IsMetaChar(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
  781. begin
  782. case AChar of
  783. 'd', 'D',
  784. 's', 'S',
  785. 'w', 'W',
  786. 'v', 'V',
  787. 'h', 'H':
  788. Result := True
  789. else
  790. Result := False;
  791. end;
  792. end;
  793. function AlignToPtr(const p: Pointer): Pointer; {$IFDEF InlineFuncs}inline;{$ENDIF}
  794. begin
  795. {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
  796. Result := Align(p, SizeOf(Pointer));
  797. {$ELSE}
  798. Result := p;
  799. {$ENDIF}
  800. end;
  801. function AlignToInt(const p: Pointer): Pointer; {$IFDEF InlineFuncs}inline;{$ENDIF}
  802. begin
  803. {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
  804. Result := Align(p, SizeOf(integer));
  805. {$ELSE}
  806. Result := p;
  807. {$ENDIF}
  808. end;
  809. {$IFDEF FastUnicodeData}
  810. function _UpperCase(Ch: REChar): REChar; inline;
  811. begin
  812. Result := CharUpperArray[Ord(Ch)];
  813. end;
  814. function _LowerCase(Ch: REChar): REChar; inline;
  815. begin
  816. Result := CharLowerArray[Ord(Ch)];
  817. end;
  818. {$ELSE}
  819. function _UpperCase(Ch: REChar): REChar;
  820. begin
  821. Result := Ch;
  822. if (Ch >= 'a') and (Ch <= 'z') then
  823. begin
  824. Dec(Result, 32);
  825. Exit;
  826. end;
  827. if Ord(Ch) < 128 then
  828. Exit;
  829. {$IFDEF FPC}
  830. {$IFDEF UniCode}
  831. Result := UnicodeUpperCase(Ch)[1];
  832. {$ELSE}
  833. Result := AnsiUpperCase(Ch)[1];
  834. {$ENDIF}
  835. {$ELSE}
  836. {$IFDEF UniCode}
  837. {$IFDEF D_XE4}
  838. Result := Ch.ToUpper;
  839. {$ELSE}
  840. {$IFDEF D2009}
  841. Result := TCharacter.ToUpper(Ch);
  842. {$ENDIF}
  843. {$ENDIF}
  844. {$ELSE}
  845. Result := AnsiUpperCase(Ch)[1];
  846. {$ENDIF}
  847. {$ENDIF}
  848. end;
  849. function _LowerCase(Ch: REChar): REChar;
  850. begin
  851. Result := Ch;
  852. if (Ch >= 'A') and (Ch <= 'Z') then
  853. begin
  854. Inc(Result, 32);
  855. Exit;
  856. end;
  857. if Ord(Ch) < 128 then
  858. Exit;
  859. {$IFDEF FPC}
  860. {$IFDEF UniCode}
  861. Result := UnicodeLowerCase(Ch)[1];
  862. {$ELSE}
  863. Result := AnsiLowerCase(Ch)[1];
  864. {$ENDIF}
  865. {$ELSE}
  866. {$IFDEF UniCode}
  867. {$IFDEF D_XE4}
  868. Result := Ch.ToLower;
  869. {$ELSE}
  870. {$IFDEF D2009}
  871. Result := TCharacter.ToLower(Ch);
  872. {$ENDIF}
  873. {$ENDIF}
  874. {$ELSE}
  875. Result := AnsiLowerCase(Ch)[1];
  876. {$ENDIF}
  877. {$ENDIF}
  878. end;
  879. {$ENDIF}
  880. function InvertCase(const Ch: REChar): REChar; {$IFDEF InlineFuncs}inline;{$ENDIF}
  881. begin
  882. Result := _UpperCase(Ch);
  883. if Result = Ch then
  884. Result := _LowerCase(Ch);
  885. end;
  886. function _FindClosingBracket(P, PEnd: PRegExprChar): PRegExprChar;
  887. var
  888. Level: integer;
  889. begin
  890. Result := nil;
  891. Level := 1;
  892. repeat
  893. if P >= PEnd then Exit;
  894. case P^ of
  895. EscChar:
  896. Inc(P);
  897. '(':
  898. begin
  899. Inc(Level);
  900. end;
  901. ')':
  902. begin
  903. Dec(Level);
  904. if Level = 0 then
  905. begin
  906. Result := P;
  907. Exit;
  908. end;
  909. end;
  910. end;
  911. Inc(P);
  912. until False;
  913. end;
  914. {$IFDEF UNICODEEX}
  915. procedure IncUnicode(var p: PRegExprChar); {$IFDEF InlineFuncs}inline;{$ENDIF}
  916. // make additional increment if we are on low-surrogate char
  917. // no need to check p<fInputEnd, at the end of string we have chr(0)
  918. var
  919. ch: REChar;
  920. begin
  921. Inc(p);
  922. ch := p^;
  923. if (Ord(ch) >= $DC00) and (Ord(ch) <= $DFFF) then
  924. Inc(p);
  925. end;
  926. procedure IncUnicode2(var p: PRegExprChar; var N: integer); {$IFDEF InlineFuncs}inline;{$ENDIF}
  927. var
  928. ch: REChar;
  929. begin
  930. Inc(p);
  931. Inc(N);
  932. ch := p^;
  933. if (Ord(ch) >= $DC00) and (Ord(ch) <= $DFFF) then
  934. begin
  935. Inc(p);
  936. Inc(N);
  937. end;
  938. end;
  939. {$ENDIF}
  940. { ============================================================= }
  941. { ===================== Global functions ====================== }
  942. { ============================================================= }
  943. function IsModifiersEqual(const A, B: TRegExprModifiers): boolean;
  944. begin
  945. Result :=
  946. (A.I = B.I) and
  947. (A.G = B.G) and
  948. (A.M = B.M) and
  949. (A.S = B.S) and
  950. (A.R = B.R) and
  951. (A.X = B.X);
  952. end;
  953. function ParseModifiers(const APtr: PRegExprChar;
  954. ALen: integer;
  955. var AValue: TRegExprModifiers): boolean;
  956. // Parse string and set AValue if it's in format 'ismxrg-ismxrg'
  957. var
  958. IsOn: boolean;
  959. i: integer;
  960. begin
  961. Result := True;
  962. IsOn := True;
  963. for i := 0 to ALen-1 do
  964. case APtr[i] of
  965. '-':
  966. IsOn := False;
  967. 'I', 'i':
  968. AValue.I := IsOn;
  969. 'R', 'r':
  970. AValue.R := IsOn;
  971. 'S', 's':
  972. AValue.S := IsOn;
  973. 'G', 'g':
  974. AValue.G := IsOn;
  975. 'M', 'm':
  976. AValue.M := IsOn;
  977. 'X', 'x':
  978. AValue.X := IsOn;
  979. else
  980. begin
  981. Result := False;
  982. Exit;
  983. end;
  984. end;
  985. end;
  986. function ExecRegExpr(const ARegExpr, AInputStr: RegExprString): boolean;
  987. var
  988. r: TRegExpr;
  989. begin
  990. r := TRegExpr.Create;
  991. try
  992. r.Expression := ARegExpr;
  993. Result := r.Exec(AInputStr);
  994. finally
  995. r.Free;
  996. end;
  997. end; { of function ExecRegExpr
  998. -------------------------------------------------------------- }
  999. procedure SplitRegExpr(const ARegExpr, AInputStr: RegExprString;
  1000. APieces: TStrings);
  1001. var
  1002. r: TRegExpr;
  1003. begin
  1004. APieces.Clear;
  1005. r := TRegExpr.Create;
  1006. try
  1007. r.Expression := ARegExpr;
  1008. r.Split(AInputStr, APieces);
  1009. finally
  1010. r.Free;
  1011. end;
  1012. end; { of procedure SplitRegExpr
  1013. -------------------------------------------------------------- }
  1014. function ReplaceRegExpr(const ARegExpr, AInputStr, AReplaceStr: RegExprString;
  1015. AUseSubstitution: boolean{$IFDEF DefParam} = False{$ENDIF}): RegExprString;
  1016. begin
  1017. with TRegExpr.Create do
  1018. try
  1019. Expression := ARegExpr;
  1020. Result := Replace(AInputStr, AReplaceStr, AUseSubstitution);
  1021. finally
  1022. Free;
  1023. end;
  1024. end; { of function ReplaceRegExpr
  1025. -------------------------------------------------------------- }
  1026. {$IFDEF OverMeth}
  1027. function ReplaceRegExpr(const ARegExpr, AInputStr, AReplaceStr: RegExprString;
  1028. Options: TRegexReplaceOptions): RegExprString; overload;
  1029. begin
  1030. with TRegExpr.Create do
  1031. try
  1032. ModifierI := (rroModifierI in Options);
  1033. ModifierR := (rroModifierR in Options);
  1034. ModifierS := (rroModifierS in Options);
  1035. ModifierG := (rroModifierG in Options);
  1036. ModifierM := (rroModifierM in Options);
  1037. ModifierX := (rroModifierX in Options);
  1038. // Set this after the above, if the regex contains modifiers, they will be applied.
  1039. Expression := ARegExpr;
  1040. if rroUseOsLineEnd in Options then
  1041. ReplaceLineEnd := sLineBreak
  1042. else
  1043. ReplaceLineEnd := #10;
  1044. Result := Replace(AInputStr, AReplaceStr, rroUseSubstitution in Options);
  1045. finally
  1046. Free;
  1047. end;
  1048. end;
  1049. {$ENDIF}
  1050. (*
  1051. const
  1052. MetaChars_Init = '^$.[()|?+*' + EscChar + '{';
  1053. MetaChars = MetaChars_Init; // not needed to be a variable, const is faster
  1054. MetaAll = MetaChars_Init + ']}'; // Very similar to MetaChars, but slighly changed.
  1055. *)
  1056. function _IsMetaSymbol1(ch: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
  1057. begin
  1058. case ch of
  1059. '^', '$', '.', '[', '(', ')', '|', '?', '+', '*', EscChar, '{':
  1060. Result := True
  1061. else
  1062. Result := False
  1063. end;
  1064. end;
  1065. function _IsMetaSymbol2(ch: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
  1066. begin
  1067. case ch of
  1068. '^', '$', '.', '[', '(', ')', '|', '?', '+', '*', EscChar, '{',
  1069. ']', '}':
  1070. Result := True
  1071. else
  1072. Result := False
  1073. end;
  1074. end;
  1075. function QuoteRegExprMetaChars(const AStr: RegExprString): RegExprString;
  1076. var
  1077. i, i0, Len: integer;
  1078. ch: REChar;
  1079. begin
  1080. Result := '';
  1081. Len := Length(AStr);
  1082. i := 1;
  1083. i0 := i;
  1084. while i <= Len do
  1085. begin
  1086. ch := AStr[i];
  1087. if _IsMetaSymbol2(ch) then
  1088. begin
  1089. Result := Result + System.Copy(AStr, i0, i - i0) + EscChar + ch;
  1090. i0 := i + 1;
  1091. end;
  1092. Inc(i);
  1093. end;
  1094. Result := Result + System.Copy(AStr, i0, MaxInt); // Tail
  1095. end; { of function QuoteRegExprMetaChars
  1096. -------------------------------------------------------------- }
  1097. function RegExprSubExpressions(const ARegExpr: string; ASubExprs: TStrings;
  1098. AExtendedSyntax: boolean{$IFDEF DefParam} = False{$ENDIF}): integer;
  1099. type
  1100. TStackItemRec = record // ###0.945
  1101. SubExprIdx: integer;
  1102. StartPos: PtrInt;
  1103. end;
  1104. TStackArray = packed array [0 .. RegexMaxMaxGroups - 1] of TStackItemRec;
  1105. var
  1106. Len, SubExprLen: integer;
  1107. i, i0: integer;
  1108. Modif: TRegExprModifiers;
  1109. Stack: ^TStackArray; // ###0.945
  1110. StackIdx, StackSz: integer;
  1111. begin
  1112. Result := 0; // no unbalanced brackets found at this very moment
  1113. FillChar(Modif, SizeOf(Modif), 0);
  1114. ASubExprs.Clear; // I don't think that adding to non empty list
  1115. // can be useful, so I simplified algorithm to work only with empty list
  1116. Len := Length(ARegExpr); // some optimization tricks
  1117. // first we have to calculate number of subexpression to reserve
  1118. // space in Stack array (may be we'll reserve more than needed, but
  1119. // it's faster then memory reallocation during parsing)
  1120. StackSz := 1; // add 1 for entire r.e.
  1121. for i := 1 to Len do
  1122. if ARegExpr[i] = '(' then
  1123. Inc(StackSz);
  1124. // SetLength (Stack, StackSz); //###0.945
  1125. GetMem(Stack, SizeOf(TStackItemRec) * StackSz);
  1126. try
  1127. StackIdx := 0;
  1128. i := 1;
  1129. while (i <= Len) do
  1130. begin
  1131. case ARegExpr[i] of
  1132. '(':
  1133. begin
  1134. if (i < Len) and (ARegExpr[i + 1] = '?') then
  1135. begin
  1136. // this is not subexpression, but comment or other
  1137. // Perl extension. We must check is it (?ismxrg-ismxrg)
  1138. // and change AExtendedSyntax if /x is changed.
  1139. Inc(i, 2); // skip '(?'
  1140. i0 := i;
  1141. while (i <= Len) and (ARegExpr[i] <> ')') do
  1142. Inc(i);
  1143. if i > Len then
  1144. Result := -1 // unbalansed '('
  1145. else
  1146. if ParseModifiers(@ARegExpr[i0], i - i0, Modif) then
  1147. // Alexey-T: original code had copy from i, not from i0
  1148. AExtendedSyntax := Modif.X;
  1149. end
  1150. else
  1151. begin // subexpression starts
  1152. ASubExprs.Add(''); // just reserve space
  1153. with Stack[StackIdx] do
  1154. begin
  1155. SubExprIdx := ASubExprs.Count - 1;
  1156. StartPos := i;
  1157. end;
  1158. Inc(StackIdx);
  1159. end;
  1160. end;
  1161. ')':
  1162. begin
  1163. if StackIdx = 0 then
  1164. Result := i // unbalanced ')'
  1165. else
  1166. begin
  1167. Dec(StackIdx);
  1168. with Stack[StackIdx] do
  1169. begin
  1170. SubExprLen := i - StartPos + 1;
  1171. ASubExprs.Objects[SubExprIdx] :=
  1172. TObject(StartPos or (SubExprLen ShL 16));
  1173. ASubExprs[SubExprIdx] := System.Copy(ARegExpr, StartPos + 1,
  1174. SubExprLen - 2); // add without brackets
  1175. end;
  1176. end;
  1177. end;
  1178. EscChar:
  1179. Inc(i); // skip quoted symbol
  1180. '[':
  1181. begin
  1182. // we have to skip character ranges at once, because they can
  1183. // contain '#', and '#' in it must NOT be recognized as eXtended
  1184. // comment beginning!
  1185. i0 := i;
  1186. Inc(i);
  1187. if ARegExpr[i] = ']' // first ']' inside [] treated as simple char, no need to check '['
  1188. then
  1189. Inc(i);
  1190. while (i <= Len) and (ARegExpr[i] <> ']') do
  1191. if ARegExpr[i] = EscChar // ###0.942
  1192. then
  1193. Inc(i, 2) // skip 'escaped' char to prevent stopping at '\]'
  1194. else
  1195. Inc(i);
  1196. if (i > Len) or (ARegExpr[i] <> ']') // ###0.942
  1197. then
  1198. Result := -(i0 + 1); // unbalansed '[' //###0.942
  1199. end;
  1200. '#':
  1201. if AExtendedSyntax then
  1202. begin
  1203. // skip eXtended comments
  1204. while (i <= Len) and (ARegExpr[i] <> #$d) and (ARegExpr[i] <> #$a)
  1205. // do not use [#$d, #$a] due to UniCode compatibility
  1206. do
  1207. Inc(i);
  1208. while (i + 1 <= Len) and
  1209. ((ARegExpr[i + 1] = #$d) or (ARegExpr[i + 1] = #$a)) do
  1210. Inc(i); // attempt to work with different kinds of line separators
  1211. // now we are at the line separator that must be skipped.
  1212. end;
  1213. // here is no 'else' clause - we simply skip ordinary chars
  1214. end; // of case
  1215. Inc(i); // skip scanned char
  1216. // ! can move after Len due to skipping quoted symbol
  1217. end;
  1218. // check brackets balance
  1219. if StackIdx <> 0 then
  1220. Result := -1; // unbalansed '('
  1221. // check if entire r.e. added
  1222. if (ASubExprs.Count = 0) or ((PtrInt(ASubExprs.Objects[0]) and $FFFF) <> 1)
  1223. or (((PtrInt(ASubExprs.Objects[0]) ShR 16) and $FFFF) <> Len)
  1224. // whole r.e. wasn't added because it isn't bracketed
  1225. // well, we add it now:
  1226. then
  1227. ASubExprs.InsertObject(0, ARegExpr, TObject((Len ShL 16) or 1));
  1228. finally
  1229. FreeMem(Stack);
  1230. end;
  1231. end; { of function RegExprSubExpressions
  1232. -------------------------------------------------------------- }
  1233. const
  1234. OP_MAGIC = TREOp(216); // programm signature
  1235. // name opcode opnd? meaning
  1236. OP_EEND = TREOp(0); // - End of program
  1237. OP_BOL = TREOp(1); // - Match "" at beginning of line
  1238. OP_EOL = TREOp(2); // - Match "" at end of line
  1239. OP_ANY = TREOp(3); // - Match any one character
  1240. OP_ANYOF = TREOp(4); // Str Match any character in string Str
  1241. OP_ANYBUT = TREOp(5); // Str Match any char. not in string Str
  1242. OP_BRANCH = TREOp(6); // Node Match this alternative, or the next
  1243. OP_BACK = TREOp(7); // - Jump backward (Next < 0)
  1244. OP_EXACTLY = TREOp(8); // Str Match string Str
  1245. OP_NOTHING = TREOp(9); // - Match empty string
  1246. OP_STAR = TREOp(10); // Node Match this (simple) thing 0 or more times
  1247. OP_PLUS = TREOp(11); // Node Match this (simple) thing 1 or more times
  1248. OP_ANYDIGIT = TREOp(12); // - Match any digit (equiv [0-9])
  1249. OP_NOTDIGIT = TREOp(13); // - Match not digit (equiv [0-9])
  1250. OP_ANYLETTER = TREOp(14); // - Match any letter from property WordChars
  1251. OP_NOTLETTER = TREOp(15); // - Match not letter from property WordChars
  1252. OP_ANYSPACE = TREOp(16); // - Match any space char (see property SpaceChars)
  1253. OP_NOTSPACE = TREOp(17); // - Match not space char (see property SpaceChars)
  1254. OP_BRACES = TREOp(18);
  1255. // Node,Min,Max Match this (simple) thing from Min to Max times.
  1256. // Min and Max are TREBracesArg
  1257. OP_COMMENT = TREOp(19); // - Comment ;)
  1258. OP_EXACTLYCI = TREOp(20); // Str Match string Str case insensitive
  1259. OP_ANYOFCI = TREOp(21);
  1260. // Str Match any character in string Str, case insensitive
  1261. OP_ANYBUTCI = TREOp(22);
  1262. // Str Match any char. not in string Str, case insensitive
  1263. OP_LOOPENTRY = TREOp(23); // Node Start of loop (Node - LOOP for this loop)
  1264. OP_LOOP = TREOp(24); // Node,Min,Max,LoopEntryJmp - back jump for LOOPENTRY.
  1265. // Min and Max are TREBracesArg
  1266. // Node - next node in sequence,
  1267. // LoopEntryJmp - associated LOOPENTRY node addr
  1268. OP_EOL2 = TReOp(25); // like OP_EOL but also matches before final line-break
  1269. OP_BSUBEXP = TREOp(28);
  1270. // Idx Match previously matched subexpression #Idx (stored as REChar) //###0.936
  1271. OP_BSUBEXPCI = TREOp(29); // Idx -"- in case-insensitive mode
  1272. // Non-Greedy Style Ops //###0.940
  1273. OP_STARNG = TREOp(30); // Same as OP_START but in non-greedy mode
  1274. OP_PLUSNG = TREOp(31); // Same as OP_PLUS but in non-greedy mode
  1275. OP_BRACESNG = TREOp(32); // Same as OP_BRACES but in non-greedy mode
  1276. OP_LOOPNG = TREOp(33); // Same as OP_LOOP but in non-greedy mode
  1277. // Multiline mode \m
  1278. OP_BOLML = TREOp(34); // - Match "" at beginning of line
  1279. OP_EOLML = TREOp(35); // - Match "" at end of line
  1280. OP_ANYML = TREOp(36); // - Match any one character
  1281. // Word boundary
  1282. OP_BOUND = TREOp(37); // Match "" between words //###0.943
  1283. OP_NOTBOUND = TREOp(38); // Match "" not between words //###0.943
  1284. OP_ANYHORZSEP = TREOp(39); // Any horizontal whitespace \h
  1285. OP_NOTHORZSEP = TREOp(40); // Not horizontal whitespace \H
  1286. OP_ANYVERTSEP = TREOp(41); // Any vertical whitespace \v
  1287. OP_NOTVERTSEP = TREOp(42); // Not vertical whitespace \V
  1288. OP_ANYCATEGORY = TREOp(43); // \p{L}
  1289. OP_NOTCATEGORY = TREOp(44); // \P{L}
  1290. OP_STAR_POSS = TReOp(45);
  1291. OP_PLUS_POSS = TReOp(46);
  1292. OP_BRACES_POSS = TReOp(47);
  1293. OP_RECUR = TReOp(48);
  1294. // !!! Change OP_OPEN value if you add new opcodes !!!
  1295. OP_OPEN = TREOp(50); // Opening of group; OP_OPEN+i is for group i
  1296. OP_OPEN_FIRST = Succ(OP_OPEN);
  1297. OP_OPEN_LAST = TREOp(Ord(OP_OPEN) + RegexMaxGroups - 1);
  1298. OP_CLOSE = Succ(OP_OPEN_LAST); // Closing of group; OP_CLOSE+i is for group i
  1299. OP_CLOSE_FIRST = Succ(OP_CLOSE);
  1300. OP_CLOSE_LAST = TReOp(Ord(OP_CLOSE) + RegexMaxGroups - 1);
  1301. OP_SUBCALL = Succ(OP_CLOSE_LAST); // Call of subroutine; OP_SUBCALL+i is for group i
  1302. OP_SUBCALL_FIRST = Succ(OP_SUBCALL);
  1303. OP_SUBCALL_LAST =
  1304. {$IFDEF Unicode}
  1305. TReOp(Ord(OP_SUBCALL) + RegexMaxGroups - 1);
  1306. {$ELSE}
  1307. High(REChar); // must fit to 0..255 range
  1308. {$ENDIF}
  1309. // We work with p-code through pointers, compatible with PRegExprChar.
  1310. // Note: all code components (TRENextOff, TREOp, TREBracesArg, etc)
  1311. // must have lengths that can be divided by SizeOf (REChar) !
  1312. // A node is TREOp of opcode followed Next "pointer" of TRENextOff type.
  1313. // The Next is a offset from the opcode of the node containing it.
  1314. // An operand, if any, simply follows the node. (Note that much of
  1315. // the code generation knows about this implicit relationship!)
  1316. // Using TRENextOff=PtrInt speed up p-code processing.
  1317. // Opcodes description:
  1318. //
  1319. // BRANCH The set of branches constituting a single choice are hooked
  1320. // together with their "next" pointers, since precedence prevents
  1321. // anything being concatenated to any individual branch. The
  1322. // "next" pointer of the last BRANCH in a choice points to the
  1323. // thing following the whole choice. This is also where the
  1324. // final "next" pointer of each individual branch points; each
  1325. // branch starts with the operand node of a BRANCH node.
  1326. // BACK Normal "next" pointers all implicitly point forward; BACK
  1327. // exists to make loop structures possible.
  1328. // STAR,PLUS,BRACES '?', and complex '*' and '+', are implemented as
  1329. // circular BRANCH structures using BACK. Complex '{min,max}'
  1330. // - as pair LOOPENTRY-LOOP (see below). Simple cases (one
  1331. // character per match) are implemented with STAR, PLUS and
  1332. // BRACES for speed and to minimize recursive plunges.
  1333. // LOOPENTRY,LOOP {min,max} are implemented as special pair
  1334. // LOOPENTRY-LOOP. Each LOOPENTRY initialize loopstack for
  1335. // current level.
  1336. // OPEN,CLOSE are numbered at compile time.
  1337. { ============================================================= }
  1338. { ================== Error handling section =================== }
  1339. { ============================================================= }
  1340. const
  1341. reeOk = 0;
  1342. reeCompNullArgument = 100;
  1343. reeUnknownMetaSymbol = 101;
  1344. reeCompParseRegTooManyBrackets = 102;
  1345. reeCompParseRegUnmatchedBrackets = 103;
  1346. reeCompParseRegUnmatchedBrackets2 = 104;
  1347. reeCompParseRegJunkOnEnd = 105;
  1348. reePlusStarOperandCouldBeEmpty = 106;
  1349. reeNestedQuantif = 107;
  1350. reeBadHexDigit = 108;
  1351. reeInvalidRange = 109;
  1352. reeParseAtomTrailingBackSlash = 110;
  1353. reeNoHexCodeAfterBSlashX = 111;
  1354. reeHexCodeAfterBSlashXTooBig = 112;
  1355. reeUnmatchedSqBrackets = 113;
  1356. reeInternalUrp = 114;
  1357. reeQuantifFollowsNothing = 115;
  1358. reeTrailingBackSlash = 116;
  1359. reeNoLetterAfterBSlashC = 117;
  1360. reeMetaCharAfterMinusInRange = 118;
  1361. reeRarseAtomInternalDisaster = 119;
  1362. reeIncorrectSpecialBrackets = 120;
  1363. reeIncorrectBraces = 121;
  1364. reeBRACESArgTooBig = 122;
  1365. reeUnknownOpcodeInFillFirst = 123;
  1366. reeBracesMinParamGreaterMax = 124;
  1367. reeUnclosedComment = 125;
  1368. reeComplexBracesNotImplemented = 126;
  1369. reeUnrecognizedModifier = 127;
  1370. reeBadLinePairedSeparator = 128;
  1371. reeBadUnicodeCategory = 129;
  1372. reeTooSmallCheckersArray = 130;
  1373. reePossessiveAfterComplexBraces = 131;
  1374. reeBadRecursion = 132;
  1375. reeBadSubCall = 133;
  1376. reeNamedGroupBad = 140;
  1377. reeNamedGroupBadName = 141;
  1378. reeNamedGroupBadRef = 142;
  1379. reeNamedGroupDupName = 143;
  1380. reeLookaheadBad = 150;
  1381. reeLookbehindBad = 152;
  1382. reeLookbehindTooComplex = 153;
  1383. reeLookaroundNotAtEdge = 154;
  1384. // Runtime errors must be >= reeFirstRuntimeCode
  1385. reeFirstRuntimeCode = 1000;
  1386. reeRegRepeatCalledInappropriately = 1000;
  1387. reeMatchPrimMemoryCorruption = 1001;
  1388. reeMatchPrimCorruptedPointers = 1002;
  1389. reeNoExpression = 1003;
  1390. reeCorruptedProgram = 1004;
  1391. reeOffsetMustBePositive = 1006;
  1392. reeExecNextWithoutExec = 1007;
  1393. reeBadOpcodeInCharClass = 1008;
  1394. reeDumpCorruptedOpcode = 1011;
  1395. reeModifierUnsupported = 1013;
  1396. reeLoopStackExceeded = 1014;
  1397. reeLoopWithoutEntry = 1015;
  1398. function TRegExpr.ErrorMsg(AErrorID: integer): RegExprString;
  1399. begin
  1400. case AErrorID of
  1401. reeOk:
  1402. Result := 'No errors';
  1403. reeCompNullArgument:
  1404. Result := 'TRegExpr compile: null argument';
  1405. reeUnknownMetaSymbol:
  1406. Result := 'TRegExpr compile: unknown meta-character: \' + fLastErrorSymbol;
  1407. reeCompParseRegTooManyBrackets:
  1408. Result := 'TRegExpr compile: ParseReg: too many ()';
  1409. reeCompParseRegUnmatchedBrackets:
  1410. Result := 'TRegExpr compile: ParseReg: unmatched ()';
  1411. reeCompParseRegUnmatchedBrackets2:
  1412. Result := 'TRegExpr compile: ParseReg: unmatched ()';
  1413. reeCompParseRegJunkOnEnd:
  1414. Result := 'TRegExpr compile: ParseReg: junk at end';
  1415. reePlusStarOperandCouldBeEmpty:
  1416. Result := 'TRegExpr compile: *+ operand could be empty';
  1417. reeNestedQuantif:
  1418. Result := 'TRegExpr compile: nested quantifier *?+';
  1419. reeBadHexDigit:
  1420. Result := 'TRegExpr compile: bad hex digit';
  1421. reeInvalidRange:
  1422. Result := 'TRegExpr compile: invalid [] range';
  1423. reeParseAtomTrailingBackSlash:
  1424. Result := 'TRegExpr compile: parse atom trailing \';
  1425. reeNoHexCodeAfterBSlashX:
  1426. Result := 'TRegExpr compile: no hex code after \x';
  1427. reeNoLetterAfterBSlashC:
  1428. Result := 'TRegExpr compile: no letter "A".."Z" after \c';
  1429. reeMetaCharAfterMinusInRange:
  1430. Result := 'TRegExpr compile: metachar after "-" in [] range';
  1431. reeHexCodeAfterBSlashXTooBig:
  1432. Result := 'TRegExpr compile: hex code after \x is too big';
  1433. reeUnmatchedSqBrackets:
  1434. Result := 'TRegExpr compile: unmatched []';
  1435. reeInternalUrp:
  1436. Result := 'TRegExpr compile: internal fail on char "|", ")"';
  1437. reeQuantifFollowsNothing:
  1438. Result := 'TRegExpr compile: quantifier ?+*{ follows nothing';
  1439. reeTrailingBackSlash:
  1440. Result := 'TRegExpr compile: trailing \';
  1441. reeRarseAtomInternalDisaster:
  1442. Result := 'TRegExpr compile: RarseAtom internal disaster';
  1443. reeIncorrectSpecialBrackets:
  1444. Result := 'TRegExpr compile: incorrect expression in (?...) brackets';
  1445. reeIncorrectBraces:
  1446. Result := 'TRegExpr compile: incorrect {} braces';
  1447. reeBRACESArgTooBig:
  1448. Result := 'TRegExpr compile: braces {} argument too big';
  1449. reeUnknownOpcodeInFillFirst:
  1450. Result := 'TRegExpr compile: unknown opcode in FillFirstCharSet ('+DumpOp(fLastErrorOpcode)+')';
  1451. reeBracesMinParamGreaterMax:
  1452. Result := 'TRegExpr compile: braces {} min param greater then max';
  1453. reeUnclosedComment:
  1454. Result := 'TRegExpr compile: unclosed (?#comment)';
  1455. reeComplexBracesNotImplemented:
  1456. Result := 'TRegExpr compile: if you use braces {} and non-greedy ops *?, +?, ?? for complex cases, enable {$DEFINE ComplexBraces}';
  1457. reeUnrecognizedModifier:
  1458. Result := 'TRegExpr compile: incorrect modifier in (?...)';
  1459. reeBadLinePairedSeparator:
  1460. Result := 'TRegExpr compile: LinePairedSeparator must countain two different chars or be empty';
  1461. reeBadUnicodeCategory:
  1462. Result := 'TRegExpr compile: invalid category after \p or \P';
  1463. reeTooSmallCheckersArray:
  1464. Result := 'TRegExpr compile: too small CharCheckers array';
  1465. reePossessiveAfterComplexBraces:
  1466. Result := 'TRegExpr compile: possessive + after complex braces: (foo){n,m}+';
  1467. reeBadRecursion:
  1468. Result := 'TRegExpr compile: bad recursion (?R)';
  1469. reeBadSubCall:
  1470. Result := 'TRegExpr compile: bad subroutine call';
  1471. reeNamedGroupBad:
  1472. Result := 'TRegExpr compile: bad named group';
  1473. reeNamedGroupBadName:
  1474. Result := 'TRegExpr compile: bad identifier in named group';
  1475. reeNamedGroupBadRef:
  1476. Result := 'TRegExpr compile: bad back-reference to named group';
  1477. reeNamedGroupDupName:
  1478. Result := 'TRegExpr compile: named group defined more than once';
  1479. reeLookaheadBad:
  1480. Result := 'TRegExpr compile: bad lookahead';
  1481. reeLookbehindBad:
  1482. Result := 'TRegExpr compile: bad lookbehind';
  1483. reeLookbehindTooComplex:
  1484. Result := 'TRegExpr compile: lookbehind (?<!foo) must have fixed length';
  1485. reeLookaroundNotAtEdge:
  1486. Result := 'TRegExpr compile: lookaround brackets must be at the very beginning/ending';
  1487. reeRegRepeatCalledInappropriately:
  1488. Result := 'TRegExpr exec: RegRepeat called inappropriately';
  1489. reeMatchPrimMemoryCorruption:
  1490. Result := 'TRegExpr exec: MatchPrim memory corruption';
  1491. reeMatchPrimCorruptedPointers:
  1492. Result := 'TRegExpr exec: MatchPrim corrupted pointers';
  1493. reeNoExpression:
  1494. Result := 'TRegExpr exec: empty expression';
  1495. reeCorruptedProgram:
  1496. Result := 'TRegExpr exec: corrupted opcode (no magic byte)';
  1497. reeOffsetMustBePositive:
  1498. Result := 'TRegExpr exec: offset must be >0';
  1499. reeExecNextWithoutExec:
  1500. Result := 'TRegExpr exec: ExecNext without Exec(Pos)';
  1501. reeBadOpcodeInCharClass:
  1502. Result := 'TRegExpr exec: invalid opcode in char class';
  1503. reeDumpCorruptedOpcode:
  1504. Result := 'TRegExpr dump: corrupted opcode';
  1505. reeLoopStackExceeded:
  1506. Result := 'TRegExpr exec: loop stack exceeded';
  1507. reeLoopWithoutEntry:
  1508. Result := 'TRegExpr exec: loop without loop entry';
  1509. else
  1510. Result := 'Unknown error';
  1511. end;
  1512. end; { of procedure TRegExpr.Error
  1513. -------------------------------------------------------------- }
  1514. function TRegExpr.LastError: integer;
  1515. begin
  1516. Result := fLastError;
  1517. fLastError := reeOk;
  1518. end; { of function TRegExpr.LastError
  1519. -------------------------------------------------------------- }
  1520. { ============================================================= }
  1521. { ===================== Common section ======================== }
  1522. { ============================================================= }
  1523. class function TRegExpr.VersionMajor: integer;
  1524. begin
  1525. Result := REVersionMajor;
  1526. end;
  1527. class function TRegExpr.VersionMinor: integer;
  1528. begin
  1529. Result := REVersionMinor;
  1530. end;
  1531. constructor TRegExpr.Create;
  1532. begin
  1533. inherited;
  1534. programm := nil;
  1535. fExpression := '';
  1536. fInputString := '';
  1537. FillChar(fModifiers, SizeOf(fModifiers), 0);
  1538. fModifiers.I := RegExprModifierI;
  1539. fModifiers.R := RegExprModifierR;
  1540. fModifiers.S := RegExprModifierS;
  1541. fModifiers.G := RegExprModifierG;
  1542. fModifiers.M := RegExprModifierM;
  1543. fModifiers.X := RegExprModifierX;
  1544. {$IFDEF UseSpaceChars}
  1545. SpaceChars := RegExprSpaceChars;
  1546. {$ENDIF}
  1547. {$IFDEF UseWordChars}
  1548. WordChars := RegExprWordChars;
  1549. {$ENDIF}
  1550. {$IFDEF UseLineSep}
  1551. fLineSeparators := RegExprLineSeparators;
  1552. {$ENDIF}
  1553. fUsePairedBreak := RegExprUsePairedBreak;
  1554. fReplaceLineEnd := RegExprReplaceLineBreak;
  1555. fSlowChecksSizeMax := 2000;
  1556. {$IFDEF UseLineSep}
  1557. InitLineSepArray;
  1558. {$ENDIF}
  1559. InitCharCheckers;
  1560. {$IFDEF Compat}
  1561. fInvertCase := OldInvertCase;
  1562. {$ENDIF}
  1563. end; { of constructor TRegExpr.Create
  1564. -------------------------------------------------------------- }
  1565. {$IFDEF OverMeth}
  1566. constructor TRegExpr.Create(const AExpression: RegExprString);
  1567. begin
  1568. Create;
  1569. Expression := AExpression;
  1570. end;
  1571. {$ENDIF}
  1572. destructor TRegExpr.Destroy;
  1573. begin
  1574. if programm <> nil then
  1575. begin
  1576. FreeMem(programm);
  1577. programm := nil;
  1578. end;
  1579. if Assigned(fHelper) then
  1580. FreeAndNil(fHelper);
  1581. end;
  1582. procedure TRegExpr.SetExpression(const AStr: RegExprString);
  1583. begin
  1584. if (AStr <> fExpression) or not IsCompiled then
  1585. begin
  1586. fExpression := AStr;
  1587. UniqueString(fExpression);
  1588. fRegexStart := PRegExprChar(fExpression);
  1589. fRegexEnd := fRegexStart + Length(fExpression);
  1590. InvalidateProgramm;
  1591. end;
  1592. end; { of procedure TRegExpr.SetExpression
  1593. -------------------------------------------------------------- }
  1594. function TRegExpr.GetSubExprCount: integer;
  1595. begin
  1596. // if nothing found, we must return -1 per TRegExpr docs
  1597. if GrpStart[0] = nil then
  1598. Result := -1
  1599. else
  1600. Result := GrpCount;
  1601. end;
  1602. function TRegExpr.GetMatchPos(Idx: integer): PtrInt;
  1603. begin
  1604. Idx := GrpIndexes[Idx];
  1605. if (Idx >= 0) and (GrpStart[Idx] <> nil) then
  1606. Result := GrpStart[Idx] - fInputStart + 1
  1607. else
  1608. Result := -1;
  1609. end; { of function TRegExpr.GetMatchPos
  1610. -------------------------------------------------------------- }
  1611. function TRegExpr.GetMatchLen(Idx: integer): PtrInt;
  1612. begin
  1613. Idx := GrpIndexes[Idx];
  1614. if (Idx >= 0) and (GrpStart[Idx] <> nil) then
  1615. Result := GrpEnd[Idx] - GrpStart[Idx]
  1616. else
  1617. Result := -1;
  1618. end; { of function TRegExpr.GetMatchLen
  1619. -------------------------------------------------------------- }
  1620. function TRegExpr.GetMatch(Idx: integer): RegExprString;
  1621. begin
  1622. Result := '';
  1623. Idx := GrpIndexes[Idx];
  1624. if (Idx >= 0) and (GrpEnd[Idx] > GrpStart[Idx]) then
  1625. SetString(Result, GrpStart[Idx], GrpEnd[Idx] - GrpStart[Idx]);
  1626. end; { of function TRegExpr.GetMatch
  1627. -------------------------------------------------------------- }
  1628. function TRegExpr.MatchIndexFromName(const AName: RegExprString): integer;
  1629. var
  1630. i: integer;
  1631. begin
  1632. for i := 1 {not 0} to GrpCount do
  1633. if GrpNames[i] = AName then
  1634. begin
  1635. Result := i;
  1636. Exit;
  1637. end;
  1638. Result := -1;
  1639. end;
  1640. function TRegExpr.MatchFromName(const AName: RegExprString): RegExprString;
  1641. var
  1642. Idx: integer;
  1643. begin
  1644. Idx := MatchIndexFromName(AName);
  1645. if Idx >= 0 then
  1646. Result := GetMatch(Idx)
  1647. else
  1648. Result := '';
  1649. end;
  1650. function TRegExpr.GetModifierStr: RegExprString;
  1651. begin
  1652. Result := '-';
  1653. if ModifierI then
  1654. Result := 'i' + Result
  1655. else
  1656. Result := Result + 'i';
  1657. if ModifierR then
  1658. Result := 'r' + Result
  1659. else
  1660. Result := Result + 'r';
  1661. if ModifierS then
  1662. Result := 's' + Result
  1663. else
  1664. Result := Result + 's';
  1665. if ModifierG then
  1666. Result := 'g' + Result
  1667. else
  1668. Result := Result + 'g';
  1669. if ModifierM then
  1670. Result := 'm' + Result
  1671. else
  1672. Result := Result + 'm';
  1673. if ModifierX then
  1674. Result := 'x' + Result
  1675. else
  1676. Result := Result + 'x';
  1677. if Result[Length(Result)] = '-' // remove '-' if all modifiers are 'On'
  1678. then
  1679. System.Delete(Result, Length(Result), 1);
  1680. end; { of function TRegExpr.GetModifierStr
  1681. -------------------------------------------------------------- }
  1682. procedure TRegExpr.SetModifierG(AValue: boolean);
  1683. begin
  1684. if fModifiers.G <> AValue then
  1685. begin
  1686. fModifiers.G := AValue;
  1687. InvalidateProgramm;
  1688. end;
  1689. end;
  1690. procedure TRegExpr.SetModifierI(AValue: boolean);
  1691. begin
  1692. if fModifiers.I <> AValue then
  1693. begin
  1694. fModifiers.I := AValue;
  1695. InvalidateProgramm;
  1696. end;
  1697. end;
  1698. procedure TRegExpr.SetModifierM(AValue: boolean);
  1699. begin
  1700. if fModifiers.M <> AValue then
  1701. begin
  1702. fModifiers.M := AValue;
  1703. InvalidateProgramm;
  1704. end;
  1705. end;
  1706. procedure TRegExpr.SetModifierR(AValue: boolean);
  1707. begin
  1708. if fModifiers.R <> AValue then
  1709. begin
  1710. fModifiers.R := AValue;
  1711. InvalidateProgramm;
  1712. end;
  1713. end;
  1714. procedure TRegExpr.SetModifierS(AValue: boolean);
  1715. begin
  1716. if fModifiers.S <> AValue then
  1717. begin
  1718. fModifiers.S := AValue;
  1719. InvalidateProgramm;
  1720. end;
  1721. end;
  1722. procedure TRegExpr.SetModifierX(AValue: boolean);
  1723. begin
  1724. if fModifiers.X <> AValue then
  1725. begin
  1726. fModifiers.X := AValue;
  1727. InvalidateProgramm;
  1728. end;
  1729. end;
  1730. procedure TRegExpr.SetModifierStr(const AStr: RegExprString);
  1731. begin
  1732. if ParseModifiers(PRegExprChar(AStr), Length(AStr), fModifiers) then
  1733. InvalidateProgramm
  1734. else
  1735. Error(reeModifierUnsupported);
  1736. end;
  1737. { ============================================================= }
  1738. { ==================== Compiler section ======================= }
  1739. { ============================================================= }
  1740. {$IFDEF FastUnicodeData}
  1741. function TRegExpr.IsWordChar(AChar: REChar): boolean;
  1742. begin
  1743. // bit 7 in value: is word char
  1744. Result := CharCategoryArray[Ord(AChar)] and 128 <> 0;
  1745. end;
  1746. (*
  1747. // Unicode General Category
  1748. UGC_UppercaseLetter = 0; Lu
  1749. UGC_LowercaseLetter = 1; Ll
  1750. UGC_TitlecaseLetter = 2; Lt
  1751. UGC_ModifierLetter = 3; Lm
  1752. UGC_OtherLetter = 4; Lo
  1753. UGC_NonSpacingMark = 5; Mn
  1754. UGC_CombiningMark = 6; Mc
  1755. UGC_EnclosingMark = 7; Me
  1756. UGC_DecimalNumber = 8; Nd
  1757. UGC_LetterNumber = 9; Nl
  1758. UGC_OtherNumber = 10; No
  1759. UGC_ConnectPunctuation = 11; Pc
  1760. UGC_DashPunctuation = 12; Pd
  1761. UGC_OpenPunctuation = 13; Ps
  1762. UGC_ClosePunctuation = 14; Pe
  1763. UGC_InitialPunctuation = 15; Pi
  1764. UGC_FinalPunctuation = 16; Pf
  1765. UGC_OtherPunctuation = 17; Po
  1766. UGC_MathSymbol = 18; Sm
  1767. UGC_CurrencySymbol = 19; Sc
  1768. UGC_ModifierSymbol = 20; Sk
  1769. UGC_OtherSymbol = 21; So
  1770. UGC_SpaceSeparator = 22; Zs
  1771. UGC_LineSeparator = 23; Zl
  1772. UGC_ParagraphSeparator = 24; Zp
  1773. UGC_Control = 25; Cc
  1774. UGC_Format = 26; Cf
  1775. UGC_Surrogate = 27; Cs
  1776. UGC_PrivateUse = 28; Co
  1777. UGC_Unassigned = 29; Cn
  1778. *)
  1779. const
  1780. CategoryNames: array[0..29] of array[0..1] of REChar = (
  1781. ('L', 'u'),
  1782. ('L', 'l'),
  1783. ('L', 't'),
  1784. ('L', 'm'),
  1785. ('L', 'o'),
  1786. ('M', 'n'),
  1787. ('M', 'c'),
  1788. ('M', 'e'),
  1789. ('N', 'd'),
  1790. ('N', 'l'),
  1791. ('N', 'o'),
  1792. ('P', 'c'),
  1793. ('P', 'd'),
  1794. ('P', 's'),
  1795. ('P', 'e'),
  1796. ('P', 'i'),
  1797. ('P', 'f'),
  1798. ('P', 'o'),
  1799. ('S', 'm'),
  1800. ('S', 'c'),
  1801. ('S', 'k'),
  1802. ('S', 'o'),
  1803. ('Z', 's'),
  1804. ('Z', 'l'),
  1805. ('Z', 'p'),
  1806. ('C', 'c'),
  1807. ('C', 'f'),
  1808. ('C', 's'),
  1809. ('C', 'o'),
  1810. ('C', 'n')
  1811. );
  1812. function IsCategoryFirstChar(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
  1813. begin
  1814. case AChar of
  1815. 'L', 'M', 'N', 'P', 'S', 'C', 'Z':
  1816. Result := True;
  1817. else
  1818. Result := False;
  1819. end;
  1820. end;
  1821. function IsCategoryChars(AChar, AChar2: REChar): boolean;
  1822. var
  1823. i: integer;
  1824. begin
  1825. for i := Low(CategoryNames) to High(CategoryNames) do
  1826. if (AChar = CategoryNames[i][0]) then
  1827. if (AChar2 = CategoryNames[i][1]) then
  1828. begin
  1829. Result := True;
  1830. Exit
  1831. end;
  1832. Result := False;
  1833. end;
  1834. function CheckCharCategory(AChar: REChar; Ch0, Ch1: REChar): boolean;
  1835. // AChar: check this char against opcode
  1836. // Ch0, Ch1: opcode operands after OP_*CATEGORY
  1837. var
  1838. N: byte;
  1839. Name0, Name1: REChar;
  1840. begin
  1841. Result := False;
  1842. // bits 0..6 are category
  1843. N := CharCategoryArray[Ord(AChar)] and 127;
  1844. if N <= High(CategoryNames) then
  1845. begin
  1846. Name0 := CategoryNames[N][0];
  1847. Name1 := CategoryNames[N][1];
  1848. if Ch0 <> Name0 then Exit;
  1849. if Ch1 <> #0 then
  1850. if Ch1 <> Name1 then Exit;
  1851. Result := True;
  1852. end;
  1853. end;
  1854. function MatchOneCharCategory(opnd, scan: PRegExprChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
  1855. // opnd: points to opcode operands after OP_*CATEGORY
  1856. // scan: points into InputString
  1857. begin
  1858. Result := CheckCharCategory(scan^, opnd^, (opnd + 1)^);
  1859. end;
  1860. {$ELSE}
  1861. function TRegExpr.IsWordChar(AChar: REChar): boolean;
  1862. begin
  1863. {$IFDEF UseWordChars}
  1864. Result := Pos(AChar, fWordChars) > 0;
  1865. {$ELSE}
  1866. case AChar of
  1867. 'a' .. 'z',
  1868. 'A' .. 'Z',
  1869. '0' .. '9', '_':
  1870. Result := True
  1871. else
  1872. Result := False;
  1873. end;
  1874. {$ENDIF}
  1875. end;
  1876. {$ENDIF}
  1877. function TRegExpr.IsSpaceChar(AChar: REChar): boolean;
  1878. begin
  1879. {$IFDEF UseSpaceChars}
  1880. Result := Pos(AChar, fSpaceChars) > 0;
  1881. {$ELSE}
  1882. case AChar of
  1883. ' ', #$9, #$A, #$D, #$C:
  1884. Result := True
  1885. else
  1886. Result := False;
  1887. end;
  1888. {$ENDIF}
  1889. end;
  1890. function TRegExpr.IsCustomLineSeparator(AChar: REChar): boolean;
  1891. begin
  1892. {$IFDEF UseLineSep}
  1893. {$IFDEF UniCode}
  1894. Result := Pos(AChar, fLineSeparators) > 0;
  1895. {$ELSE}
  1896. Result := fLineSepArray[byte(AChar)];
  1897. {$ENDIF}
  1898. {$ELSE}
  1899. case AChar of
  1900. #$d, #$a,
  1901. {$IFDEF UniCode}
  1902. #$85, #$2028, #$2029,
  1903. {$ENDIF}
  1904. #$b, #$c:
  1905. Result := True;
  1906. else
  1907. Result := False;
  1908. end;
  1909. {$ENDIF}
  1910. end;
  1911. function IsDigitChar(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
  1912. begin
  1913. case AChar of
  1914. '0' .. '9':
  1915. Result := True;
  1916. else
  1917. Result := False;
  1918. end;
  1919. end;
  1920. function IsHorzSeparator(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
  1921. begin
  1922. // Tab and Unicode categoty "Space Separator": https://www.compart.com/en/unicode/category/Zs
  1923. case AChar of
  1924. #9, #$20, #$A0:
  1925. Result := True;
  1926. {$IFDEF UniCode}
  1927. #$1680, #$2000 .. #$200A, #$202F, #$205F, #$3000:
  1928. Result := True;
  1929. {$ENDIF}
  1930. else
  1931. Result := False;
  1932. end;
  1933. end;
  1934. function IsVertLineSeparator(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
  1935. begin
  1936. case AChar of
  1937. #$d, #$a, #$b, #$c:
  1938. Result := True;
  1939. {$IFDEF UniCode}
  1940. #$2028, #$2029, #$85:
  1941. Result := True;
  1942. {$ENDIF}
  1943. else
  1944. Result := False;
  1945. end;
  1946. end;
  1947. procedure TRegExpr.InvalidateProgramm;
  1948. begin
  1949. if programm <> nil then
  1950. begin
  1951. FreeMem(programm);
  1952. programm := nil;
  1953. end;
  1954. end; { of procedure TRegExpr.InvalidateProgramm
  1955. -------------------------------------------------------------- }
  1956. procedure TRegExpr.Compile;
  1957. begin
  1958. if fExpression = '' then
  1959. begin
  1960. Error(reeNoExpression);
  1961. Exit;
  1962. end;
  1963. CompileRegExpr(fRegexStart);
  1964. end; { of procedure TRegExpr.Compile
  1965. -------------------------------------------------------------- }
  1966. {$IFDEF UseLineSep}
  1967. procedure TRegExpr.InitLineSepArray;
  1968. {$IFNDEF UniCode}
  1969. var
  1970. i: integer;
  1971. {$ENDIF}
  1972. begin
  1973. {$IFNDEF UniCode}
  1974. FillChar(fLineSepArray, SizeOf(fLineSepArray), 0);
  1975. for i := 1 to Length(fLineSeparators) do
  1976. fLineSepArray[byte(fLineSeparators[i])] := True;
  1977. {$ENDIF}
  1978. end;
  1979. {$ENDIF}
  1980. function TRegExpr.IsProgrammOk: boolean;
  1981. begin
  1982. Result := False;
  1983. // check modifiers
  1984. if not IsModifiersEqual(fModifiers, fProgModifiers) then
  1985. InvalidateProgramm;
  1986. // compile if needed
  1987. if programm = nil then
  1988. begin
  1989. Compile;
  1990. // Check compiled programm
  1991. if programm = nil then
  1992. Exit;
  1993. end;
  1994. if programm[0] <> OP_MAGIC then
  1995. Error(reeCorruptedProgram)
  1996. else
  1997. Result := True;
  1998. end; { of function TRegExpr.IsProgrammOk
  1999. -------------------------------------------------------------- }
  2000. procedure TRegExpr.Tail(p: PRegExprChar; val: PRegExprChar);
  2001. // set the next-pointer at the end of a node chain
  2002. var
  2003. scan: PRegExprChar;
  2004. temp: PRegExprChar;
  2005. begin
  2006. if p = @regDummy then
  2007. Exit;
  2008. // Find last node.
  2009. scan := p;
  2010. repeat
  2011. temp := regNext(scan);
  2012. if temp = nil then
  2013. Break;
  2014. scan := temp;
  2015. until False;
  2016. // Set Next 'pointer'
  2017. if val < scan then
  2018. PRENextOff(AlignToPtr(scan + REOpSz))^ := -(scan - val) // ###0.948
  2019. // work around PWideChar subtraction bug (Delphi uses
  2020. // shr after subtraction to calculate widechar distance %-( )
  2021. // so, if difference is negative we have .. the "feature" :(
  2022. // I could wrap it in $IFDEF UniCode, but I didn't because
  2023. // "P – Q computes the difference between the address given
  2024. // by P (the higher address) and the address given by Q (the
  2025. // lower address)" - Delphi help quotation.
  2026. else
  2027. PRENextOff(AlignToPtr(scan + REOpSz))^ := val - scan; // ###0.933
  2028. end; { of procedure TRegExpr.Tail
  2029. -------------------------------------------------------------- }
  2030. procedure TRegExpr.OpTail(p: PRegExprChar; val: PRegExprChar);
  2031. // regtail on operand of first argument; nop if operandless
  2032. begin
  2033. // "Operandless" and "op != OP_BRANCH" are synonymous in practice.
  2034. if (p = nil) or (p = @regDummy) or (PREOp(p)^ <> OP_BRANCH) then
  2035. Exit;
  2036. Tail(p + REOpSz + RENextOffSz, val); // ###0.933
  2037. end; { of procedure TRegExpr.OpTail
  2038. -------------------------------------------------------------- }
  2039. function TRegExpr.EmitNode(op: TREOp): PRegExprChar; // ###0.933
  2040. // emit a node, return location
  2041. begin
  2042. Result := regCode;
  2043. if Result <> @regDummy then
  2044. begin
  2045. PREOp(regCode)^ := op;
  2046. Inc(regCode, REOpSz);
  2047. PRENextOff(AlignToPtr(regCode))^ := 0; // Next "pointer" := nil
  2048. Inc(regCode, RENextOffSz);
  2049. if (op = OP_EXACTLY) or (op = OP_EXACTLYCI) then
  2050. regExactlyLen := PLongInt(regCode)
  2051. else
  2052. regExactlyLen := nil;
  2053. {$IFDEF DebugSynRegExpr}
  2054. if regcode - programm > regsize then
  2055. raise Exception.Create('TRegExpr.EmitNode buffer overrun');
  2056. {$ENDIF}
  2057. end
  2058. else
  2059. Inc(regCodeSize, REOpSz + RENextOffSz);
  2060. // compute code size without code generation
  2061. end; { of function TRegExpr.EmitNode
  2062. -------------------------------------------------------------- }
  2063. procedure TRegExpr.EmitC(ch: REChar);
  2064. begin
  2065. if regCode <> @regDummy then
  2066. begin
  2067. regCode^ := ch;
  2068. Inc(regCode);
  2069. {$IFDEF DebugSynRegExpr}
  2070. if regcode - programm > regsize then
  2071. raise Exception.Create('TRegExpr.EmitC buffer overrun');
  2072. {$ENDIF}
  2073. end
  2074. else
  2075. Inc(regCodeSize, REOpSz); // Type of p-code pointer always is ^REChar
  2076. end; { of procedure TRegExpr.EmitC
  2077. -------------------------------------------------------------- }
  2078. procedure TRegExpr.EmitInt(AValue: LongInt);
  2079. begin
  2080. if regCode <> @regDummy then
  2081. begin
  2082. PLongInt(regCode)^ := AValue;
  2083. Inc(regCode, RENumberSz);
  2084. {$IFDEF DebugSynRegExpr}
  2085. if regcode - programm > regsize then
  2086. raise Exception.Create('TRegExpr.EmitInt buffer overrun');
  2087. {$ENDIF}
  2088. end
  2089. else
  2090. Inc(regCodeSize, RENumberSz);
  2091. end;
  2092. function TRegExpr.EmitGroupRef(AIndex: integer; AIgnoreCase: boolean): PRegExprChar;
  2093. begin
  2094. if AIgnoreCase then
  2095. Result := EmitNode(OP_BSUBEXPCI)
  2096. else
  2097. Result := EmitNode(OP_BSUBEXP);
  2098. EmitC(REChar(AIndex));
  2099. end;
  2100. {$IFDEF FastUnicodeData}
  2101. procedure TRegExpr.FindCategoryName(var scan: PRegExprChar; var ch1, ch2: REChar);
  2102. // scan: points into regex string after '\p', to find category name
  2103. // ch1, ch2: 2-char name of category; ch2 can be #0
  2104. var
  2105. ch: REChar;
  2106. pos1, pos2, namePtr: PRegExprChar;
  2107. nameLen: integer;
  2108. begin
  2109. ch1 := #0;
  2110. ch2 := #0;
  2111. ch := scan^;
  2112. if IsCategoryFirstChar(ch) then
  2113. begin
  2114. ch1 := ch;
  2115. Exit;
  2116. end;
  2117. if ch = '{' then
  2118. begin
  2119. pos1 := scan;
  2120. pos2 := pos1;
  2121. while (pos2 < fRegexEnd) and (pos2^ <> '}') do
  2122. Inc(pos2);
  2123. if pos2 >= fRegexEnd then
  2124. Error(reeIncorrectBraces);
  2125. namePtr := pos1+1;
  2126. nameLen := pos2-pos1-1;
  2127. Inc(scan, nameLen+1);
  2128. if nameLen<1 then
  2129. Error(reeBadUnicodeCategory);
  2130. if nameLen>2 then
  2131. Error(reeBadUnicodeCategory);
  2132. if nameLen = 1 then
  2133. begin
  2134. ch1 := namePtr^;
  2135. ch2 := #0;
  2136. if not IsCategoryFirstChar(ch1) then
  2137. Error(reeBadUnicodeCategory);
  2138. Exit;
  2139. end;
  2140. if nameLen = 2 then
  2141. begin
  2142. ch1 := namePtr^;
  2143. ch2 := (namePtr+1)^;
  2144. if not IsCategoryChars(ch1, ch2) then
  2145. Error(reeBadUnicodeCategory);
  2146. Exit;
  2147. end;
  2148. end
  2149. else
  2150. Error(reeBadUnicodeCategory);
  2151. end;
  2152. function TRegExpr.EmitCategoryMain(APositive: boolean): PRegExprChar;
  2153. var
  2154. ch, ch2: REChar;
  2155. begin
  2156. Inc(regParse);
  2157. if regParse >= fRegexEnd then
  2158. Error(reeBadUnicodeCategory);
  2159. FindCategoryName(regParse, ch, ch2);
  2160. if APositive then
  2161. Result := EmitNode(OP_ANYCATEGORY)
  2162. else
  2163. Result := EmitNode(OP_NOTCATEGORY);
  2164. EmitC(ch);
  2165. EmitC(ch2);
  2166. end;
  2167. {$ENDIF}
  2168. procedure TRegExpr.InsertOperator(op: TREOp; opnd: PRegExprChar; sz: integer);
  2169. // insert an operator in front of already-emitted operand
  2170. // Means relocating the operand.
  2171. var
  2172. src, dst, place: PRegExprChar;
  2173. i: integer;
  2174. begin
  2175. if regCode = @regDummy then
  2176. begin
  2177. Inc(regCodeSize, sz);
  2178. Exit;
  2179. end;
  2180. // move code behind insert position
  2181. src := regCode;
  2182. Inc(regCode, sz);
  2183. {$IFDEF DebugSynRegExpr}
  2184. if regCode - programm > regCodeSize then
  2185. raise Exception.Create('TRegExpr.InsertOperator buffer overrun');
  2186. // if (opnd<regCode) or (opnd-regCode>regCodeSize) then
  2187. // raise Exception.Create('TRegExpr.InsertOperator invalid opnd');
  2188. {$ENDIF}
  2189. dst := regCode;
  2190. while src > opnd do
  2191. begin
  2192. Dec(dst);
  2193. Dec(src);
  2194. dst^ := src^;
  2195. end;
  2196. place := opnd; // Op node, where operand used to be.
  2197. PREOp(place)^ := op;
  2198. Inc(place, REOpSz);
  2199. for i := 1 + REOpSz to sz do
  2200. begin
  2201. place^ := #0;
  2202. Inc(place);
  2203. end;
  2204. end; { of procedure TRegExpr.InsertOperator
  2205. -------------------------------------------------------------- }
  2206. function FindSkippedMetaLen(PStart, PEnd: PRegExprChar): integer; {$IFDEF InlineFuncs}inline;{$ENDIF}
  2207. // find length of initial segment of PStart string consisting
  2208. // entirely of characters not from IsMetaSymbol1.
  2209. begin
  2210. Result := 0;
  2211. while PStart < PEnd do
  2212. begin
  2213. if _IsMetaSymbol1(PStart^) then
  2214. Exit;
  2215. Inc(Result);
  2216. Inc(PStart)
  2217. end;
  2218. end;
  2219. const
  2220. // Flags to be passed up and down.
  2221. FLAG_WORST = 0; // Worst case
  2222. FLAG_HASWIDTH = 1; // Cannot match empty string
  2223. FLAG_SIMPLE = 2; // Simple enough to be OP_STAR/OP_PLUS/OP_BRACES operand
  2224. FLAG_SPECSTART = 4; // Starts with * or +
  2225. {$IFDEF UniCode}
  2226. RusRangeLoLow = #$430; // 'а'
  2227. RusRangeLoHigh = #$44F; // 'я'
  2228. RusRangeHiLow = #$410; // 'А'
  2229. RusRangeHiHigh = #$42F; // 'Я'
  2230. {$ELSE}
  2231. RusRangeLoLow = #$E0; // 'а' in cp1251
  2232. RusRangeLoHigh = #$FF; // 'я' in cp1251
  2233. RusRangeHiLow = #$C0; // 'А' in cp1251
  2234. RusRangeHiHigh = #$DF; // 'Я' in cp1251
  2235. {$ENDIF}
  2236. function TRegExpr.FindInCharClass(ABuffer: PRegExprChar; AChar: REChar; AIgnoreCase: boolean): boolean;
  2237. // Buffer contains char pairs: (Kind, Data), where Kind is one of OpKind_ values,
  2238. // and Data depends on Kind
  2239. var
  2240. OpKind: REChar;
  2241. ch, ch2: REChar;
  2242. N, i: integer;
  2243. begin
  2244. if AIgnoreCase then
  2245. AChar := _UpperCase(AChar);
  2246. repeat
  2247. OpKind := ABuffer^;
  2248. case OpKind of
  2249. OpKind_End:
  2250. begin
  2251. Result := False;
  2252. Exit;
  2253. end;
  2254. OpKind_Range:
  2255. begin
  2256. Inc(ABuffer);
  2257. ch := ABuffer^;
  2258. Inc(ABuffer);
  2259. ch2 := ABuffer^;
  2260. Inc(ABuffer);
  2261. {
  2262. // if AIgnoreCase, ch, ch2 are upcased in opcode
  2263. if AIgnoreCase then
  2264. begin
  2265. ch := _UpperCase(ch);
  2266. ch2 := _UpperCase(ch2);
  2267. end;
  2268. }
  2269. if (AChar >= ch) and (AChar <= ch2) then
  2270. begin
  2271. Result := True;
  2272. Exit;
  2273. end;
  2274. end;
  2275. OpKind_MetaClass:
  2276. begin
  2277. Inc(ABuffer);
  2278. N := Ord(ABuffer^);
  2279. Inc(ABuffer);
  2280. if CharCheckers[N](AChar) then
  2281. begin
  2282. Result := True;
  2283. Exit
  2284. end;
  2285. end;
  2286. OpKind_Char:
  2287. begin
  2288. Inc(ABuffer);
  2289. N := PLongInt(ABuffer)^;
  2290. Inc(ABuffer, RENumberSz);
  2291. for i := 1 to N do
  2292. begin
  2293. ch := ABuffer^;
  2294. Inc(ABuffer);
  2295. {
  2296. // already upcased in opcode
  2297. if AIgnoreCase then
  2298. ch := _UpperCase(ch);
  2299. }
  2300. if ch = AChar then
  2301. begin
  2302. Result := True;
  2303. Exit;
  2304. end;
  2305. end;
  2306. end;
  2307. {$IFDEF FastUnicodeData}
  2308. OpKind_CategoryYes,
  2309. OpKind_CategoryNo:
  2310. begin
  2311. Inc(ABuffer);
  2312. ch := ABuffer^;
  2313. Inc(ABuffer);
  2314. ch2 := ABuffer^;
  2315. Inc(ABuffer);
  2316. Result := CheckCharCategory(AChar, ch, ch2);
  2317. if OpKind = OpKind_CategoryNo then
  2318. Result := not Result;
  2319. if Result then
  2320. Exit;
  2321. end;
  2322. {$ENDIF}
  2323. else
  2324. Error(reeBadOpcodeInCharClass);
  2325. end;
  2326. until False; // assume that Buffer is ended correctly
  2327. end;
  2328. procedure TRegExpr.GetCharSetFromWordChars(var ARes: TRegExprCharSet);
  2329. {$IFDEF UseWordChars}
  2330. var
  2331. i: integer;
  2332. ch: REChar;
  2333. {$ENDIF}
  2334. begin
  2335. {$IFDEF UseWordChars}
  2336. ARes := [];
  2337. for i := 1 to Length(fWordChars) do
  2338. begin
  2339. ch := fWordChars[i];
  2340. {$IFDEF UniCode}
  2341. if Ord(ch) <= $FF then
  2342. {$ENDIF}
  2343. Include(ARes, byte(ch));
  2344. end;
  2345. {$ELSE}
  2346. ARes := RegExprWordSet;
  2347. {$ENDIF}
  2348. end;
  2349. procedure TRegExpr.GetCharSetFromSpaceChars(var ARes: TRegExprCharset);
  2350. {$IFDEF UseSpaceChars}
  2351. var
  2352. i: integer;
  2353. ch: REChar;
  2354. {$ENDIF}
  2355. begin
  2356. {$IFDEF UseSpaceChars}
  2357. ARes := [];
  2358. for i := 1 to Length(fSpaceChars) do
  2359. begin
  2360. ch := fSpaceChars[i];
  2361. {$IFDEF UniCode}
  2362. if Ord(ch) <= $FF then
  2363. {$ENDIF}
  2364. Include(ARes, byte(ch));
  2365. end;
  2366. {$ELSE}
  2367. ARes := RegExprSpaceSet;
  2368. {$ENDIF}
  2369. end;
  2370. procedure TRegExpr.GetCharSetFromCharClass(ABuffer: PRegExprChar; AIgnoreCase: boolean; var ARes: TRegExprCharset);
  2371. var
  2372. ch, ch2: REChar;
  2373. TempSet: TRegExprCharSet;
  2374. N, i: integer;
  2375. begin
  2376. ARes := [];
  2377. TempSet := [];
  2378. repeat
  2379. case ABuffer^ of
  2380. OpKind_End:
  2381. Exit;
  2382. OpKind_Range:
  2383. begin
  2384. Inc(ABuffer);
  2385. ch := ABuffer^;
  2386. Inc(ABuffer);
  2387. ch2 := ABuffer^;
  2388. Inc(ABuffer);
  2389. for i := Ord(ch) to
  2390. {$IFDEF UniCode} Min(Ord(ch2), $FF) {$ELSE} Ord(ch2) {$ENDIF} do
  2391. begin
  2392. Include(ARes, byte(i));
  2393. if AIgnoreCase then
  2394. Include(ARes, byte(InvertCase(REChar(i))));
  2395. end;
  2396. end;
  2397. OpKind_MetaClass:
  2398. begin
  2399. Inc(ABuffer);
  2400. N := Ord(ABuffer^);
  2401. Inc(ABuffer);
  2402. if N = CheckerIndex_Word then
  2403. begin
  2404. GetCharSetFromWordChars(TempSet);
  2405. ARes := ARes + TempSet;
  2406. end
  2407. else
  2408. if N = CheckerIndex_NotWord then
  2409. begin
  2410. GetCharSetFromWordChars(TempSet);
  2411. ARes := ARes + (RegExprAllSet - TempSet);
  2412. end
  2413. else
  2414. if N = CheckerIndex_Space then
  2415. begin
  2416. GetCharSetFromSpaceChars(TempSet);
  2417. ARes := ARes + TempSet;
  2418. end
  2419. else
  2420. if N = CheckerIndex_NotSpace then
  2421. begin
  2422. GetCharSetFromSpaceChars(TempSet);
  2423. ARes := ARes + (RegExprAllSet - TempSet);
  2424. end
  2425. else
  2426. if N = CheckerIndex_Digit then
  2427. ARes := ARes + RegExprDigitSet
  2428. else
  2429. if N = CheckerIndex_NotDigit then
  2430. ARes := ARes + (RegExprAllSet - RegExprDigitSet)
  2431. else
  2432. if N = CheckerIndex_VertSep then
  2433. ARes := ARes + RegExprLineSeparatorsSet
  2434. else
  2435. if N = CheckerIndex_NotVertSep then
  2436. ARes := ARes + (RegExprAllSet - RegExprLineSeparatorsSet)
  2437. else
  2438. if N = CheckerIndex_HorzSep then
  2439. ARes := ARes + RegExprHorzSeparatorsSet
  2440. else
  2441. if N = CheckerIndex_NotHorzSep then
  2442. ARes := ARes + (RegExprAllSet - RegExprHorzSeparatorsSet)
  2443. else
  2444. if N = CheckerIndex_LowerAZ then
  2445. begin
  2446. if AIgnoreCase then
  2447. ARes := ARes + RegExprAllAzSet
  2448. else
  2449. ARes := ARes + RegExprLowerAzSet;
  2450. end
  2451. else
  2452. if N = CheckerIndex_UpperAZ then
  2453. begin
  2454. if AIgnoreCase then
  2455. ARes := ARes + RegExprAllAzSet
  2456. else
  2457. ARes := ARes + RegExprUpperAzSet;
  2458. end
  2459. else
  2460. Error(reeBadOpcodeInCharClass);
  2461. end;
  2462. OpKind_Char:
  2463. begin
  2464. Inc(ABuffer);
  2465. N := PLongInt(ABuffer)^;
  2466. Inc(ABuffer, RENumberSz);
  2467. for i := 1 to N do
  2468. begin
  2469. ch := ABuffer^;
  2470. Inc(ABuffer);
  2471. {$IFDEF UniCode}
  2472. if Ord(ch) <= $FF then
  2473. {$ENDIF}
  2474. begin
  2475. Include(ARes, byte(ch));
  2476. if AIgnoreCase then
  2477. Include(ARes, byte(InvertCase(ch)));
  2478. end;
  2479. end;
  2480. end;
  2481. {$IFDEF FastUnicodeData}
  2482. OpKind_CategoryYes,
  2483. OpKind_CategoryNo:
  2484. begin
  2485. // usage of FirstCharSet makes no sense for regex with \p \P
  2486. ARes := RegExprAllSet;
  2487. Exit;
  2488. end;
  2489. {$ENDIF}
  2490. else
  2491. Error(reeBadOpcodeInCharClass);
  2492. end;
  2493. until False; // assume that Buffer is ended correctly
  2494. end;
  2495. function TRegExpr.GetModifierG: boolean;
  2496. begin
  2497. Result := fModifiers.G;
  2498. end;
  2499. function TRegExpr.GetModifierI: boolean;
  2500. begin
  2501. Result := fModifiers.I;
  2502. end;
  2503. function TRegExpr.GetModifierM: boolean;
  2504. begin
  2505. Result := fModifiers.M;
  2506. end;
  2507. function TRegExpr.GetModifierR: boolean;
  2508. begin
  2509. Result := fModifiers.R;
  2510. end;
  2511. function TRegExpr.GetModifierS: boolean;
  2512. begin
  2513. Result := fModifiers.S;
  2514. end;
  2515. function TRegExpr.GetModifierX: boolean;
  2516. begin
  2517. Result := fModifiers.X;
  2518. end;
  2519. function TRegExpr.CompileRegExpr(ARegExp: PRegExprChar): boolean;
  2520. // Compile a regular expression into internal code
  2521. // We can't allocate space until we know how big the compiled form will be,
  2522. // but we can't compile it (and thus know how big it is) until we've got a
  2523. // place to put the code. So we cheat: we compile it twice, once with code
  2524. // generation turned off and size counting turned on, and once "for real".
  2525. // This also means that we don't allocate space until we are sure that the
  2526. // thing really will compile successfully, and we never have to move the
  2527. // code and thus invalidate pointers into it. (Note that it has to be in
  2528. // one piece because free() must be able to free it all.)
  2529. // Beware that the optimization-preparation code in here knows about some
  2530. // of the structure of the compiled regexp.
  2531. var
  2532. scan, longest, longestTemp: PRegExprChar;
  2533. Len, LenTemp: integer;
  2534. FlagTemp: integer;
  2535. begin
  2536. Result := False;
  2537. FlagTemp := 0;
  2538. regParse := nil; // for correct error handling
  2539. regExactlyLen := nil;
  2540. ClearInternalIndexes;
  2541. fLastError := reeOk;
  2542. fLastErrorOpcode := TREOp(0);
  2543. if Assigned(fHelper) then
  2544. FreeAndNil(fHelper);
  2545. fHelperLen := 0;
  2546. try
  2547. if programm <> nil then
  2548. begin
  2549. FreeMem(programm);
  2550. programm := nil;
  2551. end;
  2552. if ARegExp = nil then
  2553. begin
  2554. Error(reeCompNullArgument);
  2555. Exit;
  2556. end;
  2557. fProgModifiers := fModifiers;
  2558. // well, may it's paranoia. I'll check it later.
  2559. // First pass: calculate opcode size, validate regex
  2560. fSecondPass := False;
  2561. fCompModifiers := fModifiers;
  2562. regParse := ARegExp;
  2563. regNumBrackets := 1;
  2564. regCodeSize := 0;
  2565. regCode := @regDummy;
  2566. regCodeWork := nil;
  2567. regLookahead := False;
  2568. regLookaheadNeg := False;
  2569. regLookaheadGroup := -1;
  2570. regLookbehind := False;
  2571. EmitC(OP_MAGIC);
  2572. if ParseReg(False, FlagTemp) = nil then
  2573. Exit;
  2574. // Allocate memory
  2575. GetMem(programm, regCodeSize * SizeOf(REChar));
  2576. // Second pass: emit opcode
  2577. fSecondPass := True;
  2578. fCompModifiers := fModifiers;
  2579. regParse := ARegExp;
  2580. regNumBrackets := 1;
  2581. regCode := programm;
  2582. regCodeWork := programm + REOpSz;
  2583. EmitC(OP_MAGIC);
  2584. if ParseReg(False, FlagTemp) = nil then
  2585. Exit;
  2586. // Dig out information for optimizations.
  2587. {$IFDEF UseFirstCharSet} // ###0.929
  2588. FirstCharSet := [];
  2589. FillFirstCharSet(regCodeWork);
  2590. for Len := 0 to 255 do
  2591. FirstCharArray[Len] := byte(Len) in FirstCharSet;
  2592. {$ENDIF}
  2593. regAnchored := #0;
  2594. regMust := nil;
  2595. regMustLen := 0;
  2596. regMustString := '';
  2597. scan := regCodeWork; // First OP_BRANCH.
  2598. if PREOp(regNext(scan))^ = OP_EEND then
  2599. begin // Only one top-level choice.
  2600. scan := scan + REOpSz + RENextOffSz;
  2601. // Starting-point info.
  2602. if PREOp(scan)^ = OP_BOL then
  2603. Inc(regAnchored);
  2604. // If there's something expensive in the r.e., find the longest
  2605. // literal string that must appear and make it the regMust. Resolve
  2606. // ties in favor of later strings, since the regstart check works
  2607. // with the beginning of the r.e. and avoiding duplication
  2608. // strengthens checking. Not a strong reason, but sufficient in the
  2609. // absence of others.
  2610. if (FlagTemp and FLAG_SPECSTART) <> 0 then
  2611. begin
  2612. longest := nil;
  2613. Len := 0;
  2614. while scan <> nil do
  2615. begin
  2616. if PREOp(scan)^ = OP_EXACTLY then
  2617. begin
  2618. longestTemp := scan + REOpSz + RENextOffSz + RENumberSz;
  2619. LenTemp := PLongInt(scan + REOpSz + RENextOffSz)^;
  2620. if LenTemp >= Len then
  2621. begin
  2622. longest := longestTemp;
  2623. Len := LenTemp;
  2624. end;
  2625. end;
  2626. scan := regNext(scan);
  2627. end;
  2628. regMust := longest;
  2629. regMustLen := Len;
  2630. if regMustLen > 1 then // don't use regMust if too short
  2631. SetString(regMustString, regMust, regMustLen);
  2632. end;
  2633. end;
  2634. Result := True;
  2635. finally
  2636. begin
  2637. if not Result then
  2638. InvalidateProgramm;
  2639. end;
  2640. end;
  2641. end; { of function TRegExpr.CompileRegExpr
  2642. -------------------------------------------------------------- }
  2643. function TRegExpr.ParseReg(InBrackets: boolean; var FlagParse: integer): PRegExprChar;
  2644. // regular expression, i.e. main body or parenthesized thing
  2645. // Caller must absorb opening parenthesis.
  2646. // Combining parenthesis handling with the base level of regular expression
  2647. // is a trifle forced, but the need to tie the tails of the branches to what
  2648. // follows makes it hard to avoid.
  2649. var
  2650. ret, br, ender: PRegExprChar;
  2651. NBrackets: integer;
  2652. FlagTemp: integer;
  2653. SavedModifiers: TRegExprModifiers;
  2654. begin
  2655. Result := nil;
  2656. FlagTemp := 0;
  2657. FlagParse := FLAG_HASWIDTH; // Tentatively.
  2658. NBrackets := 0;
  2659. SavedModifiers := fCompModifiers;
  2660. // Make an OP_OPEN node, if parenthesized.
  2661. if InBrackets then
  2662. begin
  2663. if regNumBrackets >= RegexMaxGroups then
  2664. begin
  2665. Error(reeCompParseRegTooManyBrackets);
  2666. Exit;
  2667. end;
  2668. NBrackets := regNumBrackets;
  2669. Inc(regNumBrackets);
  2670. ret := EmitNode(TREOp(Ord(OP_OPEN) + NBrackets));
  2671. GrpOpCodes[NBrackets] := ret;
  2672. end
  2673. else
  2674. ret := nil;
  2675. // Pick up the branches, linking them together.
  2676. br := ParseBranch(FlagTemp);
  2677. if br = nil then
  2678. begin
  2679. Result := nil;
  2680. Exit;
  2681. end;
  2682. if ret <> nil then
  2683. Tail(ret, br) // OP_OPEN -> first.
  2684. else
  2685. ret := br;
  2686. if (FlagTemp and FLAG_HASWIDTH) = 0 then
  2687. FlagParse := FlagParse and not FLAG_HASWIDTH;
  2688. FlagParse := FlagParse or FlagTemp and FLAG_SPECSTART;
  2689. while (regParse^ = '|') do
  2690. begin
  2691. Inc(regParse);
  2692. br := ParseBranch(FlagTemp);
  2693. if br = nil then
  2694. begin
  2695. Result := nil;
  2696. Exit;
  2697. end;
  2698. Tail(ret, br); // OP_BRANCH -> OP_BRANCH.
  2699. if (FlagTemp and FLAG_HASWIDTH) = 0 then
  2700. FlagParse := FlagParse and not FLAG_HASWIDTH;
  2701. FlagParse := FlagParse or FlagTemp and FLAG_SPECSTART;
  2702. end;
  2703. // Make a closing node, and hook it on the end.
  2704. if InBrackets then
  2705. ender := EmitNode(TREOp(Ord(OP_CLOSE) + NBrackets))
  2706. else
  2707. ender := EmitNode(OP_EEND);
  2708. Tail(ret, ender);
  2709. // Hook the tails of the branches to the closing node.
  2710. br := ret;
  2711. while br <> nil do
  2712. begin
  2713. OpTail(br, ender);
  2714. br := regNext(br);
  2715. end;
  2716. // Check for proper termination.
  2717. if InBrackets then
  2718. if regParse^ <> ')' then
  2719. begin
  2720. Error(reeCompParseRegUnmatchedBrackets);
  2721. Exit;
  2722. end
  2723. else
  2724. Inc(regParse); // skip trailing ')'
  2725. if (not InBrackets) and (regParse < fRegexEnd) then
  2726. begin
  2727. if regParse^ = ')' then
  2728. Error(reeCompParseRegUnmatchedBrackets2)
  2729. else
  2730. Error(reeCompParseRegJunkOnEnd);
  2731. Exit;
  2732. end;
  2733. fCompModifiers := SavedModifiers; // restore modifiers of parent
  2734. Result := ret;
  2735. end; { of function TRegExpr.ParseReg
  2736. -------------------------------------------------------------- }
  2737. function TRegExpr.ParseBranch(var FlagParse: integer): PRegExprChar;
  2738. // one alternative of an | operator
  2739. // Implements the concatenation operator.
  2740. var
  2741. ret, chain, latest: PRegExprChar;
  2742. FlagTemp: integer;
  2743. begin
  2744. FlagTemp := 0;
  2745. FlagParse := FLAG_WORST; // Tentatively.
  2746. ret := EmitNode(OP_BRANCH);
  2747. chain := nil;
  2748. while (regParse < fRegexEnd) and (regParse^ <> '|') and (regParse^ <> ')') do
  2749. begin
  2750. latest := ParsePiece(FlagTemp);
  2751. if latest = nil then
  2752. begin
  2753. Result := nil;
  2754. Exit;
  2755. end;
  2756. FlagParse := FlagParse or FlagTemp and FLAG_HASWIDTH;
  2757. if chain = nil // First piece.
  2758. then
  2759. FlagParse := FlagParse or FlagTemp and FLAG_SPECSTART
  2760. else
  2761. Tail(chain, latest);
  2762. chain := latest;
  2763. end;
  2764. if chain = nil // Loop ran zero times.
  2765. then
  2766. EmitNode(OP_NOTHING);
  2767. Result := ret;
  2768. end; { of function TRegExpr.ParseBranch
  2769. -------------------------------------------------------------- }
  2770. function TRegExpr.ParsePiece(var FlagParse: integer): PRegExprChar;
  2771. // something followed by possible [*+?{]
  2772. // Note that the branching code sequences used for ? and the general cases
  2773. // of * and + and { are somewhat optimized: they use the same OP_NOTHING node as
  2774. // both the endmarker for their branch list and the body of the last branch.
  2775. // It might seem that this node could be dispensed with entirely, but the
  2776. // endmarker role is not redundant.
  2777. function ParseNumber(AStart, AEnd: PRegExprChar): TREBracesArg;
  2778. begin
  2779. Result := 0;
  2780. if AEnd - AStart + 1 > 8 then
  2781. begin // prevent stupid scanning
  2782. Error(reeBRACESArgTooBig);
  2783. Exit;
  2784. end;
  2785. while AStart <= AEnd do
  2786. begin
  2787. Result := Result * 10 + (Ord(AStart^) - Ord('0'));
  2788. Inc(AStart);
  2789. end;
  2790. if (Result > MaxBracesArg) or (Result < 0) then
  2791. begin
  2792. Error(reeBRACESArgTooBig);
  2793. Exit;
  2794. end;
  2795. end;
  2796. var
  2797. TheOp: TREOp;
  2798. NextNode: PRegExprChar;
  2799. procedure EmitComplexBraces(ABracesMin, ABracesMax: TREBracesArg; ANonGreedyOp: boolean); // ###0.940
  2800. {$IFDEF ComplexBraces}
  2801. var
  2802. off: TRENextOff;
  2803. {$ENDIF}
  2804. begin
  2805. {$IFNDEF ComplexBraces}
  2806. Error(reeComplexBracesNotImplemented);
  2807. {$ELSE}
  2808. if ANonGreedyOp then
  2809. TheOp := OP_LOOPNG
  2810. else
  2811. TheOp := OP_LOOP;
  2812. InsertOperator(OP_LOOPENTRY, Result, REOpSz + RENextOffSz);
  2813. NextNode := EmitNode(TheOp);
  2814. if regCode <> @regDummy then
  2815. begin
  2816. off := (Result + REOpSz + RENextOffSz) - (regCode - REOpSz - RENextOffSz);
  2817. // back to Atom after OP_LOOPENTRY
  2818. PREBracesArg(AlignToInt(regCode))^ := ABracesMin;
  2819. Inc(regCode, REBracesArgSz);
  2820. PREBracesArg(AlignToInt(regCode))^ := ABracesMax;
  2821. Inc(regCode, REBracesArgSz);
  2822. PRENextOff(AlignToPtr(regCode))^ := off;
  2823. Inc(regCode, RENextOffSz);
  2824. {$IFDEF DebugSynRegExpr}
  2825. if regcode - programm > regsize then
  2826. raise Exception.Create
  2827. ('TRegExpr.ParsePiece.EmitComplexBraces buffer overrun');
  2828. {$ENDIF}
  2829. end
  2830. else
  2831. Inc(regCodeSize, REBracesArgSz * 2 + RENextOffSz);
  2832. Tail(Result, NextNode); // OP_LOOPENTRY -> OP_LOOP
  2833. if regCode <> @regDummy then
  2834. Tail(Result + REOpSz + RENextOffSz, NextNode); // Atom -> OP_LOOP
  2835. {$ENDIF}
  2836. end;
  2837. procedure EmitSimpleBraces(ABracesMin, ABracesMax: TREBracesArg; ANonGreedyOp, APossessive: boolean);
  2838. begin
  2839. if APossessive then
  2840. TheOp := OP_BRACES_POSS
  2841. else
  2842. if ANonGreedyOp then
  2843. TheOp := OP_BRACESNG
  2844. else
  2845. TheOp := OP_BRACES;
  2846. InsertOperator(TheOp, Result, REOpSz + RENextOffSz + REBracesArgSz * 2);
  2847. if regCode <> @regDummy then
  2848. begin
  2849. PREBracesArg(AlignToInt(Result + REOpSz + RENextOffSz))^ := ABracesMin;
  2850. PREBracesArg(AlignToInt(Result + REOpSz + RENextOffSz + REBracesArgSz))^ := ABracesMax;
  2851. end;
  2852. end;
  2853. var
  2854. op, nextch: REChar;
  2855. NonGreedyOp, NonGreedyCh, PossessiveCh: boolean;
  2856. FlagTemp: integer;
  2857. BracesMin, BracesMax: TREBracesArg;
  2858. p: PRegExprChar;
  2859. begin
  2860. FlagTemp := 0;
  2861. Result := ParseAtom(FlagTemp);
  2862. if Result = nil then
  2863. Exit;
  2864. op := regParse^;
  2865. if not ((op = '*') or (op = '+') or (op = '?') or (op = '{')) then
  2866. begin
  2867. FlagParse := FlagTemp;
  2868. Exit;
  2869. end;
  2870. if ((FlagTemp and FLAG_HASWIDTH) = 0) and (op <> '?') then
  2871. begin
  2872. Error(reePlusStarOperandCouldBeEmpty);
  2873. Exit;
  2874. end;
  2875. case op of
  2876. '*':
  2877. begin
  2878. FlagParse := FLAG_WORST or FLAG_SPECSTART;
  2879. nextch := (regParse + 1)^;
  2880. PossessiveCh := nextch = '+';
  2881. if PossessiveCh then
  2882. begin
  2883. NonGreedyCh := False;
  2884. NonGreedyOp := False;
  2885. end
  2886. else
  2887. begin
  2888. NonGreedyCh := nextch = '?';
  2889. NonGreedyOp := NonGreedyCh or not fCompModifiers.G;
  2890. end;
  2891. if (FlagTemp and FLAG_SIMPLE) = 0 then
  2892. begin
  2893. if NonGreedyOp then
  2894. EmitComplexBraces(0, MaxBracesArg, NonGreedyOp)
  2895. else
  2896. begin // Emit x* as (x&|), where & means "self".
  2897. InsertOperator(OP_BRANCH, Result, REOpSz + RENextOffSz); // Either x
  2898. OpTail(Result, EmitNode(OP_BACK)); // and loop
  2899. OpTail(Result, Result); // back
  2900. Tail(Result, EmitNode(OP_BRANCH)); // or
  2901. Tail(Result, EmitNode(OP_NOTHING)); // nil.
  2902. end
  2903. end
  2904. else
  2905. begin // Simple
  2906. if PossessiveCh then
  2907. TheOp := OP_STAR_POSS
  2908. else
  2909. if NonGreedyOp then
  2910. TheOp := OP_STARNG
  2911. else
  2912. TheOp := OP_STAR;
  2913. InsertOperator(TheOp, Result, REOpSz + RENextOffSz);
  2914. end;
  2915. if NonGreedyCh or PossessiveCh then
  2916. Inc(regParse); // Skip extra char ('?')
  2917. end; { of case '*' }
  2918. '+':
  2919. begin
  2920. FlagParse := FLAG_WORST or FLAG_SPECSTART or FLAG_HASWIDTH;
  2921. nextch := (regParse + 1)^;
  2922. PossessiveCh := nextch = '+';
  2923. if PossessiveCh then
  2924. begin
  2925. NonGreedyCh := False;
  2926. NonGreedyOp := False;
  2927. end
  2928. else
  2929. begin
  2930. NonGreedyCh := nextch = '?';
  2931. NonGreedyOp := NonGreedyCh or not fCompModifiers.G;
  2932. end;
  2933. if (FlagTemp and FLAG_SIMPLE) = 0 then
  2934. begin
  2935. if NonGreedyOp then
  2936. EmitComplexBraces(1, MaxBracesArg, NonGreedyOp)
  2937. else
  2938. begin // Emit x+ as x(&|), where & means "self".
  2939. NextNode := EmitNode(OP_BRANCH); // Either
  2940. Tail(Result, NextNode);
  2941. Tail(EmitNode(OP_BACK), Result); // loop back
  2942. Tail(NextNode, EmitNode(OP_BRANCH)); // or
  2943. Tail(Result, EmitNode(OP_NOTHING)); // nil.
  2944. end
  2945. end
  2946. else
  2947. begin // Simple
  2948. if PossessiveCh then
  2949. TheOp := OP_PLUS_POSS
  2950. else
  2951. if NonGreedyOp then
  2952. TheOp := OP_PLUSNG
  2953. else
  2954. TheOp := OP_PLUS;
  2955. InsertOperator(TheOp, Result, REOpSz + RENextOffSz);
  2956. end;
  2957. if NonGreedyCh or PossessiveCh then
  2958. Inc(regParse); // Skip extra char ('?')
  2959. end; { of case '+' }
  2960. '?':
  2961. begin
  2962. FlagParse := FLAG_WORST;
  2963. nextch := (regParse + 1)^;
  2964. PossessiveCh := nextch = '+';
  2965. if PossessiveCh then
  2966. begin
  2967. NonGreedyCh := False;
  2968. NonGreedyOp := False;
  2969. end
  2970. else
  2971. begin
  2972. NonGreedyCh := nextch = '?';
  2973. NonGreedyOp := NonGreedyCh or not fCompModifiers.G;
  2974. end;
  2975. if NonGreedyOp or PossessiveCh then
  2976. begin // ###0.940 // We emit x?? as x{0,1}?
  2977. if (FlagTemp and FLAG_SIMPLE) = 0 then
  2978. begin
  2979. if PossessiveCh then
  2980. Error(reePossessiveAfterComplexBraces);
  2981. EmitComplexBraces(0, 1, NonGreedyOp);
  2982. end
  2983. else
  2984. EmitSimpleBraces(0, 1, NonGreedyOp, PossessiveCh);
  2985. end
  2986. else
  2987. begin // greedy '?'
  2988. InsertOperator(OP_BRANCH, Result, REOpSz + RENextOffSz); // Either x
  2989. Tail(Result, EmitNode(OP_BRANCH)); // or
  2990. NextNode := EmitNode(OP_NOTHING); // nil.
  2991. Tail(Result, NextNode);
  2992. OpTail(Result, NextNode);
  2993. end;
  2994. if NonGreedyCh or PossessiveCh then
  2995. Inc(regParse); // Skip extra char ('?')
  2996. end; { of case '?' }
  2997. '{':
  2998. begin
  2999. Inc(regParse);
  3000. p := regParse;
  3001. while IsDigitChar(regParse^) do // <min> MUST appear
  3002. Inc(regParse);
  3003. if (regParse^ <> '}') and (regParse^ <> ',') or (p = regParse) then
  3004. begin
  3005. Error(reeIncorrectBraces);
  3006. Exit;
  3007. end;
  3008. BracesMin := ParseNumber(p, regParse - 1);
  3009. if regParse^ = ',' then
  3010. begin
  3011. Inc(regParse);
  3012. p := regParse;
  3013. while IsDigitChar(regParse^) do
  3014. Inc(regParse);
  3015. if regParse^ <> '}' then
  3016. begin
  3017. Error(reeIncorrectBraces);
  3018. Exit;
  3019. end;
  3020. if p = regParse then
  3021. BracesMax := MaxBracesArg
  3022. else
  3023. BracesMax := ParseNumber(p, regParse - 1);
  3024. end
  3025. else
  3026. BracesMax := BracesMin; // {n} == {n,n}
  3027. if BracesMin > BracesMax then
  3028. begin
  3029. Error(reeBracesMinParamGreaterMax);
  3030. Exit;
  3031. end;
  3032. if BracesMin > 0 then
  3033. FlagParse := FLAG_WORST;
  3034. if BracesMax > 0 then
  3035. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SPECSTART;
  3036. nextch := (regParse + 1)^;
  3037. PossessiveCh := nextch = '+';
  3038. if PossessiveCh then
  3039. begin
  3040. NonGreedyCh := False;
  3041. NonGreedyOp := False;
  3042. end
  3043. else
  3044. begin
  3045. NonGreedyCh := nextch = '?';
  3046. NonGreedyOp := NonGreedyCh or not fCompModifiers.G;
  3047. end;
  3048. if (FlagTemp and FLAG_SIMPLE) <> 0 then
  3049. EmitSimpleBraces(BracesMin, BracesMax, NonGreedyOp, PossessiveCh)
  3050. else
  3051. begin
  3052. if PossessiveCh then
  3053. Error(reePossessiveAfterComplexBraces);
  3054. EmitComplexBraces(BracesMin, BracesMax, NonGreedyOp);
  3055. end;
  3056. if NonGreedyCh or PossessiveCh then
  3057. Inc(regParse); // Skip extra char '?'
  3058. end; // of case '{'
  3059. // else // here we can't be
  3060. end; { of case op }
  3061. Inc(regParse);
  3062. op := regParse^;
  3063. if (op = '*') or (op = '+') or (op = '?') or (op = '{') then
  3064. Error(reeNestedQuantif);
  3065. end; { of function TRegExpr.ParsePiece
  3066. -------------------------------------------------------------- }
  3067. function TRegExpr.HexDig(Ch: REChar): integer;
  3068. begin
  3069. case Ch of
  3070. '0' .. '9':
  3071. Result := Ord(Ch) - Ord('0');
  3072. 'a' .. 'f':
  3073. Result := Ord(Ch) - Ord('a') + 10;
  3074. 'A' .. 'F':
  3075. Result := Ord(Ch) - Ord('A') + 10;
  3076. else
  3077. begin
  3078. Result := 0;
  3079. Error(reeBadHexDigit);
  3080. end;
  3081. end;
  3082. end;
  3083. function TRegExpr.UnQuoteChar(var APtr, AEnd: PRegExprChar): REChar;
  3084. var
  3085. Ch: REChar;
  3086. begin
  3087. case APtr^ of
  3088. 't':
  3089. Result := #$9; // \t => tab (HT/TAB)
  3090. 'n':
  3091. Result := #$a; // \n => newline (NL)
  3092. 'r':
  3093. Result := #$d; // \r => carriage return (CR)
  3094. 'f':
  3095. Result := #$c; // \f => form feed (FF)
  3096. 'a':
  3097. Result := #$7; // \a => alarm (bell) (BEL)
  3098. 'e':
  3099. Result := #$1b; // \e => escape (ESC)
  3100. 'c':
  3101. begin // \cK => code for Ctrl+K
  3102. Result := #0;
  3103. Inc(APtr);
  3104. if APtr >= AEnd then
  3105. Error(reeNoLetterAfterBSlashC);
  3106. Ch := APtr^;
  3107. case Ch of
  3108. 'a' .. 'z':
  3109. Result := REChar(Ord(Ch) - Ord('a') + 1);
  3110. 'A' .. 'Z':
  3111. Result := REChar(Ord(Ch) - Ord('A') + 1);
  3112. else
  3113. Error(reeNoLetterAfterBSlashC);
  3114. end;
  3115. end;
  3116. 'x':
  3117. begin // \x: hex char
  3118. Result := #0;
  3119. Inc(APtr);
  3120. if APtr >= AEnd then
  3121. begin
  3122. Error(reeNoHexCodeAfterBSlashX);
  3123. Exit;
  3124. end;
  3125. if APtr^ = '{' then
  3126. begin // \x{nnnn} //###0.936
  3127. repeat
  3128. Inc(APtr);
  3129. if APtr >= AEnd then
  3130. begin
  3131. Error(reeNoHexCodeAfterBSlashX);
  3132. Exit;
  3133. end;
  3134. if APtr^ <> '}' then
  3135. begin
  3136. if (Ord(Result) ShR (SizeOf(REChar) * 8 - 4)) and $F <> 0 then
  3137. begin
  3138. Error(reeHexCodeAfterBSlashXTooBig);
  3139. Exit;
  3140. end;
  3141. Result := REChar((Ord(Result) ShL 4) or HexDig(APtr^));
  3142. // HexDig will cause Error if bad hex digit found
  3143. end
  3144. else
  3145. Break;
  3146. until False;
  3147. end
  3148. else
  3149. begin
  3150. Result := REChar(HexDig(APtr^));
  3151. // HexDig will cause Error if bad hex digit found
  3152. Inc(APtr);
  3153. if APtr >= AEnd then
  3154. begin
  3155. Error(reeNoHexCodeAfterBSlashX);
  3156. Exit;
  3157. end;
  3158. Result := REChar((Ord(Result) ShL 4) or HexDig(APtr^));
  3159. // HexDig will cause Error if bad hex digit found
  3160. end;
  3161. end;
  3162. else
  3163. begin
  3164. Result := APtr^;
  3165. if (Result <> '_') and IsWordChar(Result) then
  3166. begin
  3167. fLastErrorSymbol := Result;
  3168. Error(reeUnknownMetaSymbol);
  3169. end;
  3170. end;
  3171. end;
  3172. end;
  3173. function TRegExpr.ParseAtom(var FlagParse: integer): PRegExprChar;
  3174. // the lowest level
  3175. // Optimization: gobbles an entire sequence of ordinary characters so that
  3176. // it can turn them into a single node, which is smaller to store and
  3177. // faster to run. Backslashed characters are exceptions, each becoming a
  3178. // separate node; the code is simpler that way and it's not worth fixing.
  3179. var
  3180. ret: PRegExprChar;
  3181. RangeBeg, RangeEnd: REChar;
  3182. CanBeRange: boolean;
  3183. AddrOfLen: PLongInt;
  3184. procedure EmitExactly(Ch: REChar);
  3185. begin
  3186. if fCompModifiers.I then
  3187. ret := EmitNode(OP_EXACTLYCI)
  3188. else
  3189. ret := EmitNode(OP_EXACTLY);
  3190. EmitInt(1);
  3191. EmitC(Ch);
  3192. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3193. end;
  3194. procedure EmitRangeChar(Ch: REChar; AStartOfRange: boolean);
  3195. begin
  3196. CanBeRange := AStartOfRange;
  3197. if fCompModifiers.I then
  3198. Ch := _UpperCase(Ch);
  3199. if AStartOfRange then
  3200. begin
  3201. AddrOfLen := nil;
  3202. RangeBeg := Ch;
  3203. end
  3204. else
  3205. begin
  3206. if AddrOfLen = nil then
  3207. begin
  3208. EmitC(OpKind_Char);
  3209. Pointer(AddrOfLen) := regCode;
  3210. EmitInt(0);
  3211. end;
  3212. Inc(AddrOfLen^);
  3213. EmitC(Ch);
  3214. end;
  3215. end;
  3216. procedure EmitRangePacked(ch1, ch2: REChar);
  3217. var
  3218. ChkIndex: integer;
  3219. begin
  3220. AddrOfLen := nil;
  3221. CanBeRange := False;
  3222. if fCompModifiers.I then
  3223. begin
  3224. ch1 := _UpperCase(ch1);
  3225. ch2 := _UpperCase(ch2);
  3226. end;
  3227. for ChkIndex := Low(CharCheckerInfos) to High(CharCheckerInfos) do
  3228. if (CharCheckerInfos[ChkIndex].CharBegin = ch1) and
  3229. (CharCheckerInfos[ChkIndex].CharEnd = ch2) then
  3230. begin
  3231. EmitC(OpKind_MetaClass);
  3232. EmitC(REChar(CharCheckerInfos[ChkIndex].CheckerIndex));
  3233. Exit;
  3234. end;
  3235. EmitC(OpKind_Range);
  3236. EmitC(ch1);
  3237. EmitC(ch2);
  3238. end;
  3239. {$IFDEF FastUnicodeData}
  3240. procedure EmitCategoryInCharClass(APositive: boolean);
  3241. var
  3242. ch, ch2: REChar;
  3243. begin
  3244. AddrOfLen := nil;
  3245. CanBeRange := False;
  3246. Inc(regParse);
  3247. FindCategoryName(regParse, ch, ch2);
  3248. if APositive then
  3249. EmitC(OpKind_CategoryYes)
  3250. else
  3251. EmitC(OpKind_CategoryNo);
  3252. EmitC(ch);
  3253. EmitC(ch2);
  3254. end;
  3255. {$ENDIF}
  3256. var
  3257. FlagTemp: integer;
  3258. Len: integer;
  3259. SavedPtr: PRegExprChar;
  3260. EnderChar, TempChar: REChar;
  3261. DashForRange: Boolean;
  3262. GrpKind: TREGroupKind;
  3263. GrpName: RegExprString;
  3264. GrpIndex: integer;
  3265. NextCh: REChar;
  3266. begin
  3267. Result := nil;
  3268. FlagTemp := 0;
  3269. FlagParse := FLAG_WORST;
  3270. AddrOfLen := nil;
  3271. Inc(regParse);
  3272. case (regParse - 1)^ of
  3273. '^':
  3274. begin
  3275. if not fCompModifiers.M
  3276. {$IFDEF UseLineSep} or (fLineSeparators = '') {$ENDIF} then
  3277. ret := EmitNode(OP_BOL)
  3278. else
  3279. ret := EmitNode(OP_BOLML);
  3280. end;
  3281. '$':
  3282. begin
  3283. if not fCompModifiers.M
  3284. {$IFDEF UseLineSep} or (fLineSeparators = '') {$ENDIF} then
  3285. ret := EmitNode(OP_EOL)
  3286. else
  3287. ret := EmitNode(OP_EOLML);
  3288. end;
  3289. '.':
  3290. begin
  3291. if fCompModifiers.S then
  3292. begin
  3293. ret := EmitNode(OP_ANY);
  3294. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3295. end
  3296. else
  3297. begin // not /s, so emit [^:LineSeparators:]
  3298. ret := EmitNode(OP_ANYML);
  3299. FlagParse := FlagParse or FLAG_HASWIDTH; // not so simple ;)
  3300. end;
  3301. end;
  3302. '[':
  3303. begin
  3304. if regParse^ = '^' then
  3305. begin // Complement of range.
  3306. if fCompModifiers.I then
  3307. ret := EmitNode(OP_ANYBUTCI)
  3308. else
  3309. ret := EmitNode(OP_ANYBUT);
  3310. Inc(regParse);
  3311. end
  3312. else if fCompModifiers.I then
  3313. ret := EmitNode(OP_ANYOFCI)
  3314. else
  3315. ret := EmitNode(OP_ANYOF);
  3316. CanBeRange := False;
  3317. if regParse^ = ']' then
  3318. begin
  3319. // first ']' inside [] treated as simple char, no need to check '['
  3320. EmitRangeChar(regParse^, (regParse + 1)^ = '-');
  3321. Inc(regParse);
  3322. end;
  3323. while (regParse < fRegexEnd) and (regParse^ <> ']') do
  3324. begin
  3325. // last '-' inside [] treated as simple dash
  3326. if (regParse^ = '-') and
  3327. ((regParse + 1) < fRegexEnd) and
  3328. ((regParse + 1)^ = ']') then
  3329. begin
  3330. EmitRangeChar('-', False);
  3331. Inc(regParse);
  3332. Break;
  3333. end;
  3334. // char '-' which (maybe) makes a range
  3335. if (regParse^ = '-') and ((regParse + 1) < fRegexEnd) and CanBeRange then
  3336. begin
  3337. Inc(regParse);
  3338. RangeEnd := regParse^;
  3339. if RangeEnd = EscChar then
  3340. begin
  3341. if _IsMetaChar((regParse + 1)^) then
  3342. begin
  3343. Error(reeMetaCharAfterMinusInRange);
  3344. Exit;
  3345. end;
  3346. Inc(regParse);
  3347. RangeEnd := UnQuoteChar(regParse, fRegexEnd);
  3348. end;
  3349. // special handling for Russian range a-YA, add 2 ranges: a-ya and A-YA
  3350. if fCompModifiers.R and
  3351. (RangeBeg = RusRangeLoLow) and (RangeEnd = RusRangeHiHigh) then
  3352. begin
  3353. EmitRangePacked(RusRangeLoLow, RusRangeLoHigh);
  3354. EmitRangePacked(RusRangeHiLow, RusRangeHiHigh);
  3355. end
  3356. else
  3357. begin // standard r.e. handling
  3358. if RangeBeg > RangeEnd then
  3359. begin
  3360. Error(reeInvalidRange);
  3361. Exit;
  3362. end;
  3363. EmitRangePacked(RangeBeg, RangeEnd);
  3364. end;
  3365. Inc(regParse);
  3366. end
  3367. else
  3368. begin
  3369. if regParse^ = EscChar then
  3370. begin
  3371. Inc(regParse);
  3372. if regParse >= fRegexEnd then
  3373. begin
  3374. Error(reeParseAtomTrailingBackSlash);
  3375. Exit;
  3376. end;
  3377. if _IsMetaChar(regParse^) then
  3378. begin
  3379. AddrOfLen := nil;
  3380. CanBeRange := False;
  3381. EmitC(OpKind_MetaClass);
  3382. case regParse^ of
  3383. 'w':
  3384. EmitC(REChar(CheckerIndex_Word));
  3385. 'W':
  3386. EmitC(REChar(CheckerIndex_NotWord));
  3387. 's':
  3388. EmitC(REChar(CheckerIndex_Space));
  3389. 'S':
  3390. EmitC(REChar(CheckerIndex_NotSpace));
  3391. 'd':
  3392. EmitC(REChar(CheckerIndex_Digit));
  3393. 'D':
  3394. EmitC(REChar(CheckerIndex_NotDigit));
  3395. 'v':
  3396. EmitC(REChar(CheckerIndex_VertSep));
  3397. 'V':
  3398. EmitC(REChar(CheckerIndex_NotVertSep));
  3399. 'h':
  3400. EmitC(REChar(CheckerIndex_HorzSep));
  3401. 'H':
  3402. EmitC(REChar(CheckerIndex_NotHorzSep));
  3403. else
  3404. Error(reeBadOpcodeInCharClass);
  3405. end;
  3406. end
  3407. else
  3408. {$IFDEF FastUnicodeData}
  3409. if regParse^ = 'p' then
  3410. EmitCategoryInCharClass(True)
  3411. else
  3412. if regParse^ = 'P' then
  3413. EmitCategoryInCharClass(False)
  3414. else
  3415. {$ENDIF}
  3416. begin
  3417. TempChar := UnQuoteChar(regParse, fRegexEnd);
  3418. // False if '-' is last char in []
  3419. DashForRange :=
  3420. (regParse + 2 < fRegexEnd) and
  3421. ((regParse + 1)^ = '-') and
  3422. ((regParse + 2)^ <> ']');
  3423. EmitRangeChar(TempChar, DashForRange);
  3424. end;
  3425. end
  3426. else
  3427. begin
  3428. // False if '-' is last char in []
  3429. DashForRange :=
  3430. (regParse + 2 < fRegexEnd) and
  3431. ((regParse + 1)^ = '-') and
  3432. ((regParse + 2)^ <> ']');
  3433. EmitRangeChar(regParse^, DashForRange);
  3434. end;
  3435. Inc(regParse);
  3436. end;
  3437. end; { of while }
  3438. AddrOfLen := nil;
  3439. CanBeRange := False;
  3440. EmitC(OpKind_End);
  3441. if regParse^ <> ']' then
  3442. begin
  3443. Error(reeUnmatchedSqBrackets);
  3444. Exit;
  3445. end;
  3446. Inc(regParse);
  3447. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3448. end;
  3449. '(':
  3450. begin
  3451. GrpKind := gkNormalGroup;
  3452. GrpName := '';
  3453. // A: detect kind of expression in brackets
  3454. if regParse^ = '?' then
  3455. begin
  3456. NextCh := (regParse + 1)^;
  3457. case NextCh of
  3458. ':':
  3459. begin
  3460. // non-capturing group: (?:regex)
  3461. GrpKind := gkNonCapturingGroup;
  3462. Inc(regParse, 2);
  3463. end;
  3464. '>':
  3465. begin
  3466. // atomic group: (?>regex)
  3467. GrpKind := gkNonCapturingGroup;
  3468. Inc(regParse, 2);
  3469. GrpAtomic[regNumBrackets] := True;
  3470. end;
  3471. 'P':
  3472. begin
  3473. if (regParse + 4 >= fRegexEnd) then
  3474. Error(reeNamedGroupBad);
  3475. case (regParse + 2)^ of
  3476. '<':
  3477. begin
  3478. // named group: (?P<name>regex)
  3479. GrpKind := gkNormalGroup;
  3480. FindGroupName(regParse + 3, fRegexEnd, '>', GrpName);
  3481. Inc(regParse, Length(GrpName) + 4);
  3482. end;
  3483. '=':
  3484. begin
  3485. // back-reference to named group: (?P=name)
  3486. GrpKind := gkNamedGroupReference;
  3487. FindGroupName(regParse + 3, fRegexEnd, ')', GrpName);
  3488. Inc(regParse, Length(GrpName) + 4);
  3489. end;
  3490. '>':
  3491. begin
  3492. // subroutine call to named group: (?P>name)
  3493. GrpKind := gkSubCall;
  3494. FindGroupName(regParse + 3, fRegexEnd, ')', GrpName);
  3495. Inc(regParse, Length(GrpName) + 4);
  3496. GrpIndex := MatchIndexFromName(GrpName);
  3497. if GrpIndex < 1 then
  3498. Error(reeNamedGroupBadRef);
  3499. end;
  3500. else
  3501. Error(reeNamedGroupBad);
  3502. end;
  3503. end;
  3504. '<':
  3505. begin
  3506. // lookbehind: (?<=foo)bar
  3507. if (regParse + 4 >= fRegexEnd) then
  3508. Error(reeLookbehindBad);
  3509. case (regParse + 2)^ of
  3510. '=':
  3511. begin
  3512. // allow lookbehind only at the beginning
  3513. if regParse <> fRegexStart + 1 then
  3514. Error(reeLookaroundNotAtEdge);
  3515. GrpKind := gkLookbehind;
  3516. GrpAtomic[regNumBrackets] := RegExprLookbehindIsAtomic;
  3517. regLookbehind := True;
  3518. Inc(regParse, 3);
  3519. end;
  3520. '!':
  3521. begin
  3522. // allow lookbehind only at the beginning
  3523. if regParse <> fRegexStart + 1 then
  3524. Error(reeLookaroundNotAtEdge);
  3525. GrpKind := gkLookbehindNeg;
  3526. Inc(regParse, 3);
  3527. SavedPtr := _FindClosingBracket(regParse, fRegexEnd);
  3528. if SavedPtr = nil then
  3529. Error(reeCompParseRegUnmatchedBrackets);
  3530. // for '(?<!foo)bar', we make our regex 'bar' and make Helper object with 'foo'
  3531. if not fSecondPass then
  3532. begin
  3533. Len := SavedPtr - fRegexStart - 4;
  3534. if Len = 0 then
  3535. Error(reeLookbehindBad);
  3536. if fHelper = nil then
  3537. fHelper := TRegExpr.Create;
  3538. fHelper.Expression := Copy(fExpression, 5, Len);
  3539. try
  3540. fHelper.Compile;
  3541. except
  3542. Len := fHelper.LastError;
  3543. FreeAndNil(fHelper);
  3544. Error(Len);
  3545. end;
  3546. if fHelper.IsFixedLength(TempChar, Len) then
  3547. fHelperLen := Len
  3548. else
  3549. begin
  3550. FreeAndNil(fHelper);
  3551. Error(reeLookbehindTooComplex);
  3552. end;
  3553. end;
  3554. // jump to closing bracket, don't make opcode for (?<!foo)
  3555. regParse := SavedPtr + 1;
  3556. end;
  3557. else
  3558. Error(reeLookbehindBad);
  3559. end;
  3560. end;
  3561. '=', '!':
  3562. begin
  3563. // lookaheads: foo(?=bar) and foo(?!bar)
  3564. if (regParse + 3 >= fRegexEnd) then
  3565. Error(reeLookaheadBad);
  3566. regLookahead := True;
  3567. regLookaheadGroup := regNumBrackets;
  3568. if NextCh = '=' then
  3569. begin
  3570. GrpKind := gkLookahead;
  3571. end
  3572. else
  3573. begin
  3574. GrpKind := gkLookaheadNeg;
  3575. regLookaheadNeg := True;
  3576. end;
  3577. GrpAtomic[regNumBrackets] := RegExprLookaheadIsAtomic;
  3578. // check that these brackets are last in regex
  3579. SavedPtr := _FindClosingBracket(regParse + 1, fRegexEnd);
  3580. if (SavedPtr <> fRegexEnd - 1) then
  3581. Error(reeLookaroundNotAtEdge);
  3582. Inc(regParse, 2);
  3583. end;
  3584. '#':
  3585. begin
  3586. // (?#comment)
  3587. GrpKind := gkComment;
  3588. Inc(regParse, 2);
  3589. end;
  3590. 'a'..'z', '-':
  3591. begin
  3592. // modifiers string like (?mxr)
  3593. GrpKind := gkModifierString;
  3594. Inc(regParse);
  3595. end;
  3596. 'R', '0':
  3597. begin
  3598. // recursion (?R), (?0)
  3599. GrpKind := gkRecursion;
  3600. Inc(regParse, 2);
  3601. if regParse^ <> ')' then
  3602. Error(reeBadRecursion);
  3603. Inc(regParse);
  3604. end;
  3605. '1'..'9':
  3606. begin
  3607. // subroutine call (?1)..(?99)
  3608. GrpKind := gkSubCall;
  3609. GrpIndex := Ord(NextCh) - Ord('0');
  3610. Inc(regParse, 2);
  3611. // support 2-digit group numbers
  3612. case regParse^ of
  3613. ')':
  3614. begin
  3615. Inc(regParse);
  3616. end;
  3617. '0'..'9':
  3618. begin
  3619. GrpIndex := GrpIndex * 10 + Ord(regParse^) - Ord('0');
  3620. if GrpIndex >= RegexMaxGroups then
  3621. Error(reeBadSubCall);
  3622. Inc(regParse);
  3623. if regParse^ <> ')' then
  3624. Error(reeBadSubCall);
  3625. Inc(regParse);
  3626. end
  3627. else
  3628. Error(reeBadRecursion);
  3629. end;
  3630. end;
  3631. '''':
  3632. begin
  3633. // named group: (?'name'regex)
  3634. if (regParse + 4 >= fRegexEnd) then
  3635. Error(reeNamedGroupBad);
  3636. GrpKind := gkNormalGroup;
  3637. FindGroupName(regParse + 2, fRegexEnd, '''', GrpName);
  3638. Inc(regParse, Length(GrpName) + 3);
  3639. end;
  3640. '&':
  3641. begin
  3642. // subroutine call to named group: (?&name)
  3643. if (regParse + 2 >= fRegexEnd) then
  3644. Error(reeBadSubCall);
  3645. GrpKind := gkSubCall;
  3646. FindGroupName(regParse + 2, fRegexEnd, ')', GrpName);
  3647. Inc(regParse, Length(GrpName) + 3);
  3648. GrpIndex := MatchIndexFromName(GrpName);
  3649. if GrpIndex < 1 then
  3650. Error(reeNamedGroupBadRef);
  3651. end;
  3652. else
  3653. Error(reeIncorrectSpecialBrackets);
  3654. end;
  3655. end;
  3656. // B: process found kind of brackets
  3657. case GrpKind of
  3658. gkNormalGroup,
  3659. gkNonCapturingGroup,
  3660. gkLookahead,
  3661. gkLookaheadNeg,
  3662. gkLookbehind:
  3663. begin
  3664. // skip this block for one of passes, to not double groups count;
  3665. // must take first pass (we need GrpNames filled)
  3666. if (GrpKind = gkNormalGroup) and not fSecondPass then
  3667. if GrpCount < RegexMaxGroups - 1 then
  3668. begin
  3669. Inc(GrpCount);
  3670. GrpIndexes[GrpCount] := regNumBrackets;
  3671. if GrpName <> '' then
  3672. begin
  3673. if MatchIndexFromName(GrpName) >= 0 then
  3674. Error(reeNamedGroupDupName);
  3675. GrpNames[GrpCount] := GrpName;
  3676. end;
  3677. end;
  3678. ret := ParseReg(True, FlagTemp);
  3679. if ret = nil then
  3680. begin
  3681. Result := nil;
  3682. Exit;
  3683. end;
  3684. FlagParse := FlagParse or FlagTemp and (FLAG_HASWIDTH or FLAG_SPECSTART);
  3685. end;
  3686. gkLookbehindNeg:
  3687. begin
  3688. // don't make opcode
  3689. ret := EmitNode(OP_COMMENT);
  3690. FlagParse := FLAG_WORST;
  3691. end;
  3692. gkNamedGroupReference:
  3693. begin
  3694. Len := MatchIndexFromName(GrpName);
  3695. if Len < 0 then
  3696. Error(reeNamedGroupBadRef);
  3697. ret := EmitGroupRef(Len, fCompModifiers.I);
  3698. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3699. end;
  3700. gkModifierString:
  3701. begin
  3702. SavedPtr := regParse;
  3703. while (regParse < fRegexEnd) and (regParse^ <> ')') do
  3704. Inc(regParse);
  3705. if (regParse^ <> ')') or
  3706. not ParseModifiers(SavedPtr, regParse - SavedPtr, fCompModifiers) then
  3707. begin
  3708. Error(reeUnrecognizedModifier);
  3709. Exit;
  3710. end;
  3711. Inc(regParse); // skip ')'
  3712. ret := EmitNode(OP_COMMENT); // comment
  3713. // Error (reeQuantifFollowsNothing);
  3714. // Exit;
  3715. end;
  3716. gkComment:
  3717. begin
  3718. while (regParse < fRegexEnd) and (regParse^ <> ')') do
  3719. Inc(regParse);
  3720. if regParse^ <> ')' then
  3721. begin
  3722. Error(reeUnclosedComment);
  3723. Exit;
  3724. end;
  3725. Inc(regParse); // skip ')'
  3726. ret := EmitNode(OP_COMMENT); // comment
  3727. end;
  3728. gkRecursion:
  3729. begin
  3730. // set FLAG_HASWIDTH to allow compiling of such regex: b(?:m|(?R))*e
  3731. FlagParse := FlagParse or FLAG_HASWIDTH;
  3732. ret := EmitNode(OP_RECUR);
  3733. end;
  3734. gkSubCall:
  3735. begin
  3736. // set FLAG_HASWIDTH like for (?R)
  3737. FlagParse := FlagParse or FLAG_HASWIDTH;
  3738. ret := EmitNode(TReOp(Ord(OP_SUBCALL) + GrpIndex));
  3739. end;
  3740. end; // case GrpKind of
  3741. end;
  3742. '|', ')':
  3743. begin // Supposed to be caught earlier.
  3744. Error(reeInternalUrp);
  3745. Exit;
  3746. end;
  3747. '?', '+', '*':
  3748. begin
  3749. Error(reeQuantifFollowsNothing);
  3750. Exit;
  3751. end;
  3752. EscChar:
  3753. begin
  3754. if regParse >= fRegexEnd then
  3755. begin
  3756. Error(reeTrailingBackSlash);
  3757. Exit;
  3758. end;
  3759. case regParse^ of
  3760. 'b':
  3761. ret := EmitNode(OP_BOUND);
  3762. 'B':
  3763. ret := EmitNode(OP_NOTBOUND);
  3764. 'A':
  3765. ret := EmitNode(OP_BOL);
  3766. 'z':
  3767. ret := EmitNode(OP_EOL);
  3768. 'Z':
  3769. ret := EmitNode(OP_EOL2);
  3770. 'd':
  3771. begin // r.e.extension - any digit ('0' .. '9')
  3772. ret := EmitNode(OP_ANYDIGIT);
  3773. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3774. end;
  3775. 'D':
  3776. begin // r.e.extension - not digit ('0' .. '9')
  3777. ret := EmitNode(OP_NOTDIGIT);
  3778. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3779. end;
  3780. 's':
  3781. begin // r.e.extension - any space char
  3782. ret := EmitNode(OP_ANYSPACE);
  3783. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3784. end;
  3785. 'S':
  3786. begin // r.e.extension - not space char
  3787. ret := EmitNode(OP_NOTSPACE);
  3788. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3789. end;
  3790. 'w':
  3791. begin // r.e.extension - any english char / digit / '_'
  3792. ret := EmitNode(OP_ANYLETTER);
  3793. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3794. end;
  3795. 'W':
  3796. begin // r.e.extension - not english char / digit / '_'
  3797. ret := EmitNode(OP_NOTLETTER);
  3798. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3799. end;
  3800. 'v':
  3801. begin
  3802. ret := EmitNode(OP_ANYVERTSEP);
  3803. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3804. end;
  3805. 'V':
  3806. begin
  3807. ret := EmitNode(OP_NOTVERTSEP);
  3808. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3809. end;
  3810. 'h':
  3811. begin
  3812. ret := EmitNode(OP_ANYHORZSEP);
  3813. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3814. end;
  3815. 'H':
  3816. begin
  3817. ret := EmitNode(OP_NOTHORZSEP);
  3818. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3819. end;
  3820. '1' .. '9':
  3821. begin
  3822. ret := EmitGroupRef(Ord(regParse^) - Ord('0'), fCompModifiers.I);
  3823. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3824. end;
  3825. {$IFDEF FastUnicodeData}
  3826. 'p':
  3827. begin
  3828. ret := EmitCategoryMain(True);
  3829. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3830. end;
  3831. 'P':
  3832. begin
  3833. ret := EmitCategoryMain(False);
  3834. FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  3835. end;
  3836. {$ENDIF}
  3837. else
  3838. EmitExactly(UnQuoteChar(regParse, fRegexEnd));
  3839. end; { of case }
  3840. Inc(regParse);
  3841. end;
  3842. else
  3843. begin
  3844. Dec(regParse);
  3845. if fCompModifiers.X and // check for eXtended syntax
  3846. ((regParse^ = '#') or IsIgnoredChar(regParse^)) then
  3847. begin // ###0.941 \x
  3848. if regParse^ = '#' then
  3849. begin // Skip eXtended comment
  3850. // find comment terminator (group of \n and/or \r)
  3851. while (regParse < fRegexEnd) and (regParse^ <> #$d) and
  3852. (regParse^ <> #$a) do
  3853. Inc(regParse);
  3854. while (regParse^ = #$d) or (regParse^ = #$a)
  3855. // skip comment terminator
  3856. do
  3857. Inc(regParse);
  3858. // attempt to support different type of line separators
  3859. end
  3860. else
  3861. begin // Skip the blanks!
  3862. while IsIgnoredChar(regParse^) do
  3863. Inc(regParse);
  3864. end;
  3865. ret := EmitNode(OP_COMMENT); // comment
  3866. end
  3867. else
  3868. begin
  3869. Len := FindSkippedMetaLen(regParse, fRegexEnd);
  3870. if Len <= 0 then
  3871. if regParse^ <> '{' then
  3872. begin
  3873. Error(reeRarseAtomInternalDisaster);
  3874. Exit;
  3875. end
  3876. else
  3877. Len := FindSkippedMetaLen(regParse + 1, fRegexEnd) + 1;
  3878. // bad {n,m} - compile as EXACTLY
  3879. EnderChar := (regParse + Len)^;
  3880. if (Len > 1) and ((EnderChar = '*') or (EnderChar = '+') or (EnderChar = '?') or (EnderChar = '{')) then
  3881. Dec(Len); // back off clear of ?+*{ operand.
  3882. FlagParse := FlagParse or FLAG_HASWIDTH;
  3883. if Len = 1 then
  3884. FlagParse := FlagParse or FLAG_SIMPLE;
  3885. if fCompModifiers.I then
  3886. ret := EmitNode(OP_EXACTLYCI)
  3887. else
  3888. ret := EmitNode(OP_EXACTLY);
  3889. EmitInt(0);
  3890. while (Len > 0) and ((not fCompModifiers.X) or (regParse^ <> '#')) do
  3891. begin
  3892. if not fCompModifiers.X or not IsIgnoredChar(regParse^) then
  3893. begin
  3894. EmitC(regParse^);
  3895. if regCode <> @regDummy then
  3896. Inc(regExactlyLen^);
  3897. end;
  3898. Inc(regParse);
  3899. Dec(Len);
  3900. end;
  3901. end; { of if not comment }
  3902. end; { of case else }
  3903. end; { of case }
  3904. Result := ret;
  3905. end; { of function TRegExpr.ParseAtom
  3906. -------------------------------------------------------------- }
  3907. function TRegExpr.GetCompilerErrorPos: PtrInt;
  3908. begin
  3909. Result := 0;
  3910. if (fRegexStart = nil) or (regParse = nil) then
  3911. Exit; // not in compiling mode ?
  3912. Result := regParse - fRegexStart;
  3913. end; { of function TRegExpr.GetCompilerErrorPos
  3914. -------------------------------------------------------------- }
  3915. { ============================================================= }
  3916. { ===================== Matching section ====================== }
  3917. { ============================================================= }
  3918. procedure TRegExpr.FindGroupName(APtr, AEndPtr: PRegExprChar; AEndChar: REChar; var AName: RegExprString);
  3919. // check that group name is valid identifier, started from non-digit
  3920. // this is to be like in Python regex
  3921. var
  3922. P: PRegExprChar;
  3923. begin
  3924. P := APtr;
  3925. if IsDigitChar(P^) or not IsWordChar(P^) then
  3926. Error(reeNamedGroupBadName);
  3927. repeat
  3928. if P >= AEndPtr then
  3929. Error(reeNamedGroupBad);
  3930. if P^ = AEndChar then
  3931. Break;
  3932. if not IsWordChar(P^) then
  3933. Error(reeNamedGroupBadName);
  3934. Inc(P);
  3935. until False;
  3936. SetString(AName, APtr, P-APtr);
  3937. end;
  3938. function TRegExpr.FindRepeated(p: PRegExprChar; AMax: integer): integer;
  3939. // repeatedly match something simple, report how many
  3940. // p: points to current opcode
  3941. var
  3942. scan: PRegExprChar;
  3943. opnd: PRegExprChar;
  3944. TheMax: PtrInt; // PtrInt, gets diff of 2 pointers
  3945. InvChar: REChar;
  3946. CurStart, CurEnd: PRegExprChar;
  3947. ArrayIndex, i: integer;
  3948. begin
  3949. Result := 0;
  3950. scan := regInput; // points into InputString
  3951. opnd := p + REOpSz + RENextOffSz; // points to operand of opcode (after OP_nnn code)
  3952. TheMax := fInputEnd - scan;
  3953. if TheMax > AMax then
  3954. TheMax := AMax;
  3955. case PREOp(p)^ of
  3956. OP_ANY:
  3957. begin
  3958. // note - OP_ANYML cannot be proceeded in FindRepeated because can skip
  3959. // more than one char at once
  3960. {$IFDEF UnicodeEx}
  3961. for i := 1 to TheMax do
  3962. IncUnicode2(scan, Result);
  3963. {$ELSE}
  3964. Result := TheMax;
  3965. Inc(scan, Result);
  3966. {$ENDIF}
  3967. end;
  3968. OP_EXACTLY:
  3969. begin // in opnd can be only ONE char !!!
  3970. {
  3971. // Alexey: commented because of https://github.com/andgineer/TRegExpr/issues/145
  3972. NLen := PLongInt(opnd)^;
  3973. if TheMax > NLen then
  3974. TheMax := NLen;
  3975. }
  3976. Inc(opnd, RENumberSz);
  3977. while (Result < TheMax) and (opnd^ = scan^) do
  3978. begin
  3979. Inc(Result);
  3980. Inc(scan);
  3981. end;
  3982. end;
  3983. OP_EXACTLYCI:
  3984. begin // in opnd can be only ONE char !!!
  3985. {
  3986. // Alexey: commented because of https://github.com/andgineer/TRegExpr/issues/145
  3987. NLen := PLongInt(opnd)^;
  3988. if TheMax > NLen then
  3989. TheMax := NLen;
  3990. }
  3991. Inc(opnd, RENumberSz);
  3992. while (Result < TheMax) and (opnd^ = scan^) do
  3993. begin // prevent unneeded InvertCase //###0.931
  3994. Inc(Result);
  3995. Inc(scan);
  3996. end;
  3997. if Result < TheMax then
  3998. begin // ###0.931
  3999. InvChar := InvertCase(opnd^); // store in register
  4000. while (Result < TheMax) and ((opnd^ = scan^) or (InvChar = scan^)) do
  4001. begin
  4002. Inc(Result);
  4003. Inc(scan);
  4004. end;
  4005. end;
  4006. end;
  4007. OP_BSUBEXP:
  4008. begin // ###0.936
  4009. ArrayIndex := GrpIndexes[Ord(opnd^)];
  4010. if ArrayIndex < 0 then
  4011. Exit;
  4012. CurStart := GrpStart[ArrayIndex];
  4013. if CurStart = nil then
  4014. Exit;
  4015. CurEnd := GrpEnd[ArrayIndex];
  4016. if CurEnd = nil then
  4017. Exit;
  4018. repeat
  4019. opnd := CurStart;
  4020. while opnd < CurEnd do
  4021. begin
  4022. if (scan >= fInputEnd) or (scan^ <> opnd^) then
  4023. Exit;
  4024. Inc(scan);
  4025. Inc(opnd);
  4026. end;
  4027. Inc(Result);
  4028. regInput := scan;
  4029. until Result >= AMax;
  4030. end;
  4031. OP_BSUBEXPCI:
  4032. begin // ###0.936
  4033. ArrayIndex := GrpIndexes[Ord(opnd^)];
  4034. if ArrayIndex < 0 then
  4035. Exit;
  4036. CurStart := GrpStart[ArrayIndex];
  4037. if CurStart = nil then
  4038. Exit;
  4039. CurEnd := GrpEnd[ArrayIndex];
  4040. if CurEnd = nil then
  4041. Exit;
  4042. repeat
  4043. opnd := CurStart;
  4044. while opnd < CurEnd do
  4045. begin
  4046. if (scan >= fInputEnd) or
  4047. ((scan^ <> opnd^) and (scan^ <> InvertCase(opnd^))) then
  4048. Exit;
  4049. Inc(scan);
  4050. Inc(opnd);
  4051. end;
  4052. Inc(Result);
  4053. regInput := scan;
  4054. until Result >= AMax;
  4055. end;
  4056. OP_ANYDIGIT:
  4057. while (Result < TheMax) and IsDigitChar(scan^) do
  4058. begin
  4059. Inc(Result);
  4060. Inc(scan);
  4061. end;
  4062. OP_NOTDIGIT:
  4063. {$IFDEF UNICODEEX}
  4064. begin
  4065. i := 0;
  4066. while (i < TheMax) and not IsDigitChar(scan^) do
  4067. begin
  4068. Inc(i);
  4069. IncUnicode2(scan, Result);
  4070. end;
  4071. end;
  4072. {$ELSE}
  4073. while (Result < TheMax) and not IsDigitChar(scan^) do
  4074. begin
  4075. Inc(Result);
  4076. Inc(scan);
  4077. end;
  4078. {$ENDIF}
  4079. OP_ANYLETTER:
  4080. while (Result < TheMax) and IsWordChar(scan^) do // ###0.940
  4081. begin
  4082. Inc(Result);
  4083. Inc(scan);
  4084. end;
  4085. OP_NOTLETTER:
  4086. {$IFDEF UNICODEEX}
  4087. begin
  4088. i := 0;
  4089. while (i < TheMax) and not IsWordChar(scan^) do
  4090. begin
  4091. Inc(i);
  4092. IncUnicode2(scan, Result);
  4093. end;
  4094. end;
  4095. {$ELSE}
  4096. while (Result < TheMax) and not IsWordChar(scan^) do // ###0.940
  4097. begin
  4098. Inc(Result);
  4099. Inc(scan);
  4100. end;
  4101. {$ENDIF}
  4102. OP_ANYSPACE:
  4103. while (Result < TheMax) and IsSpaceChar(scan^) do
  4104. begin
  4105. Inc(Result);
  4106. Inc(scan);
  4107. end;
  4108. OP_NOTSPACE:
  4109. {$IFDEF UNICODEEX}
  4110. begin
  4111. i := 0;
  4112. while (i < TheMax) and not IsSpaceChar(scan^) do
  4113. begin
  4114. Inc(i);
  4115. IncUnicode2(scan, Result);
  4116. end;
  4117. end;
  4118. {$ELSE}
  4119. while (Result < TheMax) and not IsSpaceChar(scan^) do
  4120. begin
  4121. Inc(Result);
  4122. Inc(scan);
  4123. end;
  4124. {$ENDIF}
  4125. OP_ANYVERTSEP:
  4126. while (Result < TheMax) and IsVertLineSeparator(scan^) do
  4127. begin
  4128. Inc(Result);
  4129. Inc(scan);
  4130. end;
  4131. OP_NOTVERTSEP:
  4132. {$IFDEF UNICODEEX}
  4133. begin
  4134. i := 0;
  4135. while (i < TheMax) and not IsVertLineSeparator(scan^) do
  4136. begin
  4137. Inc(i);
  4138. IncUnicode2(scan, Result);
  4139. end;
  4140. end;
  4141. {$ELSE}
  4142. while (Result < TheMax) and not IsVertLineSeparator(scan^) do
  4143. begin
  4144. Inc(Result);
  4145. Inc(scan);
  4146. end;
  4147. {$ENDIF}
  4148. OP_ANYHORZSEP:
  4149. while (Result < TheMax) and IsHorzSeparator(scan^) do
  4150. begin
  4151. Inc(Result);
  4152. Inc(scan);
  4153. end;
  4154. OP_NOTHORZSEP:
  4155. {$IFDEF UNICODEEX}
  4156. begin
  4157. i := 0;
  4158. while (i < TheMax) and not IsHorzSeparator(scan^) do
  4159. begin
  4160. Inc(i);
  4161. IncUnicode2(scan, Result);
  4162. end;
  4163. end;
  4164. {$ELSE}
  4165. while (Result < TheMax) and not IsHorzSeparator(scan^) do
  4166. begin
  4167. Inc(Result);
  4168. Inc(scan);
  4169. end;
  4170. {$ENDIF}
  4171. OP_ANYOF:
  4172. {$IFDEF UNICODEEX}
  4173. begin
  4174. i := 0;
  4175. while (i < TheMax) and FindInCharClass(opnd, scan^, False) do
  4176. begin
  4177. Inc(i);
  4178. IncUnicode2(scan, Result);
  4179. end;
  4180. end;
  4181. {$ELSE}
  4182. while (Result < TheMax) and FindInCharClass(opnd, scan^, False) do
  4183. begin
  4184. Inc(Result);
  4185. Inc(scan);
  4186. end;
  4187. {$ENDIF}
  4188. OP_ANYBUT:
  4189. {$IFDEF UNICODEEX}
  4190. begin
  4191. i := 0;
  4192. while (i < TheMax) and not FindInCharClass(opnd, scan^, False) do
  4193. begin
  4194. Inc(i);
  4195. IncUnicode2(scan, Result);
  4196. end;
  4197. end;
  4198. {$ELSE}
  4199. while (Result < TheMax) and not FindInCharClass(opnd, scan^, False) do
  4200. begin
  4201. Inc(Result);
  4202. Inc(scan);
  4203. end;
  4204. {$ENDIF}
  4205. OP_ANYOFCI:
  4206. {$IFDEF UNICODEEX}
  4207. begin
  4208. i := 0;
  4209. while (i < TheMax) and FindInCharClass(opnd, scan^, True) do
  4210. begin
  4211. Inc(i);
  4212. IncUnicode2(scan, Result);
  4213. end;
  4214. end;
  4215. {$ELSE}
  4216. while (Result < TheMax) and FindInCharClass(opnd, scan^, True) do
  4217. begin
  4218. Inc(Result);
  4219. Inc(scan);
  4220. end;
  4221. {$ENDIF}
  4222. OP_ANYBUTCI:
  4223. {$IFDEF UNICODEEX}
  4224. begin
  4225. i := 0;
  4226. while (i < TheMax) and not FindInCharClass(opnd, scan^, True) do
  4227. begin
  4228. Inc(i);
  4229. IncUnicode2(scan, Result);
  4230. end;
  4231. end;
  4232. {$ELSE}
  4233. while (Result < TheMax) and not FindInCharClass(opnd, scan^, True) do
  4234. begin
  4235. Inc(Result);
  4236. Inc(scan);
  4237. end;
  4238. {$ENDIF}
  4239. {$IFDEF FastUnicodeData}
  4240. OP_ANYCATEGORY:
  4241. {$IFDEF UNICODEEX}
  4242. begin
  4243. i := 0;
  4244. while (i < TheMax) and MatchOneCharCategory(opnd, scan) do
  4245. begin
  4246. Inc(i);
  4247. IncUnicode2(scan, Result);
  4248. end;
  4249. end;
  4250. {$ELSE}
  4251. while (Result < TheMax) and MatchOneCharCategory(opnd, scan) do
  4252. begin
  4253. Inc(Result);
  4254. Inc(scan);
  4255. end;
  4256. {$ENDIF}
  4257. OP_NOTCATEGORY:
  4258. {$IFDEF UNICODEEX}
  4259. begin
  4260. i := 0;
  4261. while (i < TheMax) and not MatchOneCharCategory(opnd, scan) do
  4262. begin
  4263. Inc(i);
  4264. IncUnicode2(scan, Result);
  4265. end;
  4266. end;
  4267. {$ELSE}
  4268. while (Result < TheMax) and not MatchOneCharCategory(opnd, scan) do
  4269. begin
  4270. Inc(Result);
  4271. Inc(scan);
  4272. end;
  4273. {$ENDIF}
  4274. {$ENDIF}
  4275. else
  4276. begin // Oh dear. Called inappropriately.
  4277. Result := 0;
  4278. Error(reeRegRepeatCalledInappropriately);
  4279. Exit;
  4280. end;
  4281. end; { of case }
  4282. regInput := scan;
  4283. end; { of function TRegExpr.FindRepeated
  4284. -------------------------------------------------------------- }
  4285. function TRegExpr.regNext(p: PRegExprChar): PRegExprChar;
  4286. // dig the "next" pointer out of a node
  4287. var
  4288. offset: TRENextOff;
  4289. begin
  4290. if p = @regDummy then
  4291. begin
  4292. Result := nil;
  4293. Exit;
  4294. end;
  4295. offset := PRENextOff(AlignToPtr(p + REOpSz))^; // ###0.933 inlined NEXT
  4296. if offset = 0 then
  4297. Result := nil
  4298. else
  4299. Result := p + offset;
  4300. end; { of function TRegExpr.regNext
  4301. -------------------------------------------------------------- }
  4302. function TRegExpr.MatchPrim(prog: PRegExprChar): boolean;
  4303. // recursively matching routine
  4304. // Conceptually the strategy is simple: check to see whether the current
  4305. // node matches, call self recursively to see whether the rest matches,
  4306. // and then act accordingly. In practice we make some effort to avoid
  4307. // recursion, in particular by going through "ordinary" nodes (that don't
  4308. // need to know whether the rest of the match failed) by a loop instead of
  4309. // by recursion.
  4310. var
  4311. scan: PRegExprChar; // Current node.
  4312. next: PRegExprChar; // Next node.
  4313. Len: PtrInt;
  4314. opnd: PRegExprChar;
  4315. no: integer;
  4316. save: PRegExprChar;
  4317. saveCurrentGrp: integer;
  4318. nextch: REChar;
  4319. BracesMin, BracesMax: integer;
  4320. // we use integer instead of TREBracesArg for better support */+
  4321. {$IFDEF ComplexBraces}
  4322. SavedLoopStack: TRegExprLoopStack; // :(( very bad for recursion
  4323. SavedLoopStackIdx: integer; // ###0.925
  4324. {$ENDIF}
  4325. bound1, bound2: boolean;
  4326. checkAtomicGroup: boolean;
  4327. begin
  4328. Result := False;
  4329. {
  4330. // Alexey: not sure it's ok for long searches in big texts, so disabled
  4331. if regNestedCalls > MaxRegexBackTracking then
  4332. Exit;
  4333. Inc(regNestedCalls);
  4334. }
  4335. scan := prog;
  4336. while scan <> nil do
  4337. begin
  4338. Len := PRENextOff(AlignToPtr(scan + 1))^; // ###0.932 inlined regNext
  4339. if Len = 0 then
  4340. next := nil
  4341. else
  4342. next := scan + Len;
  4343. case scan^ of
  4344. OP_BOUND:
  4345. begin
  4346. bound1 := (regInput = fInputStart) or not IsWordChar((regInput - 1)^);
  4347. bound2 := (regInput >= fInputEnd) or not IsWordChar(regInput^);
  4348. if bound1 = bound2 then
  4349. Exit;
  4350. end;
  4351. OP_NOTBOUND:
  4352. begin
  4353. bound1 := (regInput = fInputStart) or not IsWordChar((regInput - 1)^);
  4354. bound2 := (regInput >= fInputEnd) or not IsWordChar(regInput^);
  4355. if bound1 <> bound2 then
  4356. Exit;
  4357. end;
  4358. OP_BOL:
  4359. begin
  4360. if regInput <> fInputStart then
  4361. Exit;
  4362. end;
  4363. OP_EOL:
  4364. begin
  4365. // \z matches at the very end
  4366. if regInput < fInputEnd then
  4367. Exit;
  4368. end;
  4369. OP_EOL2:
  4370. begin
  4371. // \Z matches at the very and + before the final line-break (LF and CR LF)
  4372. if regInput < fInputEnd then
  4373. begin
  4374. if (regInput = fInputEnd - 1) and (regInput^ = #10) then
  4375. begin end
  4376. else
  4377. if (regInput = fInputEnd - 2) and (regInput^ = #13) and ((regInput + 1) ^ = #10) then
  4378. begin end
  4379. else
  4380. Exit;
  4381. end;
  4382. end;
  4383. OP_BOLML:
  4384. if regInput > fInputStart then
  4385. begin
  4386. if ((regInput - 1) <= fInputStart) or
  4387. not IsPairedBreak(regInput - 2) then
  4388. begin
  4389. // don't stop between paired separator
  4390. if IsPairedBreak(regInput - 1) then
  4391. Exit;
  4392. if not IsCustomLineSeparator((regInput - 1)^) then
  4393. Exit;
  4394. end;
  4395. end;
  4396. OP_EOLML:
  4397. if regInput < fInputEnd then
  4398. begin
  4399. if not IsPairedBreak(regInput) then
  4400. begin
  4401. // don't stop between paired separator
  4402. if (regInput > fInputStart) and IsPairedBreak(regInput - 1) then
  4403. Exit;
  4404. if not IsCustomLineSeparator(regInput^) then
  4405. Exit;
  4406. end;
  4407. end;
  4408. OP_ANY:
  4409. begin
  4410. if regInput >= fInputEnd then
  4411. Exit;
  4412. {$IFDEF UNICODEEX}
  4413. IncUnicode(regInput);
  4414. {$ELSE}
  4415. Inc(regInput);
  4416. {$ENDIF}
  4417. end;
  4418. OP_ANYML:
  4419. begin
  4420. if (regInput >= fInputEnd) or
  4421. IsPairedBreak(regInput) or
  4422. IsCustomLineSeparator(regInput^)
  4423. then
  4424. Exit;
  4425. {$IFDEF UNICODEEX}
  4426. IncUnicode(regInput);
  4427. {$ELSE}
  4428. Inc(regInput);
  4429. {$ENDIF}
  4430. end;
  4431. OP_ANYDIGIT:
  4432. begin
  4433. if (regInput >= fInputEnd) or not IsDigitChar(regInput^) then
  4434. Exit;
  4435. Inc(regInput);
  4436. end;
  4437. OP_NOTDIGIT:
  4438. begin
  4439. if (regInput >= fInputEnd) or IsDigitChar(regInput^) then
  4440. Exit;
  4441. {$IFDEF UNICODEEX}
  4442. IncUnicode(regInput);
  4443. {$ELSE}
  4444. Inc(regInput);
  4445. {$ENDIF}
  4446. end;
  4447. OP_ANYLETTER:
  4448. begin
  4449. if (regInput >= fInputEnd) or not IsWordChar(regInput^) then
  4450. Exit;
  4451. Inc(regInput);
  4452. end;
  4453. OP_NOTLETTER:
  4454. begin
  4455. if (regInput >= fInputEnd) or IsWordChar(regInput^) then
  4456. Exit;
  4457. {$IFDEF UNICODEEX}
  4458. IncUnicode(regInput);
  4459. {$ELSE}
  4460. Inc(regInput);
  4461. {$ENDIF}
  4462. end;
  4463. OP_ANYSPACE:
  4464. begin
  4465. if (regInput >= fInputEnd) or not IsSpaceChar(regInput^) then
  4466. Exit;
  4467. Inc(regInput);
  4468. end;
  4469. OP_NOTSPACE:
  4470. begin
  4471. if (regInput >= fInputEnd) or IsSpaceChar(regInput^) then
  4472. Exit;
  4473. {$IFDEF UNICODEEX}
  4474. IncUnicode(regInput);
  4475. {$ELSE}
  4476. Inc(regInput);
  4477. {$ENDIF}
  4478. end;
  4479. OP_ANYVERTSEP:
  4480. begin
  4481. if (regInput >= fInputEnd) or not IsVertLineSeparator(regInput^) then
  4482. Exit;
  4483. Inc(regInput);
  4484. end;
  4485. OP_NOTVERTSEP:
  4486. begin
  4487. if (regInput >= fInputEnd) or IsVertLineSeparator(regInput^) then
  4488. Exit;
  4489. {$IFDEF UNICODEEX}
  4490. IncUnicode(regInput);
  4491. {$ELSE}
  4492. Inc(regInput);
  4493. {$ENDIF}
  4494. end;
  4495. OP_ANYHORZSEP:
  4496. begin
  4497. if (regInput >= fInputEnd) or not IsHorzSeparator(regInput^) then
  4498. Exit;
  4499. Inc(regInput);
  4500. end;
  4501. OP_NOTHORZSEP:
  4502. begin
  4503. if (regInput >= fInputEnd) or IsHorzSeparator(regInput^) then
  4504. Exit;
  4505. {$IFDEF UNICODEEX}
  4506. IncUnicode(regInput);
  4507. {$ELSE}
  4508. Inc(regInput);
  4509. {$ENDIF}
  4510. end;
  4511. OP_EXACTLYCI:
  4512. begin
  4513. opnd := scan + REOpSz + RENextOffSz; // OPERAND
  4514. Len := PLongInt(opnd)^;
  4515. Inc(opnd, RENumberSz);
  4516. // Inline the first character, for speed.
  4517. if (opnd^ <> regInput^) and (InvertCase(opnd^) <> regInput^) then
  4518. Exit;
  4519. // ###0.929 begin
  4520. no := Len;
  4521. save := regInput;
  4522. while no > 1 do
  4523. begin
  4524. Inc(save);
  4525. Inc(opnd);
  4526. if (opnd^ <> save^) and (InvertCase(opnd^) <> save^) then
  4527. Exit;
  4528. Dec(no);
  4529. end;
  4530. // ###0.929 end
  4531. Inc(regInput, Len);
  4532. end;
  4533. OP_EXACTLY:
  4534. begin
  4535. opnd := scan + REOpSz + RENextOffSz; // OPERAND
  4536. Len := PLongInt(opnd)^;
  4537. Inc(opnd, RENumberSz);
  4538. // Inline the first character, for speed.
  4539. if opnd^ <> regInput^ then
  4540. Exit;
  4541. // ###0.929 begin
  4542. no := Len;
  4543. save := regInput;
  4544. while no > 1 do
  4545. begin
  4546. Inc(save);
  4547. Inc(opnd);
  4548. if opnd^ <> save^ then
  4549. Exit;
  4550. Dec(no);
  4551. end;
  4552. // ###0.929 end
  4553. Inc(regInput, Len);
  4554. end;
  4555. OP_BSUBEXP:
  4556. begin // ###0.936
  4557. no := Ord((scan + REOpSz + RENextOffSz)^);
  4558. no := GrpIndexes[no];
  4559. if no < 0 then
  4560. Exit;
  4561. if GrpStart[no] = nil then
  4562. Exit;
  4563. if GrpEnd[no] = nil then
  4564. Exit;
  4565. save := regInput;
  4566. opnd := GrpStart[no];
  4567. while opnd < GrpEnd[no] do
  4568. begin
  4569. if (save >= fInputEnd) or (save^ <> opnd^) then
  4570. Exit;
  4571. Inc(save);
  4572. Inc(opnd);
  4573. end;
  4574. regInput := save;
  4575. end;
  4576. OP_BSUBEXPCI:
  4577. begin // ###0.936
  4578. no := Ord((scan + REOpSz + RENextOffSz)^);
  4579. no := GrpIndexes[no];
  4580. if no < 0 then
  4581. Exit;
  4582. if GrpStart[no] = nil then
  4583. Exit;
  4584. if GrpEnd[no] = nil then
  4585. Exit;
  4586. save := regInput;
  4587. opnd := GrpStart[no];
  4588. while opnd < GrpEnd[no] do
  4589. begin
  4590. if (save >= fInputEnd) or
  4591. ((save^ <> opnd^) and (save^ <> InvertCase(opnd^))) then
  4592. Exit;
  4593. Inc(save);
  4594. Inc(opnd);
  4595. end;
  4596. regInput := save;
  4597. end;
  4598. OP_ANYOF:
  4599. begin
  4600. if (regInput >= fInputEnd) or
  4601. not FindInCharClass(scan + REOpSz + RENextOffSz, regInput^, False) then
  4602. Exit;
  4603. {$IFDEF UNICODEEX}
  4604. IncUnicode(regInput);
  4605. {$ELSE}
  4606. Inc(regInput);
  4607. {$ENDIF}
  4608. end;
  4609. OP_ANYBUT:
  4610. begin
  4611. if (regInput >= fInputEnd) or
  4612. FindInCharClass(scan + REOpSz + RENextOffSz, regInput^, False) then
  4613. Exit;
  4614. {$IFDEF UNICODEEX}
  4615. IncUnicode(regInput);
  4616. {$ELSE}
  4617. Inc(regInput);
  4618. {$ENDIF}
  4619. end;
  4620. OP_ANYOFCI:
  4621. begin
  4622. if (regInput >= fInputEnd) or
  4623. not FindInCharClass(scan + REOpSz + RENextOffSz, regInput^, True) then
  4624. Exit;
  4625. {$IFDEF UNICODEEX}
  4626. IncUnicode(regInput);
  4627. {$ELSE}
  4628. Inc(regInput);
  4629. {$ENDIF}
  4630. end;
  4631. OP_ANYBUTCI:
  4632. begin
  4633. if (regInput >= fInputEnd) or
  4634. FindInCharClass(scan + REOpSz + RENextOffSz, regInput^, True) then
  4635. Exit;
  4636. {$IFDEF UNICODEEX}
  4637. IncUnicode(regInput);
  4638. {$ELSE}
  4639. Inc(regInput);
  4640. {$ENDIF}
  4641. end;
  4642. OP_NOTHING:
  4643. ;
  4644. OP_COMMENT:
  4645. ;
  4646. OP_BACK:
  4647. ;
  4648. OP_OPEN_FIRST .. OP_OPEN_LAST:
  4649. begin
  4650. no := Ord(scan^) - Ord(OP_OPEN);
  4651. regCurrentGrp := no;
  4652. save := GrpStart[no]; // ###0.936
  4653. GrpStart[no] := regInput; // ###0.936
  4654. Result := MatchPrim(next);
  4655. if not Result then // ###0.936
  4656. GrpStart[no] := save;
  4657. // handle negative lookahead
  4658. if regLookaheadNeg then
  4659. if no = regLookaheadGroup then
  4660. begin
  4661. Result := not Result;
  4662. if Result then
  4663. begin
  4664. // we need zero length of "lookahead group",
  4665. // it is later used to adjust the match
  4666. GrpStart[no] := regInput;
  4667. GrpEnd[no]:= regInput;
  4668. end
  4669. else
  4670. GrpStart[no] := save;
  4671. end;
  4672. Exit;
  4673. end;
  4674. OP_CLOSE_FIRST .. OP_CLOSE_LAST:
  4675. begin
  4676. no := Ord(scan^) - Ord(OP_CLOSE);
  4677. regCurrentGrp := -1;
  4678. // handle atomic group, mark it as "done"
  4679. // (we are here because some OP_BRANCH is matched)
  4680. if GrpAtomic[no] then
  4681. GrpAtomicDone[no] := True;
  4682. save := GrpEnd[no]; // ###0.936
  4683. GrpEnd[no] := regInput; // ###0.936
  4684. // if we are in OP_SUBCALL* call, it called OP_OPEN*, so we must return
  4685. // in OP_CLOSE, without going to next opcode
  4686. if GrpSubCalled[no] then
  4687. begin
  4688. Result := True;
  4689. Exit;
  4690. end;
  4691. Result := MatchPrim(next);
  4692. if not Result then // ###0.936
  4693. GrpEnd[no] := save;
  4694. Exit;
  4695. end;
  4696. OP_BRANCH:
  4697. begin
  4698. saveCurrentGrp := regCurrentGrp;
  4699. checkAtomicGroup := (regCurrentGrp >= 0) and GrpAtomic[regCurrentGrp];
  4700. if (next^ <> OP_BRANCH) // No next choice in group
  4701. then
  4702. next := scan + REOpSz + RENextOffSz // Avoid recursion
  4703. else
  4704. begin
  4705. repeat
  4706. save := regInput;
  4707. Result := MatchPrim(scan + REOpSz + RENextOffSz);
  4708. regCurrentGrp := saveCurrentGrp;
  4709. if Result then
  4710. Exit;
  4711. // if branch worked until OP_CLOSE, and marked atomic group as "done", then exit
  4712. if checkAtomicGroup then
  4713. if GrpAtomicDone[regCurrentGrp] then
  4714. Exit;
  4715. regInput := save;
  4716. scan := regNext(scan);
  4717. until (scan = nil) or (scan^ <> OP_BRANCH);
  4718. Exit;
  4719. end;
  4720. end;
  4721. {$IFDEF ComplexBraces}
  4722. OP_LOOPENTRY:
  4723. begin // ###0.925
  4724. no := LoopStackIdx;
  4725. Inc(LoopStackIdx);
  4726. if LoopStackIdx > LoopStackMax then
  4727. begin
  4728. Error(reeLoopStackExceeded);
  4729. Exit;
  4730. end;
  4731. save := regInput;
  4732. LoopStack[LoopStackIdx] := 0; // init loop counter
  4733. Result := MatchPrim(next); // execute loop
  4734. LoopStackIdx := no; // cleanup
  4735. if Result then
  4736. Exit;
  4737. regInput := save;
  4738. Exit;
  4739. end;
  4740. OP_LOOP, OP_LOOPNG:
  4741. begin // ###0.940
  4742. if LoopStackIdx <= 0 then
  4743. begin
  4744. Error(reeLoopWithoutEntry);
  4745. Exit;
  4746. end;
  4747. opnd := scan + PRENextOff(AlignToPtr(scan + REOpSz + RENextOffSz + 2 * REBracesArgSz))^;
  4748. BracesMin := PREBracesArg(AlignToInt(scan + REOpSz + RENextOffSz))^;
  4749. BracesMax := PREBracesArg(AlignToPtr(scan + REOpSz + RENextOffSz + REBracesArgSz))^;
  4750. save := regInput;
  4751. if LoopStack[LoopStackIdx] >= BracesMin then
  4752. begin // Min alredy matched - we can work
  4753. if scan^ = OP_LOOP then
  4754. begin
  4755. // greedy way - first try to max deep of greed ;)
  4756. if LoopStack[LoopStackIdx] < BracesMax then
  4757. begin
  4758. Inc(LoopStack[LoopStackIdx]);
  4759. no := LoopStackIdx;
  4760. Result := MatchPrim(opnd);
  4761. LoopStackIdx := no;
  4762. if Result then
  4763. Exit;
  4764. regInput := save;
  4765. end;
  4766. Dec(LoopStackIdx); // Fail. May be we are too greedy? ;)
  4767. Result := MatchPrim(next);
  4768. if not Result then
  4769. regInput := save;
  4770. Exit;
  4771. end
  4772. else
  4773. begin
  4774. // non-greedy - try just now
  4775. Result := MatchPrim(next);
  4776. if Result then
  4777. Exit
  4778. else
  4779. regInput := save; // failed - move next and try again
  4780. if LoopStack[LoopStackIdx] < BracesMax then
  4781. begin
  4782. Inc(LoopStack[LoopStackIdx]);
  4783. no := LoopStackIdx;
  4784. Result := MatchPrim(opnd);
  4785. LoopStackIdx := no;
  4786. if Result then
  4787. Exit;
  4788. regInput := save;
  4789. end;
  4790. Dec(LoopStackIdx); // Failed - back up
  4791. Exit;
  4792. end
  4793. end
  4794. else
  4795. begin // first match a min_cnt times
  4796. Inc(LoopStack[LoopStackIdx]);
  4797. no := LoopStackIdx;
  4798. Result := MatchPrim(opnd);
  4799. LoopStackIdx := no;
  4800. if Result then
  4801. Exit;
  4802. Dec(LoopStack[LoopStackIdx]);
  4803. regInput := save;
  4804. Exit;
  4805. end;
  4806. end;
  4807. {$ENDIF}
  4808. OP_STAR, OP_PLUS, OP_BRACES, OP_STARNG, OP_PLUSNG, OP_BRACESNG:
  4809. begin
  4810. // Lookahead to avoid useless match attempts when we know
  4811. // what character comes next.
  4812. nextch := #0;
  4813. if next^ = OP_EXACTLY then
  4814. nextch := (next + REOpSz + RENextOffSz + RENumberSz)^;
  4815. BracesMax := MaxInt; // infinite loop for * and + //###0.92
  4816. if (scan^ = OP_STAR) or (scan^ = OP_STARNG) then
  4817. BracesMin := 0 // star
  4818. else if (scan^ = OP_PLUS) or (scan^ = OP_PLUSNG) then
  4819. BracesMin := 1 // plus
  4820. else
  4821. begin // braces
  4822. BracesMin := PREBracesArg(AlignToPtr(scan + REOpSz + RENextOffSz))^;
  4823. BracesMax := PREBracesArg(AlignToPtr(scan + REOpSz + RENextOffSz + REBracesArgSz))^;
  4824. end;
  4825. save := regInput;
  4826. opnd := scan + REOpSz + RENextOffSz;
  4827. if (scan^ = OP_BRACES) or (scan^ = OP_BRACESNG) then
  4828. Inc(opnd, 2 * REBracesArgSz);
  4829. if (scan^ = OP_PLUSNG) or (scan^ = OP_STARNG) or (scan^ = OP_BRACESNG) then
  4830. begin
  4831. // non-greedy mode
  4832. BracesMax := FindRepeated(opnd, BracesMax);
  4833. // don't repeat more than BracesMax
  4834. // Now we know real Max limit to move forward (for recursion 'back up')
  4835. // In some cases it can be faster to check only Min positions first,
  4836. // but after that we have to check every position separtely instead
  4837. // of fast scannig in loop.
  4838. no := BracesMin;
  4839. while no <= BracesMax do
  4840. begin
  4841. regInput := save + no;
  4842. // If it could work, try it.
  4843. if (nextch = #0) or (regInput^ = nextch) then
  4844. begin
  4845. {$IFDEF ComplexBraces}
  4846. System.Move(LoopStack, SavedLoopStack, SizeOf(LoopStack));
  4847. // ###0.925
  4848. SavedLoopStackIdx := LoopStackIdx;
  4849. {$ENDIF}
  4850. if MatchPrim(next) then
  4851. begin
  4852. Result := True;
  4853. Exit;
  4854. end;
  4855. {$IFDEF ComplexBraces}
  4856. System.Move(SavedLoopStack, LoopStack, SizeOf(LoopStack));
  4857. LoopStackIdx := SavedLoopStackIdx;
  4858. {$ENDIF}
  4859. end;
  4860. Inc(no); // Couldn't or didn't - move forward.
  4861. end; { of while }
  4862. Exit;
  4863. end
  4864. else
  4865. begin // greedy mode
  4866. no := FindRepeated(opnd, BracesMax); // don't repeat more than max_cnt
  4867. while no >= BracesMin do
  4868. begin
  4869. // If it could work, try it.
  4870. if (nextch = #0) or (regInput^ = nextch) then
  4871. begin
  4872. {$IFDEF ComplexBraces}
  4873. System.Move(LoopStack, SavedLoopStack, SizeOf(LoopStack));
  4874. // ###0.925
  4875. SavedLoopStackIdx := LoopStackIdx;
  4876. {$ENDIF}
  4877. if MatchPrim(next) then
  4878. begin
  4879. Result := True;
  4880. Exit;
  4881. end;
  4882. {$IFDEF ComplexBraces}
  4883. System.Move(SavedLoopStack, LoopStack, SizeOf(LoopStack));
  4884. LoopStackIdx := SavedLoopStackIdx;
  4885. {$ENDIF}
  4886. end;
  4887. Dec(no); // Couldn't or didn't - back up.
  4888. regInput := save + no;
  4889. end; { of while }
  4890. Exit;
  4891. end;
  4892. end;
  4893. OP_STAR_POSS, OP_PLUS_POSS, OP_BRACES_POSS:
  4894. begin
  4895. // Lookahead to avoid useless match attempts when we know
  4896. // what character comes next.
  4897. nextch := #0;
  4898. if next^ = OP_EXACTLY then
  4899. nextch := (next + REOpSz + RENextOffSz + RENumberSz)^;
  4900. opnd := scan + REOpSz + RENextOffSz;
  4901. case scan^ of
  4902. OP_STAR_POSS:
  4903. begin
  4904. BracesMin := 0;
  4905. BracesMax := MaxInt;
  4906. end;
  4907. OP_PLUS_POSS:
  4908. begin
  4909. BracesMin := 1;
  4910. BracesMax := MaxInt;
  4911. end;
  4912. else
  4913. begin // braces
  4914. BracesMin := PREBracesArg(AlignToPtr(scan + REOpSz + RENextOffSz))^;
  4915. BracesMax := PREBracesArg(AlignToPtr(scan + REOpSz + RENextOffSz + REBracesArgSz))^;
  4916. Inc(opnd, 2 * REBracesArgSz);
  4917. end;
  4918. end;
  4919. no := FindRepeated(opnd, BracesMax);
  4920. if no >= BracesMin then
  4921. if (nextch = #0) or (regInput^ = nextch) then
  4922. Result := MatchPrim(next);
  4923. Exit;
  4924. end;
  4925. OP_EEND:
  4926. begin
  4927. Result := True; // Success!
  4928. Exit;
  4929. end;
  4930. {$IFDEF FastUnicodeData}
  4931. OP_ANYCATEGORY:
  4932. begin
  4933. if (regInput >= fInputEnd) then Exit;
  4934. if not MatchOneCharCategory(scan + REOpSz + RENextOffSz, regInput) then Exit;
  4935. {$IFDEF UNICODEEX}
  4936. IncUnicode(regInput);
  4937. {$ELSE}
  4938. Inc(regInput);
  4939. {$ENDIF}
  4940. end;
  4941. OP_NOTCATEGORY:
  4942. begin
  4943. if (regInput >= fInputEnd) then Exit;
  4944. if MatchOneCharCategory(scan + REOpSz + RENextOffSz, regInput) then Exit;
  4945. {$IFDEF UNICODEEX}
  4946. IncUnicode(regInput);
  4947. {$ELSE}
  4948. Inc(regInput);
  4949. {$ENDIF}
  4950. end;
  4951. {$ENDIF}
  4952. OP_RECUR:
  4953. begin
  4954. // call opcode start
  4955. if not MatchPrim(regCodeWork) then Exit;
  4956. end;
  4957. OP_SUBCALL_FIRST .. OP_SUBCALL_LAST:
  4958. begin
  4959. // call subroutine
  4960. no := GrpIndexes[Ord(scan^) - Ord(OP_SUBCALL)];
  4961. if no < 0 then Exit;
  4962. save := GrpOpCodes[no];
  4963. if save = nil then Exit;
  4964. checkAtomicGroup := GrpSubCalled[no];
  4965. // mark group in GrpSubCalled array so opcode can detect subcall
  4966. GrpSubCalled[no] := True;
  4967. if not MatchPrim(save) then
  4968. begin
  4969. GrpSubCalled[no] := checkAtomicGroup;
  4970. Exit;
  4971. end;
  4972. GrpSubCalled[no] := checkAtomicGroup;
  4973. end;
  4974. else
  4975. begin
  4976. Error(reeMatchPrimMemoryCorruption);
  4977. Exit;
  4978. end;
  4979. end; { of case scan^ }
  4980. scan := next;
  4981. end; { of while scan <> nil }
  4982. // We get here only if there's trouble -- normally "case EEND" is the
  4983. // terminating point.
  4984. Error(reeMatchPrimCorruptedPointers);
  4985. end; { of function TRegExpr.MatchPrim
  4986. -------------------------------------------------------------- }
  4987. function TRegExpr.Exec(const AInputString: RegExprString): boolean;
  4988. begin
  4989. InputString := AInputString;
  4990. Result := ExecPrim(1, False, False, False);
  4991. end; { of function TRegExpr.Exec
  4992. -------------------------------------------------------------- }
  4993. {$IFDEF OverMeth}
  4994. function TRegExpr.Exec: boolean;
  4995. var
  4996. SlowChecks: boolean;
  4997. begin
  4998. SlowChecks := Length(fInputString) < fSlowChecksSizeMax;
  4999. Result := ExecPrim(1, False, SlowChecks, False);
  5000. end; { of function TRegExpr.Exec
  5001. -------------------------------------------------------------- }
  5002. function TRegExpr.Exec(AOffset: integer): boolean;
  5003. begin
  5004. Result := ExecPrim(AOffset, False, False, False);
  5005. end; { of function TRegExpr.Exec
  5006. -------------------------------------------------------------- }
  5007. {$ENDIF}
  5008. function TRegExpr.ExecPos(AOffset: integer {$IFDEF DefParam} = 1{$ENDIF}): boolean;
  5009. begin
  5010. Result := ExecPrim(AOffset, False, False, False);
  5011. end; { of function TRegExpr.ExecPos
  5012. -------------------------------------------------------------- }
  5013. {$IFDEF OverMeth}
  5014. function TRegExpr.ExecPos(AOffset: integer; ATryOnce, ABackward: boolean): boolean;
  5015. begin
  5016. Result := ExecPrim(AOffset, ATryOnce, False, ABackward);
  5017. end;
  5018. {$ENDIF}
  5019. function TRegExpr.MatchAtOnePos(APos: PRegExprChar): boolean;
  5020. begin
  5021. // test for lookbehind '(?<!foo)bar' before running actual MatchPrim
  5022. if Assigned(fHelper) then
  5023. if (APos - fHelperLen) >= fInputStart then
  5024. begin
  5025. fHelper.SetInputRange(APos - fHelperLen, APos);
  5026. if fHelper.MatchAtOnePos(APos - fHelperLen) then
  5027. begin
  5028. Result := False;
  5029. Exit;
  5030. end;
  5031. end;
  5032. regInput := APos;
  5033. regCurrentGrp := -1;
  5034. regNestedCalls := 0;
  5035. Result := MatchPrim(regCodeWork);
  5036. if Result then
  5037. begin
  5038. GrpStart[0] := APos;
  5039. GrpEnd[0] := regInput;
  5040. // with lookbehind, increase found position by the len of group=1
  5041. if regLookbehind then
  5042. Inc(GrpStart[0], GrpEnd[1] - GrpStart[1]);
  5043. // with lookahead, decrease ending by the len of group=regLookaheadGroup
  5044. if regLookahead and (regLookaheadGroup > 0) then
  5045. Dec(GrpEnd[0], GrpEnd[regLookaheadGroup] - GrpStart[regLookaheadGroup]);
  5046. end;
  5047. end;
  5048. procedure TRegExpr.ClearMatches;
  5049. begin
  5050. FillChar(GrpStart, SizeOf(GrpStart), 0);
  5051. FillChar(GrpEnd, SizeOf(GrpEnd), 0);
  5052. FillChar(GrpAtomicDone, SizeOf(GrpAtomicDone), 0);
  5053. FillChar(GrpSubCalled, SizeOf(GrpSubCalled), 0);
  5054. end;
  5055. procedure TRegExpr.ClearInternalIndexes;
  5056. var
  5057. i: integer;
  5058. begin
  5059. FillChar(GrpStart, SizeOf(GrpStart), 0);
  5060. FillChar(GrpEnd, SizeOf(GrpEnd), 0);
  5061. FillChar(GrpAtomic, SizeOf(GrpAtomic), 0);
  5062. FillChar(GrpAtomicDone, SizeOf(GrpAtomicDone), 0);
  5063. FillChar(GrpSubCalled, SizeOf(GrpSubCalled), 0);
  5064. FillChar(GrpOpCodes, SizeOf(GrpOpCodes), 0);
  5065. for i := 0 to RegexMaxGroups - 1 do
  5066. begin
  5067. GrpIndexes[i] := -1;
  5068. GrpNames[i] := '';
  5069. end;
  5070. GrpIndexes[0] := 0;
  5071. GrpCount := 0;
  5072. end;
  5073. function TRegExpr.ExecPrim(AOffset: integer;
  5074. ATryOnce, ASlowChecks, ABackward: boolean): boolean;
  5075. var
  5076. Ptr: PRegExprChar;
  5077. begin
  5078. Result := False;
  5079. // Ensure that Match cleared either if optimization tricks or some error
  5080. // will lead to leaving ExecPrim without actual search. That is
  5081. // important for ExecNext logic and so on.
  5082. ClearMatches;
  5083. // Don't check IsProgrammOk here! it causes big slowdown in test_benchmark!
  5084. if programm = nil then
  5085. begin
  5086. Compile;
  5087. if programm = nil then
  5088. Exit;
  5089. end;
  5090. if fInputString = '' then
  5091. begin
  5092. // Empty string can match e.g. '^$'
  5093. if regMustLen > 0 then
  5094. Exit;
  5095. end;
  5096. // Check that the start position is not negative
  5097. if AOffset < 1 then
  5098. begin
  5099. Error(reeOffsetMustBePositive);
  5100. Exit;
  5101. end;
  5102. // Check that the start position is not longer than the line
  5103. if AOffset > (Length(fInputString) + 1) then
  5104. Exit;
  5105. Ptr := fInputStart + AOffset - 1;
  5106. // If there is a "must appear" string, look for it.
  5107. if ASlowChecks then
  5108. if regMustString <> '' then
  5109. if Pos(regMustString, fInputString) = 0 then Exit;
  5110. {$IFDEF ComplexBraces}
  5111. // no loops started
  5112. LoopStackIdx := 0; // ###0.925
  5113. {$ENDIF}
  5114. // ATryOnce or anchored match (it needs to be tried only once).
  5115. if ATryOnce or (regAnchored <> #0) then
  5116. begin
  5117. {$IFDEF UseFirstCharSet}
  5118. {$IFDEF UniCode}
  5119. if Ord(Ptr^) <= $FF then
  5120. {$ENDIF}
  5121. if not FirstCharArray[byte(Ptr^)] then
  5122. Exit;
  5123. {$ENDIF}
  5124. Result := MatchAtOnePos(Ptr);
  5125. Exit;
  5126. end;
  5127. // Messy cases: unanchored match.
  5128. if ABackward then
  5129. Inc(Ptr, 2)
  5130. else
  5131. Dec(Ptr);
  5132. repeat
  5133. if ABackward then
  5134. begin
  5135. Dec(Ptr);
  5136. if Ptr < fInputStart then
  5137. Exit;
  5138. end
  5139. else
  5140. begin
  5141. Inc(Ptr);
  5142. if Ptr > fInputEnd then
  5143. Exit;
  5144. end;
  5145. {$IFDEF UseFirstCharSet}
  5146. {$IFDEF UniCode}
  5147. if Ord(Ptr^) <= $FF then
  5148. {$ENDIF}
  5149. if not FirstCharArray[byte(Ptr^)] then
  5150. Continue;
  5151. {$ENDIF}
  5152. Result := MatchAtOnePos(Ptr);
  5153. // Exit on a match or after testing the end-of-string
  5154. if Result then
  5155. Exit;
  5156. until False;
  5157. end; { of function TRegExpr.ExecPrim
  5158. -------------------------------------------------------------- }
  5159. function TRegExpr.ExecNext(ABackward: boolean {$IFDEF DefParam} = False{$ENDIF}): boolean;
  5160. var
  5161. PtrBegin, PtrEnd: PRegExprChar;
  5162. Offset: PtrInt;
  5163. begin
  5164. PtrBegin := GrpStart[0];
  5165. PtrEnd := GrpEnd[0];
  5166. if (PtrBegin = nil) or (PtrEnd = nil) then
  5167. begin
  5168. Error(reeExecNextWithoutExec);
  5169. Result := False;
  5170. Exit;
  5171. end;
  5172. Offset := PtrEnd - fInputStart + 1;
  5173. // prevent infinite looping if empty string matches r.e.
  5174. if PtrBegin = PtrEnd then
  5175. Inc(Offset);
  5176. Result := ExecPrim(Offset, False, False, ABackward);
  5177. end; { of function TRegExpr.ExecNext
  5178. -------------------------------------------------------------- }
  5179. procedure TRegExpr.SetInputString(const AInputString: RegExprString);
  5180. begin
  5181. ClearMatches;
  5182. fInputString := AInputString;
  5183. UniqueString(fInputString);
  5184. fInputStart := PRegExprChar(fInputString);
  5185. fInputEnd := fInputStart + Length(fInputString);
  5186. end;
  5187. procedure TRegExpr.SetInputRange(AStart, AEnd: PRegExprChar);
  5188. begin
  5189. fInputString := '';
  5190. fInputStart := AStart;
  5191. fInputEnd := AEnd;
  5192. end;
  5193. {$IFDEF UseLineSep}
  5194. procedure TRegExpr.SetLineSeparators(const AStr: RegExprString);
  5195. begin
  5196. if AStr <> fLineSeparators then
  5197. begin
  5198. fLineSeparators := AStr;
  5199. InitLineSepArray;
  5200. InvalidateProgramm;
  5201. end;
  5202. end; { of procedure TRegExpr.SetLineSeparators
  5203. -------------------------------------------------------------- }
  5204. {$ENDIF}
  5205. procedure TRegExpr.SetUsePairedBreak(AValue: boolean);
  5206. begin
  5207. if AValue <> fUsePairedBreak then
  5208. begin
  5209. fUsePairedBreak := AValue;
  5210. InvalidateProgramm;
  5211. end;
  5212. end;
  5213. function TRegExpr.Substitute(const ATemplate: RegExprString): RegExprString;
  5214. // perform substitutions after a regexp match
  5215. var
  5216. TemplateBeg, TemplateEnd: PRegExprChar;
  5217. function ParseVarName(var APtr: PRegExprChar): integer;
  5218. // extract name of variable: $1 or ${1} or ${name}
  5219. // from APtr^, uses TemplateEnd
  5220. var
  5221. p: PRegExprChar;
  5222. Delimited: boolean;
  5223. GrpName: RegExprString;
  5224. begin
  5225. Result := 0;
  5226. p := APtr;
  5227. Delimited := (p < TemplateEnd) and (p^ = '{');
  5228. if Delimited then
  5229. Inc(p); // skip left curly brace
  5230. if (p < TemplateEnd) and (p^ = '&') then
  5231. Inc(p) // this is '$&' or '${&}'
  5232. else
  5233. begin
  5234. if IsDigitChar(p^) then
  5235. begin
  5236. while (p < TemplateEnd) and IsDigitChar(p^) do
  5237. begin
  5238. Result := Result * 10 + (Ord(p^) - Ord('0'));
  5239. Inc(p);
  5240. end
  5241. end
  5242. else
  5243. if Delimited then
  5244. begin
  5245. FindGroupName(p, TemplateEnd, '}', GrpName);
  5246. Result := MatchIndexFromName(GrpName);
  5247. Inc(p, Length(GrpName));
  5248. end;
  5249. end;
  5250. if Delimited then
  5251. if (p < TemplateEnd) and (p^ = '}') then
  5252. Inc(p) // skip right curly brace
  5253. else
  5254. p := APtr; // isn't properly terminated
  5255. if p = APtr then
  5256. Result := -1; // no valid digits found or no right curly brace
  5257. APtr := p;
  5258. end;
  5259. procedure FindSubstGroupIndex(var p: PRegExprChar; var Idx: integer; var NumberFound: boolean);
  5260. begin
  5261. Idx := ParseVarName(p);
  5262. NumberFound := (Idx >= 0) and (Idx <= High(GrpIndexes));
  5263. if NumberFound then
  5264. Idx := GrpIndexes[Idx];
  5265. end;
  5266. type
  5267. TSubstMode = (smodeNormal, smodeOneUpper, smodeOneLower, smodeAllUpper, smodeAllLower);
  5268. var
  5269. Mode: TSubstMode;
  5270. p, p0, p1, ResultPtr: PRegExprChar;
  5271. ResultLen, n: integer;
  5272. Ch, QuotedChar: REChar;
  5273. GroupFound: boolean;
  5274. begin
  5275. // Check programm and input string
  5276. if not IsProgrammOk then
  5277. Exit;
  5278. // Note: don't check for empty fInputString, it's valid case,
  5279. // e.g. user needs to replace regex "\b" to "_", it's zero match length
  5280. if ATemplate = '' then
  5281. begin
  5282. Result := '';
  5283. Exit;
  5284. end;
  5285. TemplateBeg := PRegExprChar(ATemplate);
  5286. TemplateEnd := TemplateBeg + Length(ATemplate);
  5287. // Count result length for speed optimization.
  5288. ResultLen := 0;
  5289. p := TemplateBeg;
  5290. while p < TemplateEnd do
  5291. begin
  5292. Ch := p^;
  5293. Inc(p);
  5294. n := -1;
  5295. GroupFound := False;
  5296. if Ch = SubstituteGroupChar then
  5297. FindSubstGroupIndex(p, n, GroupFound);
  5298. if GroupFound then
  5299. begin
  5300. if n >= 0 then
  5301. Inc(ResultLen, GrpEnd[n] - GrpStart[n]);
  5302. end
  5303. else
  5304. begin
  5305. if (Ch = EscChar) and (p < TemplateEnd) then
  5306. begin // quoted or special char followed
  5307. Ch := p^;
  5308. Inc(p);
  5309. case Ch of
  5310. 'n':
  5311. Inc(ResultLen, Length(fReplaceLineEnd));
  5312. 'u', 'l', 'U', 'L': { nothing }
  5313. ;
  5314. 'x':
  5315. begin
  5316. Inc(ResultLen);
  5317. if (p^ = '{') then
  5318. begin // skip \x{....}
  5319. while ((p^ <> '}') and (p < TemplateEnd)) do
  5320. p := p + 1;
  5321. p := p + 1;
  5322. end
  5323. else
  5324. p := p + 2 // skip \x..
  5325. end;
  5326. else
  5327. Inc(ResultLen);
  5328. end;
  5329. end
  5330. else
  5331. Inc(ResultLen);
  5332. end;
  5333. end;
  5334. // Get memory. We do it once and it significant speed up work !
  5335. if ResultLen = 0 then
  5336. begin
  5337. Result := '';
  5338. Exit;
  5339. end;
  5340. SetLength(Result, ResultLen);
  5341. // Fill Result
  5342. ResultPtr := PRegExprChar(Result);
  5343. p := TemplateBeg;
  5344. Mode := smodeNormal;
  5345. while p < TemplateEnd do
  5346. begin
  5347. Ch := p^;
  5348. p0 := p;
  5349. Inc(p);
  5350. p1 := p;
  5351. n := -1;
  5352. GroupFound := False;
  5353. if Ch = SubstituteGroupChar then
  5354. FindSubstGroupIndex(p, n, GroupFound);
  5355. if GroupFound then
  5356. begin
  5357. if n >= 0 then
  5358. begin
  5359. p0 := GrpStart[n];
  5360. p1 := GrpEnd[n];
  5361. end
  5362. else
  5363. p1 := p0;
  5364. end
  5365. else
  5366. begin
  5367. if (Ch = EscChar) and (p < TemplateEnd) then
  5368. begin // quoted or special char followed
  5369. Ch := p^;
  5370. Inc(p);
  5371. case Ch of
  5372. 'n':
  5373. begin
  5374. p0 := PRegExprChar(fReplaceLineEnd);
  5375. p1 := p0 + Length(fReplaceLineEnd);
  5376. end;
  5377. 'x', 't', 'r', 'f', 'a', 'e':
  5378. begin
  5379. p := p - 1;
  5380. // UnquoteChar expects the escaped char under the pointer
  5381. QuotedChar := UnQuoteChar(p, TemplateEnd);
  5382. p := p + 1;
  5383. // Skip after last part of the escaped sequence - UnquoteChar stops on the last symbol of it
  5384. p0 := @QuotedChar;
  5385. p1 := p0 + 1;
  5386. end;
  5387. 'l':
  5388. begin
  5389. Mode := smodeOneLower;
  5390. p1 := p0;
  5391. end;
  5392. 'L':
  5393. begin
  5394. Mode := smodeAllLower;
  5395. p1 := p0;
  5396. end;
  5397. 'u':
  5398. begin
  5399. Mode := smodeOneUpper;
  5400. p1 := p0;
  5401. end;
  5402. 'U':
  5403. begin
  5404. Mode := smodeAllUpper;
  5405. p1 := p0;
  5406. end;
  5407. else
  5408. begin
  5409. Inc(p0);
  5410. Inc(p1);
  5411. end;
  5412. end;
  5413. end
  5414. end;
  5415. if p0 < p1 then
  5416. begin
  5417. while p0 < p1 do
  5418. begin
  5419. case Mode of
  5420. smodeOneLower:
  5421. begin
  5422. ResultPtr^ := _LowerCase(p0^);
  5423. Mode := smodeNormal;
  5424. end;
  5425. smodeAllLower:
  5426. begin
  5427. ResultPtr^ := _LowerCase(p0^);
  5428. end;
  5429. smodeOneUpper:
  5430. begin
  5431. ResultPtr^ := _UpperCase(p0^);
  5432. Mode := smodeNormal;
  5433. end;
  5434. smodeAllUpper:
  5435. begin
  5436. ResultPtr^ := _UpperCase(p0^);
  5437. end;
  5438. else
  5439. ResultPtr^ := p0^;
  5440. end;
  5441. Inc(ResultPtr);
  5442. Inc(p0);
  5443. end;
  5444. Mode := smodeNormal;
  5445. end;
  5446. end;
  5447. end; { of function TRegExpr.Substitute
  5448. -------------------------------------------------------------- }
  5449. procedure TRegExpr.Split(const AInputStr: RegExprString; APieces: TStrings);
  5450. var
  5451. PrevPos: PtrInt;
  5452. begin
  5453. PrevPos := 1;
  5454. if Exec(AInputStr) then
  5455. repeat
  5456. APieces.Add(System.Copy(AInputStr, PrevPos, MatchPos[0] - PrevPos));
  5457. PrevPos := MatchPos[0] + MatchLen[0];
  5458. until not ExecNext;
  5459. APieces.Add(System.Copy(AInputStr, PrevPos, MaxInt)); // Tail
  5460. end; { of procedure TRegExpr.Split
  5461. -------------------------------------------------------------- }
  5462. function TRegExpr.Replace(const AInputStr: RegExprString;
  5463. const AReplaceStr: RegExprString;
  5464. AUseSubstitution: boolean{$IFDEF DefParam} = False{$ENDIF}): RegExprString;
  5465. var
  5466. PrevPos: PtrInt;
  5467. begin
  5468. Result := '';
  5469. PrevPos := 1;
  5470. if Exec(AInputStr) then
  5471. repeat
  5472. Result := Result + System.Copy(AInputStr, PrevPos, MatchPos[0] - PrevPos);
  5473. if AUseSubstitution // ###0.946
  5474. then
  5475. Result := Result + Substitute(AReplaceStr)
  5476. else
  5477. Result := Result + AReplaceStr;
  5478. PrevPos := MatchPos[0] + MatchLen[0];
  5479. until not ExecNext;
  5480. Result := Result + System.Copy(AInputStr, PrevPos, MaxInt); // Tail
  5481. end; { of function TRegExpr.Replace
  5482. -------------------------------------------------------------- }
  5483. function TRegExpr.ReplaceEx(const AInputStr: RegExprString;
  5484. AReplaceFunc: TRegExprReplaceFunction): RegExprString;
  5485. var
  5486. PrevPos: PtrInt;
  5487. begin
  5488. Result := '';
  5489. PrevPos := 1;
  5490. if Exec(AInputStr) then
  5491. repeat
  5492. Result := Result + System.Copy(AInputStr, PrevPos, MatchPos[0] - PrevPos)
  5493. + AReplaceFunc(Self);
  5494. PrevPos := MatchPos[0] + MatchLen[0];
  5495. until not ExecNext;
  5496. Result := Result + System.Copy(AInputStr, PrevPos, MaxInt); // Tail
  5497. end; { of function TRegExpr.ReplaceEx
  5498. -------------------------------------------------------------- }
  5499. {$IFDEF OverMeth}
  5500. function TRegExpr.Replace(const AInputStr: RegExprString;
  5501. AReplaceFunc: TRegExprReplaceFunction): RegExprString;
  5502. begin
  5503. Result := ReplaceEx(AInputStr, AReplaceFunc);
  5504. end; { of function TRegExpr.Replace
  5505. -------------------------------------------------------------- }
  5506. {$ENDIF}
  5507. { ============================================================= }
  5508. { ====================== Debug section ======================== }
  5509. { ============================================================= }
  5510. {$IFDEF UseFirstCharSet}
  5511. procedure TRegExpr.FillFirstCharSet(prog: PRegExprChar);
  5512. var
  5513. scan: PRegExprChar; // Current node.
  5514. Next: PRegExprChar; // Next node.
  5515. opnd: PRegExprChar;
  5516. Oper: TREOp;
  5517. ch: REChar;
  5518. min_cnt, i: integer;
  5519. TempSet: TRegExprCharset;
  5520. begin
  5521. TempSet := [];
  5522. scan := prog;
  5523. while scan <> nil do
  5524. begin
  5525. Next := regNext(scan);
  5526. Oper := PREOp(scan)^;
  5527. case Oper of
  5528. OP_BSUBEXP,
  5529. OP_BSUBEXPCI:
  5530. begin
  5531. // we cannot optimize r.e. if it starts with back reference
  5532. FirstCharSet := RegExprAllSet; //###0.930
  5533. Exit;
  5534. end;
  5535. OP_BOL,
  5536. OP_BOLML:
  5537. ; // Exit; //###0.937
  5538. OP_EOL,
  5539. OP_EOL2,
  5540. OP_EOLML:
  5541. begin //###0.948 was empty in 0.947, was EXIT in 0.937
  5542. Include(FirstCharSet, 0);
  5543. if ModifierM then
  5544. begin
  5545. {$IFDEF UseLineSep}
  5546. for i := 1 to Length(LineSeparators) do
  5547. Include(FirstCharSet, byte(LineSeparators[i]));
  5548. {$ELSE}
  5549. FirstCharSet := FirstCharSet + RegExprLineSeparatorsSet;
  5550. {$ENDIF}
  5551. end;
  5552. Exit;
  5553. end;
  5554. OP_BOUND,
  5555. OP_NOTBOUND:
  5556. ; //###0.943 ?!!
  5557. OP_ANY,
  5558. OP_ANYML:
  5559. begin // we can better define ANYML !!!
  5560. FirstCharSet := RegExprAllSet; //###0.930
  5561. Exit;
  5562. end;
  5563. OP_ANYDIGIT:
  5564. begin
  5565. FirstCharSet := FirstCharSet + RegExprDigitSet;
  5566. Exit;
  5567. end;
  5568. OP_NOTDIGIT:
  5569. begin
  5570. FirstCharSet := FirstCharSet + (RegExprAllSet - RegExprDigitSet);
  5571. Exit;
  5572. end;
  5573. OP_ANYLETTER:
  5574. begin
  5575. GetCharSetFromWordChars(TempSet);
  5576. FirstCharSet := FirstCharSet + TempSet;
  5577. Exit;
  5578. end;
  5579. OP_NOTLETTER:
  5580. begin
  5581. GetCharSetFromWordChars(TempSet);
  5582. FirstCharSet := FirstCharSet + (RegExprAllSet - TempSet);
  5583. Exit;
  5584. end;
  5585. OP_ANYSPACE:
  5586. begin
  5587. GetCharSetFromSpaceChars(TempSet);
  5588. FirstCharSet := FirstCharSet + TempSet;
  5589. Exit;
  5590. end;
  5591. OP_NOTSPACE:
  5592. begin
  5593. GetCharSetFromSpaceChars(TempSet);
  5594. FirstCharSet := FirstCharSet + (RegExprAllSet - TempSet);
  5595. Exit;
  5596. end;
  5597. OP_ANYVERTSEP:
  5598. begin
  5599. FirstCharSet := FirstCharSet + RegExprLineSeparatorsSet;
  5600. Exit;
  5601. end;
  5602. OP_NOTVERTSEP:
  5603. begin
  5604. FirstCharSet := FirstCharSet + (RegExprAllSet - RegExprLineSeparatorsSet);
  5605. Exit;
  5606. end;
  5607. OP_ANYHORZSEP:
  5608. begin
  5609. FirstCharSet := FirstCharSet + RegExprHorzSeparatorsSet;
  5610. Exit;
  5611. end;
  5612. OP_NOTHORZSEP:
  5613. begin
  5614. FirstCharSet := FirstCharSet + (RegExprAllSet - RegExprHorzSeparatorsSet);
  5615. Exit;
  5616. end;
  5617. OP_EXACTLYCI:
  5618. begin
  5619. ch := (scan + REOpSz + RENextOffSz + RENumberSz)^;
  5620. {$IFDEF UniCode}
  5621. if Ord(ch) <= $FF then
  5622. {$ENDIF}
  5623. begin
  5624. Include(FirstCharSet, byte(ch));
  5625. Include(FirstCharSet, byte(InvertCase(ch)));
  5626. end;
  5627. Exit;
  5628. end;
  5629. OP_EXACTLY:
  5630. begin
  5631. ch := (scan + REOpSz + RENextOffSz + RENumberSz)^;
  5632. {$IFDEF UniCode}
  5633. if Ord(ch) <= $FF then
  5634. {$ENDIF}
  5635. Include(FirstCharSet, byte(ch));
  5636. Exit;
  5637. end;
  5638. OP_ANYOF:
  5639. begin
  5640. GetCharSetFromCharClass(scan + REOpSz + RENextOffSz, False, TempSet);
  5641. FirstCharSet := FirstCharSet + TempSet;
  5642. Exit;
  5643. end;
  5644. OP_ANYBUT:
  5645. begin
  5646. GetCharSetFromCharClass(scan + REOpSz + RENextOffSz, False, TempSet);
  5647. FirstCharSet := FirstCharSet + (RegExprAllSet - TempSet);
  5648. Exit;
  5649. end;
  5650. OP_ANYOFCI:
  5651. begin
  5652. GetCharSetFromCharClass(scan + REOpSz + RENextOffSz, True, TempSet);
  5653. FirstCharSet := FirstCharSet + TempSet;
  5654. Exit;
  5655. end;
  5656. OP_ANYBUTCI:
  5657. begin
  5658. GetCharSetFromCharClass(scan + REOpSz + RENextOffSz, True, TempSet);
  5659. FirstCharSet := FirstCharSet + (RegExprAllSet - TempSet);
  5660. Exit;
  5661. end;
  5662. OP_NOTHING:
  5663. ;
  5664. OP_COMMENT:
  5665. ;
  5666. OP_BACK:
  5667. ;
  5668. OP_OPEN_FIRST .. OP_OPEN_LAST:
  5669. begin
  5670. FillFirstCharSet(Next);
  5671. Exit;
  5672. end;
  5673. OP_CLOSE_FIRST .. OP_CLOSE_LAST:
  5674. begin
  5675. FillFirstCharSet(Next);
  5676. Exit;
  5677. end;
  5678. OP_BRANCH:
  5679. begin
  5680. if (PREOp(Next)^ <> OP_BRANCH) // No choice.
  5681. then
  5682. Next := scan + REOpSz + RENextOffSz // Avoid recursion.
  5683. else
  5684. begin
  5685. repeat
  5686. FillFirstCharSet(scan + REOpSz + RENextOffSz);
  5687. scan := regNext(scan);
  5688. until (scan = nil) or (PREOp(scan)^ <> OP_BRANCH);
  5689. Exit;
  5690. end;
  5691. end;
  5692. {$IFDEF ComplexBraces}
  5693. OP_LOOPENTRY:
  5694. begin //###0.925
  5695. //LoopStack [LoopStackIdx] := 0; //###0.940 line removed
  5696. FillFirstCharSet(Next); // execute LOOP
  5697. Exit;
  5698. end;
  5699. OP_LOOP,
  5700. OP_LOOPNG:
  5701. begin //###0.940
  5702. opnd := scan + PRENextOff(AlignToPtr(scan + REOpSz + RENextOffSz + REBracesArgSz * 2))^;
  5703. min_cnt := PREBracesArg(AlignToPtr(scan + REOpSz + RENextOffSz))^;
  5704. FillFirstCharSet(opnd);
  5705. if min_cnt = 0 then
  5706. FillFirstCharSet(Next);
  5707. Exit;
  5708. end;
  5709. {$ENDIF}
  5710. OP_STAR,
  5711. OP_STARNG,
  5712. OP_STAR_POSS: //###0.940
  5713. FillFirstCharSet(scan + REOpSz + RENextOffSz);
  5714. OP_PLUS,
  5715. OP_PLUSNG,
  5716. OP_PLUS_POSS:
  5717. begin //###0.940
  5718. FillFirstCharSet(scan + REOpSz + RENextOffSz);
  5719. Exit;
  5720. end;
  5721. OP_BRACES,
  5722. OP_BRACESNG,
  5723. OP_BRACES_POSS:
  5724. begin //###0.940
  5725. opnd := scan + REOpSz + RENextOffSz + REBracesArgSz * 2;
  5726. min_cnt := PREBracesArg(AlignToPtr(scan + REOpSz + RENextOffSz))^; // BRACES
  5727. FillFirstCharSet(opnd);
  5728. if min_cnt > 0 then
  5729. Exit;
  5730. end;
  5731. OP_EEND:
  5732. begin
  5733. FirstCharSet := RegExprAllSet; //###0.948
  5734. Exit;
  5735. end;
  5736. OP_ANYCATEGORY,
  5737. OP_NOTCATEGORY:
  5738. begin
  5739. FirstCharSet := RegExprAllSet;
  5740. Exit;
  5741. end;
  5742. OP_RECUR,
  5743. OP_SUBCALL_FIRST .. OP_SUBCALL_LAST:
  5744. begin
  5745. end
  5746. else
  5747. begin
  5748. fLastErrorOpcode := Oper;
  5749. Error(reeUnknownOpcodeInFillFirst);
  5750. Exit;
  5751. end;
  5752. end; { of case scan^}
  5753. scan := Next;
  5754. end; { of while scan <> nil}
  5755. end; { of procedure FillFirstCharSet
  5756. --------------------------------------------------------------}
  5757. {$ENDIF}
  5758. procedure TRegExpr.InitCharCheckers;
  5759. var
  5760. Cnt: integer;
  5761. //
  5762. function Add(AChecker: TRegExprCharChecker): byte;
  5763. begin
  5764. Inc(Cnt);
  5765. if Cnt > High(CharCheckers) then
  5766. Error(reeTooSmallCheckersArray);
  5767. CharCheckers[Cnt - 1] := AChecker;
  5768. Result := Cnt - 1;
  5769. end;
  5770. //
  5771. begin
  5772. Cnt := 0;
  5773. FillChar(CharCheckers, SizeOf(CharCheckers), 0);
  5774. CheckerIndex_Word := Add(CharChecker_Word);
  5775. CheckerIndex_NotWord := Add(CharChecker_NotWord);
  5776. CheckerIndex_Space := Add(CharChecker_Space);
  5777. CheckerIndex_NotSpace := Add(CharChecker_NotSpace);
  5778. CheckerIndex_Digit := Add(CharChecker_Digit);
  5779. CheckerIndex_NotDigit := Add(CharChecker_NotDigit);
  5780. CheckerIndex_VertSep := Add(CharChecker_VertSep);
  5781. CheckerIndex_NotVertSep := Add(CharChecker_NotVertSep);
  5782. CheckerIndex_HorzSep := Add(CharChecker_HorzSep);
  5783. CheckerIndex_NotHorzSep := Add(CharChecker_NotHorzSep);
  5784. //CheckerIndex_AllAZ := Add(CharChecker_AllAZ);
  5785. CheckerIndex_LowerAZ := Add(CharChecker_LowerAZ);
  5786. CheckerIndex_UpperAZ := Add(CharChecker_UpperAZ);
  5787. SetLength(CharCheckerInfos, 3);
  5788. with CharCheckerInfos[0] do
  5789. begin
  5790. CharBegin := 'a';
  5791. CharEnd:= 'z';
  5792. CheckerIndex := CheckerIndex_LowerAZ;
  5793. end;
  5794. with CharCheckerInfos[1] do
  5795. begin
  5796. CharBegin := 'A';
  5797. CharEnd := 'Z';
  5798. CheckerIndex := CheckerIndex_UpperAZ;
  5799. end;
  5800. with CharCheckerInfos[2] do
  5801. begin
  5802. CharBegin := '0';
  5803. CharEnd := '9';
  5804. CheckerIndex := CheckerIndex_Digit;
  5805. end;
  5806. end;
  5807. function TRegExpr.GetUseOsLineEndOnReplace: Boolean;
  5808. begin
  5809. Result:=fReplaceLineEnd=sLineBreak;
  5810. end;
  5811. function TRegExpr.CharChecker_Word(ch: REChar): boolean;
  5812. begin
  5813. Result := IsWordChar(ch);
  5814. end;
  5815. function TRegExpr.CharChecker_NotWord(ch: REChar): boolean;
  5816. begin
  5817. Result := not IsWordChar(ch);
  5818. end;
  5819. function TRegExpr.CharChecker_Space(ch: REChar): boolean;
  5820. begin
  5821. Result := IsSpaceChar(ch);
  5822. end;
  5823. function TRegExpr.CharChecker_NotSpace(ch: REChar): boolean;
  5824. begin
  5825. Result := not IsSpaceChar(ch);
  5826. end;
  5827. function TRegExpr.CharChecker_Digit(ch: REChar): boolean;
  5828. begin
  5829. Result := IsDigitChar(ch);
  5830. end;
  5831. function TRegExpr.CharChecker_NotDigit(ch: REChar): boolean;
  5832. begin
  5833. Result := not IsDigitChar(ch);
  5834. end;
  5835. function TRegExpr.CharChecker_VertSep(ch: REChar): boolean;
  5836. begin
  5837. Result := IsVertLineSeparator(ch);
  5838. end;
  5839. function TRegExpr.CharChecker_NotVertSep(ch: REChar): boolean;
  5840. begin
  5841. Result := not IsVertLineSeparator(ch);
  5842. end;
  5843. function TRegExpr.CharChecker_HorzSep(ch: REChar): boolean;
  5844. begin
  5845. Result := IsHorzSeparator(ch);
  5846. end;
  5847. function TRegExpr.CharChecker_NotHorzSep(ch: REChar): boolean;
  5848. begin
  5849. Result := not IsHorzSeparator(ch);
  5850. end;
  5851. function TRegExpr.CharChecker_LowerAZ(ch: REChar): boolean;
  5852. begin
  5853. case ch of
  5854. 'a' .. 'z':
  5855. Result := True;
  5856. else
  5857. Result := False;
  5858. end;
  5859. end;
  5860. function TRegExpr.CharChecker_UpperAZ(ch: REChar): boolean;
  5861. begin
  5862. case ch of
  5863. 'A' .. 'Z':
  5864. Result := True;
  5865. else
  5866. Result := False;
  5867. end;
  5868. end;
  5869. {$IFDEF RegExpPCodeDump}
  5870. function TRegExpr.DumpOp(op: TREOp): RegExprString;
  5871. // printable representation of opcode
  5872. begin
  5873. case op of
  5874. OP_BOL:
  5875. Result := 'BOL';
  5876. OP_EOL:
  5877. Result := 'EOL';
  5878. OP_EOL2:
  5879. Result := 'EOL2';
  5880. OP_BOLML:
  5881. Result := 'BOLML';
  5882. OP_EOLML:
  5883. Result := 'EOLML';
  5884. OP_BOUND:
  5885. Result := 'BOUND';
  5886. OP_NOTBOUND:
  5887. Result := 'NOTBOUND';
  5888. OP_ANY:
  5889. Result := 'ANY';
  5890. OP_ANYML:
  5891. Result := 'ANYML';
  5892. OP_ANYLETTER:
  5893. Result := 'ANYLETTER';
  5894. OP_NOTLETTER:
  5895. Result := 'NOTLETTER';
  5896. OP_ANYDIGIT:
  5897. Result := 'ANYDIGIT';
  5898. OP_NOTDIGIT:
  5899. Result := 'NOTDIGIT';
  5900. OP_ANYSPACE:
  5901. Result := 'ANYSPACE';
  5902. OP_NOTSPACE:
  5903. Result := 'NOTSPACE';
  5904. OP_ANYHORZSEP:
  5905. Result := 'ANYHORZSEP';
  5906. OP_NOTHORZSEP:
  5907. Result := 'NOTHORZSEP';
  5908. OP_ANYVERTSEP:
  5909. Result := 'ANYVERTSEP';
  5910. OP_NOTVERTSEP:
  5911. Result := 'NOTVERTSEP';
  5912. OP_ANYOF:
  5913. Result := 'ANYOF';
  5914. OP_ANYBUT:
  5915. Result := 'ANYBUT';
  5916. OP_ANYOFCI:
  5917. Result := 'ANYOF/CI';
  5918. OP_ANYBUTCI:
  5919. Result := 'ANYBUT/CI';
  5920. OP_BRANCH:
  5921. Result := 'BRANCH';
  5922. OP_EXACTLY:
  5923. Result := 'EXACTLY';
  5924. OP_EXACTLYCI:
  5925. Result := 'EXACTLY/CI';
  5926. OP_NOTHING:
  5927. Result := 'NOTHING';
  5928. OP_COMMENT:
  5929. Result := 'COMMENT';
  5930. OP_BACK:
  5931. Result := 'BACK';
  5932. OP_EEND:
  5933. Result := 'END';
  5934. OP_BSUBEXP:
  5935. Result := 'BSUBEXP';
  5936. OP_BSUBEXPCI:
  5937. Result := 'BSUBEXP/CI';
  5938. OP_OPEN_FIRST .. OP_OPEN_LAST:
  5939. Result := Format('OPEN[%d]', [Ord(op) - Ord(OP_OPEN)]);
  5940. OP_CLOSE_FIRST .. OP_CLOSE_LAST:
  5941. Result := Format('CLOSE[%d]', [Ord(op) - Ord(OP_CLOSE)]);
  5942. OP_STAR:
  5943. Result := 'STAR';
  5944. OP_PLUS:
  5945. Result := 'PLUS';
  5946. OP_BRACES:
  5947. Result := 'BRACES';
  5948. {$IFDEF ComplexBraces}
  5949. OP_LOOPENTRY:
  5950. Result := 'LOOPENTRY';
  5951. OP_LOOP:
  5952. Result := 'LOOP';
  5953. OP_LOOPNG:
  5954. Result := 'LOOPNG';
  5955. {$ENDIF}
  5956. OP_STARNG:
  5957. Result := 'STARNG';
  5958. OP_PLUSNG:
  5959. Result := 'PLUSNG';
  5960. OP_BRACESNG:
  5961. Result := 'BRACESNG';
  5962. OP_STAR_POSS:
  5963. Result := 'STAR_POSS';
  5964. OP_PLUS_POSS:
  5965. Result := 'PLUS_POSS';
  5966. OP_BRACES_POSS:
  5967. Result := 'BRACES_POSS';
  5968. OP_ANYCATEGORY:
  5969. Result := 'ANYCATEG';
  5970. OP_NOTCATEGORY:
  5971. Result := 'NOTCATEG';
  5972. OP_RECUR:
  5973. Result := 'RECURSION';
  5974. OP_SUBCALL_FIRST .. OP_SUBCALL_LAST:
  5975. Result := Format('SUBCALL[%d]', [Ord(op) - Ord(OP_SUBCALL)]);
  5976. else
  5977. Error(reeDumpCorruptedOpcode);
  5978. end;
  5979. end; { of function TRegExpr.DumpOp
  5980. -------------------------------------------------------------- }
  5981. function TRegExpr.IsCompiled: boolean;
  5982. begin
  5983. Result := programm <> nil;
  5984. end;
  5985. function PrintableChar(AChar: REChar): RegExprString; {$IFDEF InlineFuncs}inline;{$ENDIF}
  5986. begin
  5987. if AChar < ' ' then
  5988. Result := '#' + IntToStr(Ord(AChar))
  5989. else
  5990. Result := AChar;
  5991. end;
  5992. function TRegExpr.DumpCheckerIndex(N: byte): RegExprString;
  5993. begin
  5994. Result := '?';
  5995. if N = CheckerIndex_Word then Result := '\w' else
  5996. if N = CheckerIndex_NotWord then Result := '\W' else
  5997. if N = CheckerIndex_Digit then Result := '\d' else
  5998. if N = CheckerIndex_NotDigit then Result := '\D' else
  5999. if N = CheckerIndex_Space then Result := '\s' else
  6000. if N = CheckerIndex_NotSpace then Result := '\S' else
  6001. if N = CheckerIndex_HorzSep then Result := '\h' else
  6002. if N = CheckerIndex_NotHorzSep then Result := '\H' else
  6003. if N = CheckerIndex_VertSep then Result := '\v' else
  6004. if N = CheckerIndex_NotVertSep then Result := '\V' else
  6005. if N = CheckerIndex_LowerAZ then Result := 'az' else
  6006. if N = CheckerIndex_UpperAZ then Result := 'AZ' else
  6007. ;
  6008. end;
  6009. function TRegExpr.DumpCategoryChars(ch, ch2: REChar; Positive: boolean): RegExprString;
  6010. const
  6011. S: array[boolean] of RegExprString = ('P', 'p');
  6012. begin
  6013. Result := '\' + S[Positive] + '{' + ch;
  6014. if ch2 <> #0 then
  6015. Result := Result + ch2;
  6016. Result := Result + '} ';
  6017. end;
  6018. function TRegExpr.Dump: RegExprString;
  6019. // dump a regexp in vaguely comprehensible form
  6020. var
  6021. s: PRegExprChar;
  6022. op: TREOp; // Arbitrary non-END op.
  6023. next: PRegExprChar;
  6024. i, NLen: integer;
  6025. Diff: PtrInt;
  6026. iByte: byte;
  6027. ch, ch2: REChar;
  6028. begin
  6029. if not IsProgrammOk then
  6030. Exit;
  6031. op := OP_EXACTLY;
  6032. Result := '';
  6033. s := regCodeWork;
  6034. while op <> OP_EEND do
  6035. begin // While that wasn't END last time...
  6036. op := s^;
  6037. Result := Result + Format('%2d: %s', [s - programm, DumpOp(s^)]);
  6038. // Where, what.
  6039. next := regNext(s);
  6040. if next = nil // Next ptr.
  6041. then
  6042. Result := Result + ' (0)'
  6043. else
  6044. begin
  6045. if next > s
  6046. // ###0.948 PWideChar subtraction workaround (see comments in Tail method for details)
  6047. then
  6048. Diff := next - s
  6049. else
  6050. Diff := -(s - next);
  6051. Result := Result + Format(' (%d) ', [(s - programm) + Diff]);
  6052. end;
  6053. Inc(s, REOpSz + RENextOffSz);
  6054. if (op = OP_ANYOF) or (op = OP_ANYOFCI) or (op = OP_ANYBUT) or (op = OP_ANYBUTCI) then
  6055. begin
  6056. repeat
  6057. case s^ of
  6058. OpKind_End:
  6059. begin
  6060. Inc(s);
  6061. Break;
  6062. end;
  6063. OpKind_Range:
  6064. begin
  6065. Result := Result + 'Rng(';
  6066. Inc(s);
  6067. Result := Result + PrintableChar(s^) + '-';
  6068. Inc(s);
  6069. Result := Result + PrintableChar(s^);
  6070. Result := Result + ') ';
  6071. Inc(s);
  6072. end;
  6073. OpKind_MetaClass:
  6074. begin
  6075. Inc(s);
  6076. Result := Result + DumpCheckerIndex(byte(s^)) + ' ';
  6077. Inc(s);
  6078. end;
  6079. OpKind_Char:
  6080. begin
  6081. Inc(s);
  6082. NLen := PLongInt(s)^;
  6083. Inc(s, RENumberSz);
  6084. Result := Result + 'Ch(';
  6085. for i := 1 to NLen do
  6086. begin
  6087. Result := Result + PrintableChar(s^);
  6088. Inc(s);
  6089. end;
  6090. Result := Result + ') ';
  6091. end;
  6092. OpKind_CategoryYes:
  6093. begin
  6094. Inc(s);
  6095. ch := s^;
  6096. Inc(s);
  6097. ch2 := s^;
  6098. Result := Result + DumpCategoryChars(ch, ch2, True);
  6099. Inc(s);
  6100. end;
  6101. OpKind_CategoryNo:
  6102. begin
  6103. Inc(s);
  6104. ch := s^;
  6105. Inc(s);
  6106. ch2 := s^;
  6107. Result := Result + DumpCategoryChars(ch, ch2, False);
  6108. Inc(s);
  6109. end;
  6110. else
  6111. Error(reeDumpCorruptedOpcode);
  6112. end;
  6113. until false;
  6114. end;
  6115. if (op = OP_EXACTLY) or (op = OP_EXACTLYCI) then
  6116. begin
  6117. // Literal string, where present.
  6118. NLen := PLongInt(s)^;
  6119. Inc(s, RENumberSz);
  6120. for i := 1 to NLen do
  6121. begin
  6122. Result := Result + PrintableChar(s^);
  6123. Inc(s);
  6124. end;
  6125. end;
  6126. if (op = OP_BSUBEXP) or (op = OP_BSUBEXPCI) then
  6127. begin
  6128. Result := Result + ' \' + IntToStr(Ord(s^));
  6129. Inc(s);
  6130. end;
  6131. if (op = OP_BRACES) or (op = OP_BRACESNG) or (op = OP_BRACES_POSS) then
  6132. begin // ###0.941
  6133. // show min/max argument of braces operator
  6134. Result := Result + Format('{%d,%d}', [PREBracesArg(AlignToInt(s))^,
  6135. PREBracesArg(AlignToInt(s + REBracesArgSz))^]);
  6136. Inc(s, REBracesArgSz * 2);
  6137. end;
  6138. {$IFDEF ComplexBraces}
  6139. if (op = OP_LOOP) or (op = OP_LOOPNG) then
  6140. begin // ###0.940
  6141. Result := Result + Format(' -> (%d) {%d,%d}',
  6142. [(s - programm - (REOpSz + RENextOffSz)) +
  6143. PRENextOff(AlignToPtr(s + 2 * REBracesArgSz))^,
  6144. PREBracesArg(AlignToInt(s))^,
  6145. PREBracesArg(AlignToInt(s + REBracesArgSz))^]);
  6146. Inc(s, 2 * REBracesArgSz + RENextOffSz);
  6147. end;
  6148. {$ENDIF}
  6149. if (op = OP_ANYCATEGORY) or (op = OP_NOTCATEGORY) then
  6150. begin
  6151. ch := s^;
  6152. Inc(s);
  6153. ch2 := s^;
  6154. Inc(s);
  6155. if ch2<>#0 then
  6156. Result := Result + '{' + ch + ch2 + '}'
  6157. else
  6158. Result := Result + '{' + ch + '}';
  6159. end;
  6160. Result := Result + #$d#$a;
  6161. end; { of while }
  6162. // Header fields of interest.
  6163. if regAnchored <> #0 then
  6164. Result := Result + 'Anchored; ';
  6165. if regMustString <> '' then
  6166. Result := Result + 'Must have: "' + regMustString + '"; ';
  6167. {$IFDEF UseFirstCharSet} // ###0.929
  6168. Result := Result + #$d#$a'First charset: ';
  6169. if FirstCharSet = [] then
  6170. Result := Result + '<empty set>'
  6171. else
  6172. if FirstCharSet = RegExprAllSet then
  6173. Result := Result + '<all chars>'
  6174. else
  6175. for iByte := 0 to 255 do
  6176. if iByte in FirstCharSet then
  6177. Result := Result + PrintableChar(REChar(iByte));
  6178. {$ENDIF}
  6179. Result := Result + #$d#$a;
  6180. end; { of function TRegExpr.Dump
  6181. -------------------------------------------------------------- }
  6182. {$ENDIF}
  6183. function TRegExpr.IsFixedLength(var op: TREOp; var ALen: integer): boolean;
  6184. var
  6185. s, next: PRegExprChar;
  6186. N, N2: integer;
  6187. begin
  6188. Result := False;
  6189. ALen := 0;
  6190. if not IsCompiled then Exit;
  6191. s := regCodeWork;
  6192. repeat
  6193. next := regNext(s);
  6194. op := s^;
  6195. Inc(s, REOpSz + RENextOffSz);
  6196. case op of
  6197. OP_EEND:
  6198. begin
  6199. Result := True;
  6200. Exit;
  6201. end;
  6202. OP_BRANCH:
  6203. begin
  6204. op := next^;
  6205. if op <> OP_EEND then Exit;
  6206. end;
  6207. OP_COMMENT,
  6208. OP_BOUND,
  6209. OP_NOTBOUND:
  6210. Continue;
  6211. OP_ANY,
  6212. OP_ANYML,
  6213. OP_ANYDIGIT,
  6214. OP_NOTDIGIT,
  6215. OP_ANYLETTER,
  6216. OP_NOTLETTER,
  6217. OP_ANYSPACE,
  6218. OP_NOTSPACE,
  6219. OP_ANYHORZSEP,
  6220. OP_NOTHORZSEP,
  6221. OP_ANYVERTSEP,
  6222. OP_NOTVERTSEP:
  6223. begin
  6224. Inc(ALen);
  6225. Continue;
  6226. end;
  6227. OP_ANYOF,
  6228. OP_ANYOFCI,
  6229. OP_ANYBUT,
  6230. OP_ANYBUTCI:
  6231. begin
  6232. Inc(ALen);
  6233. repeat
  6234. case s^ of
  6235. OpKind_End:
  6236. begin
  6237. Inc(s);
  6238. Break;
  6239. end;
  6240. OpKind_Range:
  6241. begin
  6242. Inc(s);
  6243. Inc(s);
  6244. Inc(s);
  6245. end;
  6246. OpKind_MetaClass:
  6247. begin
  6248. Inc(s);
  6249. Inc(s);
  6250. end;
  6251. OpKind_Char:
  6252. begin
  6253. Inc(s);
  6254. Inc(s, RENumberSz + PLongInt(s)^);
  6255. end;
  6256. OpKind_CategoryYes,
  6257. OpKind_CategoryNo:
  6258. begin
  6259. Inc(s);
  6260. Inc(s);
  6261. Inc(s);
  6262. end;
  6263. end;
  6264. until False;
  6265. end;
  6266. OP_EXACTLY,
  6267. OP_EXACTLYCI:
  6268. begin
  6269. N := PLongInt(s)^;
  6270. Inc(ALen, N);
  6271. Inc(s, RENumberSz + N);
  6272. Continue;
  6273. end;
  6274. OP_ANYCATEGORY,
  6275. OP_NOTCATEGORY:
  6276. begin
  6277. Inc(ALen);
  6278. Inc(s, 2);
  6279. Continue;
  6280. end;
  6281. OP_BRACES,
  6282. OP_BRACESNG,
  6283. OP_BRACES_POSS:
  6284. begin
  6285. // allow only d{n,n}
  6286. N := PREBracesArg(AlignToInt(s))^;
  6287. N2 := PREBracesArg(AlignToInt(s + REBracesArgSz))^;
  6288. if N <> N2 then
  6289. Exit;
  6290. Inc(ALen, N-1);
  6291. Inc(s, REBracesArgSz * 2);
  6292. end;
  6293. else
  6294. Exit;
  6295. end;
  6296. until False;
  6297. end;
  6298. {$IFDEF reRealExceptionAddr}
  6299. { OPTIMIZATION ON} // specified via (fp)make
  6300. // ReturnAddr works correctly only if compiler optimization is ON
  6301. // I placed this method at very end of unit because there are no
  6302. // way to restore compiler optimization flag ...
  6303. {$ENDIF}
  6304. procedure TRegExpr.Error(AErrorID: integer);
  6305. {$IFNDEF LINUX}
  6306. {$IFDEF reRealExceptionAddr}
  6307. function ReturnAddr: Pointer; // ###0.938
  6308. asm
  6309. mov eax,[ebp+4]
  6310. end;
  6311. {$ENDIF}
  6312. {$ENDIF}
  6313. var
  6314. e: ERegExpr;
  6315. Msg: string;
  6316. begin
  6317. fLastError := AErrorID; // dummy stub - useless because will raise exception
  6318. Msg := ErrorMsg(AErrorID);
  6319. // compilation error ?
  6320. if AErrorID < reeFirstRuntimeCode then
  6321. Msg := Msg + ' (pos ' + IntToStr(CompilerErrorPos) + ')';
  6322. e := ERegExpr.Create(Msg);
  6323. e.ErrorCode := AErrorID;
  6324. e.CompilerErrorPos := CompilerErrorPos;
  6325. raise e
  6326. {$IFNDEF LINUX}
  6327. {$IFDEF reRealExceptionAddr}
  6328. at ReturnAddr
  6329. {$ENDIF}
  6330. {$ENDIF};
  6331. end; { of procedure TRegExpr.Error
  6332. -------------------------------------------------------------- }
  6333. {$IFDEF Compat} // APIs needed only for users of old FPC 3.0
  6334. function TRegExpr.ExecPos(AOffset: integer; ATryOnce: boolean): boolean; overload;
  6335. begin
  6336. Result := ExecPrim(AOffset, ATryOnce, False, False);
  6337. end;
  6338. function TRegExpr.OldInvertCase(const Ch: REChar): REChar;
  6339. begin
  6340. Result := _UpperCase(Ch);
  6341. if Result = Ch then
  6342. Result := _LowerCase(Ch);
  6343. end;
  6344. class function TRegExpr.InvertCaseFunction(const Ch: REChar): REChar;
  6345. begin
  6346. Result := _UpperCase(Ch);
  6347. if Result = Ch then
  6348. Result := _LowerCase(Ch);
  6349. end;
  6350. function TRegExpr.GetLinePairedSeparator: RegExprString;
  6351. begin
  6352. // not supported anymore
  6353. Result := '';
  6354. end;
  6355. procedure TRegExpr.SetLinePairedSeparator(const AValue: RegExprString);
  6356. begin
  6357. // not supported anymore
  6358. end;
  6359. procedure TRegExpr.SetUseOsLineEndOnReplace(AValue: boolean);
  6360. begin
  6361. if fUseOsLineEndOnReplace = AValue then
  6362. Exit;
  6363. fUseOsLineEndOnReplace := AValue;
  6364. if fUseOsLineEndOnReplace then
  6365. fReplaceLineEnd := sLineBreak
  6366. else
  6367. fReplaceLineEnd := #10;
  6368. end;
  6369. {$ENDIF}
  6370. end.