1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 01:30:27 +02:00

syntax-case: fix error reporting for misplaced ellipses.

Reported by taylanbayirli@gmail.com (Taylan Ulrich B.).

* module/ice-9/psyntax.scm (cvt*): Use 'syntax-case' to destructure
  the pattern tail, instead of 'pair?', 'car', and 'cdr'.
  (gen-clause): When checking for errors, check for misplaced ellipsis
  before duplicate pattern variables, to improve the error message in
  case of multiple misplaced ellipses.

* module/ice-9/psyntax-pp.scm: Regenerate.

* test-suite/tests/syntax.test: Add tests.
This commit is contained in:
Mark H Weaver 2013-12-13 12:53:24 -05:00
parent d8c476b68d
commit aa8630efb3
3 changed files with 80 additions and 19 deletions

View file

@ -1171,3 +1171,60 @@
(unreachable))))))
(r 'outer))
#t)))
(with-test-prefix "syntax-case"
(pass-if-syntax-error "duplicate pattern variable"
'(syntax-case . "duplicate pattern variable")
(eval '(lambda (e)
(syntax-case e ()
((a b c d e d f) #f)))
(interaction-environment)))
(with-test-prefix "misplaced ellipses"
(pass-if-syntax-error "bare ellipsis"
'(syntax-case . "misplaced ellipsis")
(eval '(lambda (e)
(syntax-case e ()
(... #f)))
(interaction-environment)))
(pass-if-syntax-error "ellipsis singleton"
'(syntax-case . "misplaced ellipsis")
(eval '(lambda (e)
(syntax-case e ()
((...) #f)))
(interaction-environment)))
(pass-if-syntax-error "ellipsis in car"
'(syntax-case . "misplaced ellipsis")
(eval '(lambda (e)
(syntax-case e ()
((... . _) #f)))
(interaction-environment)))
(pass-if-syntax-error "ellipsis in cdr"
'(syntax-case . "misplaced ellipsis")
(eval '(lambda (e)
(syntax-case e ()
((_ . ...) #f)))
(interaction-environment)))
(pass-if-syntax-error "two ellipses in the same list"
'(syntax-case . "misplaced ellipsis")
(eval '(lambda (e)
(syntax-case e ()
((x ... y ...) #f)))
(interaction-environment)))
(pass-if-syntax-error "three ellipses in the same list"
'(syntax-case . "misplaced ellipsis")
(eval '(lambda (e)
(syntax-case e ()
((x ... y ... z ...) #f)))
(interaction-environment)))))
;;; Local Variables:
;;; eval: (put 'pass-if-syntax-error 'scheme-indent-function 1)
;;; End: