Ticket #281: irregex-named-submatches.diff

File irregex-named-submatches.diff, 2.4 KB (added by sjamaan, 14 years ago)

Fixes extraction of existing, but nonmatching named submatches

  • irregex.scm

    diff -r bc532fb2efc4 irregex.scm
    a b  
    159159  (if (pair? opt)
    160160      (if (number? (car opt))
    161161          (car opt)
    162           (let lp ((ls (irregex-match-names m)))
    163             (cond ((null? ls) (error "unknown match name" (car opt)))
    164                   ((and (eq? (car opt) (caar ls))
    165                         (%irregex-match-start-chunk m (cdar ls)))
    166                    (cdar ls))
    167                   (else (lp (cdr ls))))))
     162          (let lp ((ls (irregex-match-names m))
     163                   (exists #f))
     164            (cond ((null? ls)
     165                   (if exists #f (error "unknown match name" (car opt))))
     166                  ((eq? (car opt) (caar ls))
     167                   (if (%irregex-match-start-chunk m (cdar ls))
     168                       (cdar ls)
     169                       (lp (cdr ls) #t)))
     170                  (else (lp (cdr ls) exists)))))
    168171      0))
    170173(define (%irregex-match-valid-index? m n)
    183186      (error "irregex-match-substring: not match data" m))
    184187  (let* ((cnk (irregex-match-chunker m))
    185188         (n (irregex-match-index m opt)))
    186     (and (%irregex-match-valid-index? m n)
     189    (and n
     190         (%irregex-match-valid-index? m n)
    187191         ((chunker-get-substring cnk)
    188192          (%irregex-match-start-chunk m n)
    189193          (%irregex-match-start-index m n)
  • test-irregex.scm

    diff -r bc532fb2efc4 test-irregex.scm
    a b  
    283283       (lambda (src i s) (reverse s))))
    284284  )
    287286(define (extract name irx str)
    288287  (irregex-match-substring (irregex-match irx str) name))
    290289(test-group "named submatches"
     290  (test "matching submatch is seen and extracted"
     291        "first" (extract 'first `(or (submatch-named first "first")
     292                                     (submatch-named second "second"))
     293                         "first"))
     294  (test "nonmatching submatch is known but returns false"
     295        #f (extract 'second `(or (submatch-named first "first")
     296                                 (submatch-named second "second"))
     297                    "first"))
     298  (test-error "nonexisting submatch is unknown and raises an error"
     299              (extract 'third `(or (submatch-named first "first")
     300                                   (submatch-named second "second"))
     301                       "first"))
    291302  (test "matching alternative is used"
    292303        "first" (extract 'sub `(or (submatch-named sub "first")
    293304                                   (submatch-named sub "second"))