Ticket #281: total-irregex-named-submatches.diff

irregex-core.scm

@@ -252 +252 @@
   (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))
 
 (cond-expand
@@ -298 +301 @@
          (get-subchunk (chunker-get-subchunk cnk)))
     (if (not get-subchunk)
         (error "this chunk type does not support match subchunks")
-        (and (%irregex-match-valid-index? m n)
+        (and n
+             (%irregex-match-valid-index? m n)
              (get-subchunk
               (%irregex-match-start-chunk m n)
               (%irregex-match-start-index m n)

tests/test-irregex.scm

@@ -295 +295 @@
   (irregex-match-substring (irregex-match irx str) name))
 
 (test-group "named submatches"
-  (test-equal "matching alternative is used"
+  (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"))
                          "first"))
-  (test-equal "matching alternative is used (second match)"
+  (test "matching alternative is used (second match)"
         "second" (extract 'sub `(or (submatch-named sub "first")
                                     (submatch-named sub "second"))
                          "second"))
-  (test-equal "last match is used with multiple matches for a name"
+  (test "last match is used with multiple matches for a name"
         "second" (extract 'sub `(seq (submatch-named sub "first")
                                      space
                                      (submatch-named sub "second"))