regexpr.pas 254 KB

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