cs & regexp: report unmatched )

Closes #3854
This commit is contained in:
Matthew Flatt 2021-05-29 07:11:46 -05:00
parent c7eb001be3
commit d4dc2683aa
3 changed files with 24 additions and 10 deletions

View File

@ -1521,6 +1521,8 @@
;; Regexps that shouldn't work: ;; Regexps that shouldn't work:
(err/rt-test (regexp "[a--b]") exn:fail?) (err/rt-test (regexp "[a--b]") exn:fail?)
(err/rt-test (regexp "[a-b-c]") exn:fail?) (err/rt-test (regexp "[a-b-c]") exn:fail?)
(err/rt-test (regexp "abc)") exn:fail?)
(err/rt-test (pregexp "abc)") exn:fail?)
;; A good test of unicode-friendly ".": ;; A good test of unicode-friendly ".":
(test '("load-extension: couldn't open \\\" (%s)\"") (test '("load-extension: couldn't open \\\" (%s)\"")

View File

@ -2972,13 +2972,20 @@
(lambda () (parse-regexp.1 unsafe-undefined p3_0 0 config_0)) (lambda () (parse-regexp.1 unsafe-undefined p3_0 0 config_0))
(case-lambda (case-lambda
((rx_0 pos_0) ((rx_0 pos_0)
(let ((pos_1 pos_0))
(let ((tmp_0
(if (let ((app_0 pos_1)) (= app_0 (chytes-length$1 p3_0)))
'eos
(chytes-ref/char p3_0 pos_1))))
(if (eqv? tmp_0 '#\x29)
(parse-error p3_0 pos_0 config_0 "unmatched `)` in pattern")
(let ((app_0 (let ((app_0
(begin-unsafe (begin-unsafe
(unbox (parse-config-group-number-box config_0))))) (unbox (parse-config-group-number-box config_0)))))
(values (values
rx_0 rx_0
app_0 app_0
(unbox (parse-config-references?-box config_0))))) (unbox (parse-config-references?-box config_0))))))))
(args (raise-binding-result-arity-error 2 args))))))))) (args (raise-binding-result-arity-error 2 args)))))))))
(define parse-regexp.1 (define parse-regexp.1
(|#%name| (|#%name|

View File

@ -15,9 +15,14 @@
(define (parse p #:px? [px? #f]) (define (parse p #:px? [px? #f])
(define config (make-parse-config #:px? px?)) (define config (make-parse-config #:px? px?))
(define-values (rx pos) (parse-regexp p 0 config)) (define-values (rx pos) (parse-regexp p 0 config))
(chyte-case/eos
p pos
[(#\))
(parse-error p pos config "unmatched `)` in pattern")]
[else
(values rx (values rx
(config-group-number config) (config-group-number config)
(unbox (parse-config-references?-box config)))) (unbox (parse-config-references?-box config)))]))
;; Returns (values rx position) ;; Returns (values rx position)
(define (parse-regexp s pos config #:parse-regexp [parse-regexp (lambda (s pos config) (define (parse-regexp s pos config #:parse-regexp [parse-regexp (lambda (s pos config)