fix: address review findings in regex tier 1-3
ober
a11ed651d96d60443d2e38a6626c3fd6b664b410
--- a/lib/std/regex.sls +++ b/lib/std/regex.sls @@ -62,8 +62,6 @@ ;; These are ONLY CALLED when native-available? is #t. (define c-native-compile (foreign-procedure "jerboa_regex_compile" (u8* size_t u8*) int)) - (define c-native-is-match - (foreign-procedure "jerboa_regex_is_match" (unsigned-64 u8* size_t) int)) (define c-native-find (foreign-procedure "jerboa_regex_find" (unsigned-64 u8* size_t u8* u8*) int)) (define c-native-free @@ -76,8 +74,7 @@ (immutable pattern) ;; original: string or SRE datum (immutable pat-string) ;; normalized pregexp-compatible string (immutable named-groups) ;; alist: (symbol . 1-based-group-index) - (immutable native-handle) ;; u64 integer handle, or #f - (immutable pregexp-obj)) ;; compiled pregexp object or #f + (immutable native-handle)) ;; u64 integer handle, or #f (sealed #t)) (define-record-type re-match-object @@ -164,8 +161,7 @@ (pattern->named-groups pat-str) (car named-override))] [handle (try-native-compile! pat-str)] - [pxobj (guard (exn [#t #f]) (pregexp pat-str))] - [obj (make-re-object original pat-str named handle pxobj)]) + [obj (make-re-object original pat-str named handle)]) (when handle (re-guardian obj)) ;; guard the object, not just the handle obj)) --- a/lib/std/rx.sls +++ b/lib/std/rx.sls @@ -49,10 +49,23 @@ ;; (embed "str") is handled by srfi-115's sre->pregexp: it embeds the ;; string as a raw pregexp fragment inside (?:...). + ;; SRE keywords that must never be replaced by registry entries. + ;; These are operators or named character classes in the SRE language. + (define sre-reserved-symbols + '(: seq or * + ? = >= ** => submatch submatch-named + not-submatch look-ahead neg-look-ahead look-behind neg-look-behind + w/nocase / char-range ~ complement - difference & intersection embed + ;; Named character classes + any alpha alphabetic digit numeric num alnum alphanumeric + space whitespace white upper upper-case lower lower-case + word ascii hex-digit xdigit epsilon eof)) + (define (splice-re-refs sre) (cond ;; Symbol with a registered re-object → (embed raw-pattern) + ;; But never replace SRE reserved keywords. [(and (symbol? sre) + (not (memq sre sre-reserved-symbols)) (hashtable-ref rx-registry sre #f)) => (lambda (r) (list 'embed (re-object-pat-string r)))] --- a/lib/std/rx/patterns.sls +++ b/lib/std/rx/patterns.sls @@ -73,8 +73,8 @@ (define-rx rx:domain (: rx:hostname "." rx:tld)) ;; Email - ;; local part: printable ASCII excluding whitespace and @ - (define-rx rx:email-local (+ (or alnum (/ #\! #\~)))) + ;; local part: common email characters (RFC 5321 subset) + (define-rx rx:email-local (+ (or alnum "." "_" "+" "-"))) (define-rx rx:email-domain rx:domain) (define-rx rx:email (: rx:email-local "@" rx:email-domain)) --- a/lib/std/srfi/srfi-115.sls +++ b/lib/std/srfi/srfi-115.sls @@ -149,9 +149,11 @@ [(ascii) "\\x00-\\x7f"] [(hex-digit xdigit) "0-9a-fA-F"] [else (error 'regexp "unknown char class" sre)])] + [(char? sre) + (char-class-quote-char sre)] [(string? sre) ;; Single string inside a char class — escape each character for use in [...] - (apply string-append (map pregexp-quote-char (string->list sre)))] + (apply string-append (map char-class-quote-char (string->list sre)))] [(pair? sre) (case (car sre) [(/ char-range) @@ -182,6 +184,12 @@ (string #\\ c) (string c))) + ;; Inside a character class [...], only ], \, ^, and - are special. + (define (char-class-quote-char c) + (if (memv c '(#\] #\\ #\^ #\-)) + (string #\\ c) + (string c))) + (define (join-with sep lst) (if (null? lst) "" (let loop ([rest (cdr lst)] [acc (car lst)])