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

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

Named submatches fix for Chicken

  • irregex-core.scm

    diff --git a/irregex-core.scm b/irregex-core.scm
    index db8a1e8..dd9792d 100644
    a b  
    252252  (if (pair? opt)
    253253      (if (number? (car opt))
    254254          (car opt)
    255           (let lp ((ls (irregex-match-names m)))
    256             (cond ((null? ls) (error "unknown match name" (car opt)))
    257                   ((and (eq? (car opt) (caar ls))
    258                         (%irregex-match-start-chunk m (cdar ls)))
    259                    (cdar ls))
    260                   (else (lp (cdr ls))))))
     255          (let lp ((ls (irregex-match-names m))
     256                   (exists #f))
     257            (cond ((null? ls)
     258                   (if exists #f (error "unknown match name" (car opt))))
     259                  ((eq? (car opt) (caar ls))
     260                   (if (%irregex-match-start-chunk m (cdar ls))
     261                       (cdar ls)
     262                       (lp (cdr ls) #t)))
     263                  (else (lp (cdr ls) exists)))))
    261264      0))
    298301         (get-subchunk (chunker-get-subchunk cnk)))
    299302    (if (not get-subchunk)
    300303        (error "this chunk type does not support match subchunks")
    301         (and (%irregex-match-valid-index? m n)
     304        (and n
     305             (%irregex-match-valid-index? m n)
    302306             (get-subchunk
    303307              (%irregex-match-start-chunk m n)
    304308              (%irregex-match-start-index m n)
  • tests/test-irregex.scm

    diff --git a/tests/test-irregex.scm b/tests/test-irregex.scm
    index fbeb628..7007ec7 100644
    a b  
    295295  (irregex-match-substring (irregex-match irx str) name))
    297297(test-group "named submatches"
    298   (test-equal "matching alternative is used"
     298  (test "matching submatch is seen and extracted"
     299        "first" (extract 'first `(or (submatch-named first "first")
     300                                     (submatch-named second "second"))
     301                         "first"))
     302  (test "nonmatching submatch is known but returns false"
     303        #f (extract 'second `(or (submatch-named first "first")
     304                                 (submatch-named second "second"))
     305                    "first"))
     306  (test-error "nonexisting submatch is unknown and raises an error"
     307              (extract 'third `(or (submatch-named first "first")
     308                                   (submatch-named second "second"))
     309                       "first"))
     310  (test "matching alternative is used"
    299311        "first" (extract 'sub `(or (submatch-named sub "first")
    300312                                   (submatch-named sub "second"))
    301313                         "first"))
    302   (test-equal "matching alternative is used (second match)"
     314  (test "matching alternative is used (second match)"
    303315        "second" (extract 'sub `(or (submatch-named sub "first")
    304316                                    (submatch-named sub "second"))
    305317                         "second"))
    306   (test-equal "last match is used with multiple matches for a name"
     318  (test "last match is used with multiple matches for a name"
    307319        "second" (extract 'sub `(seq (submatch-named sub "first")
    308320                                     space
    309321                                     (submatch-named sub "second"))