mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

catch syntax errors in unquote and unquote-splicing

Browse source 
* module/ice-9/psyntax.scm (quasiquote): Catch syntax errors in unquote
  and unquote-splicing.

* module/ice-9/psytax-pp.scm: Regenerated.
This commit is contained in:
Andy Wingo 2009-05-21 22:11:48 +02:00
parent 2032f3d1db
commit 40b36cfbbe
3 changed files with 29 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

22
module/ice-9/psyntax-pp.scm
View file

File diff suppressed because one or more lines are too long

10
module/ice-9/psyntax.scm
View file

@ -2355,12 +2355,22 @@
(syntax p) (syntax p)
(quasicons (syntax (quote unquote)) (quasicons (syntax (quote unquote))
(quasi (syntax (p)) (- lev 1))))) (quasi (syntax (p)) (- lev 1)))))
((unquote . args)
(= lev 0)
(syntax-violation 'unquote
"unquote takes exactly one argument"
p (syntax (unquote . args))))
(((unquote-splicing p) . q) (((unquote-splicing p) . q)
(if (= lev 0) (if (= lev 0)
(quasiappend (syntax p) (quasi (syntax q) lev)) (quasiappend (syntax p) (quasi (syntax q) lev))
(quasicons (quasicons (syntax (quote unquote-splicing)) (quasicons (quasicons (syntax (quote unquote-splicing))
(quasi (syntax (p)) (- lev 1))) (quasi (syntax (p)) (- lev 1)))
(quasi (syntax q) lev)))) (quasi (syntax q) lev))))
(((unquote-splicing . args) . q)
(= lev 0)
(syntax-violation 'unquote-splicing
"unquote-splicing takes exactly one argument"
p (syntax (unquote-splicing . args))))
((quasiquote p) ((quasiquote p)
(quasicons (syntax (quote quasiquote)) (quasicons (syntax (quote quasiquote))
(quasi (syntax (p)) (+ lev 1)))) (quasi (syntax (p)) (+ lev 1))))

11
test-suite/tests/syntax.test
View file

@ -21,6 +21,11 @@
:use-module (test-suite lib)) :use-module (test-suite lib))
(define exception:generic-syncase-error
(cons 'syntax-error "Source expression failed to match"))
(define exception:unexpected-syntax
(cons 'syntax-error "unexpected syntax"))
(define exception:bad-expression (define exception:bad-expression
(cons 'syntax-error "Bad expression")) (cons 'syntax-error "Bad expression"))
@ -67,13 +72,13 @@
(with-test-prefix "Bad argument list" (with-test-prefix "Bad argument list"
(pass-if-exception "improper argument list of length 1" (pass-if-exception "improper argument list of length 1"
exception:wrong-num-args exception:generic-syncase-error
(eval '(let ((foo (lambda (x y) #t))) (eval '(let ((foo (lambda (x y) #t)))
(foo . 1)) (foo . 1))
(interaction-environment))) (interaction-environment)))
(pass-if-exception "improper argument list of length 2" (pass-if-exception "improper argument list of length 2"
exception:wrong-num-args exception:generic-syncase-error
(eval '(let ((foo (lambda (x y) #t))) (eval '(let ((foo (lambda (x y) #t)))
(foo 1 . 2)) (foo 1 . 2))
(interaction-environment)))) (interaction-environment))))
@ -88,7 +93,7 @@
;; Fixed on 2001-3-3 ;; Fixed on 2001-3-3
(pass-if-exception "empty parentheses \"()\"" (pass-if-exception "empty parentheses \"()\""
exception:illegal-empty-combination exception:unexpected-syntax
(eval '() (eval '()
(interaction-environment))))) (interaction-environment)))))