Ticket #281: irregex-named-submatches.diff

irregex.scm

@@ -159 +159 @@
   (if (pair? opt)
       (if (number? (car opt))
           (car opt)
-          (let lp ((ls (irregex-match-names m)))
-            (cond ((null? ls) (error "unknown match name" (car opt)))
-                  ((and (eq? (car opt) (caar ls))
-                        (%irregex-match-start-chunk m (cdar ls)))
-                   (cdar ls))
-                  (else (lp (cdr ls))))))
+          (let lp ((ls (irregex-match-names m))
+                   (exists #f))
+            (cond ((null? ls)
+                   (if exists #f (error "unknown match name" (car opt))))
+                  ((eq? (car opt) (caar ls))
+                   (if (%irregex-match-start-chunk m (cdar ls))
+                       (cdar ls)
+                       (lp (cdr ls) #t)))
+                  (else (lp (cdr ls) exists)))))
       0))
 
 (define (%irregex-match-valid-index? m n)
@@ -183 +186 @@
       (error "irregex-match-substring: not match data" m))
   (let* ((cnk (irregex-match-chunker m))
          (n (irregex-match-index m opt)))
-    (and (%irregex-match-valid-index? m n)
+    (and n
+         (%irregex-match-valid-index? m n)
          ((chunker-get-substring cnk)
           (%irregex-match-start-chunk m n)
           (%irregex-match-start-index m n)

test-irregex.scm

@@ -283 +283 @@
        (lambda (src i s) (reverse s))))
   )
 
-
 (define (extract name irx str)
   (irregex-match-substring (irregex-match irx str) name))
 
 (test-group "named submatches"
+  (test "matching submatch is seen and extracted"
+        "first" (extract 'first `(or (submatch-named first "first")
+                                     (submatch-named second "second"))
+                         "first"))
+  (test "nonmatching submatch is known but returns false"
+        #f (extract 'second `(or (submatch-named first "first")
+                                 (submatch-named second "second"))
+                    "first"))
+  (test-error "nonexisting submatch is unknown and raises an error"
+              (extract 'third `(or (submatch-named first "first")
+                                   (submatch-named second "second"))
+                       "first"))
   (test "matching alternative is used"
         "first" (extract 'sub `(or (submatch-named sub "first")
                                    (submatch-named sub "second"))