mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-19 18:20:22 +02:00
Code Activity

* libguile/eval.c (s_missing_body_expression): New static identifier.

Browse source 
(s_body): Removed.

	(scm_m_expand_body): Fixed core dump when passing a body with
	defines, but without expressions (see additions to syntax.test).
	Use ASSERT_SYNTAX to signal syntax errors.

	* test-suite/tests/syntax.test (exception:missing-body-expr): New.

	Renamed section 'define' to 'top-level define' and added a new
	section 'internal define' with some tests.
This commit is contained in:
Dirk Herrmann 2003-11-08 08:11:14 +00:00
parent a5fda890f5
commit ced8edb0f9
4 changed files with 75 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

7
test-suite/ChangeLog
View file

@ -1,3 +1,10 @@
2003-11-08 Dirk Herrmann <D.Herrmann@tu-bs.de>
* tests/syntax.test (exception:missing-body-expr): New.
Renamed section 'define' to 'top-level define' and added a new
section 'internal define' with some tests.
2003-11-01 Dirk Herrmann <D.Herrmann@tu-bs.de>
* tests/syntax.test (exception:missing/extra-expr-misc): Removed.

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

@ -28,6 +28,8 @@
(cons 'syntax-error "Missing or extra expression"))
(define exception:missing-expr
(cons 'syntax-error "Missing expression"))
(define exception:missing-body-expr
(cons 'syntax-error "Missing body expression"))
(define exception:extra-expr
(cons 'syntax-error "Extra expression"))
(define exception:illegal-empty-combination
@ -588,13 +590,15 @@
(eval '(case 1 (else #f) ((1) #t))
(interaction-environment)))))
(with-test-prefix "define"
(with-test-prefix "top-level define"
(with-test-prefix "currying"
(pass-if "(define ((foo)) #f)"
(define ((foo)) #t)
((foo))))
(eval '(begin
(define ((foo)) #t)
((foo)))
(interaction-environment))))
(with-test-prefix "missing or extra expressions"
@ -603,6 +607,47 @@
(eval '(define)
(interaction-environment)))))
(with-test-prefix "internal define"
(pass-if "internal defines become letrec"
(eval '(let ((a identity) (b identity) (c identity))
(define (a x) (if (= x 0) 'a (b (- x 1))))
(define (b x) (if (= x 0) 'b (c (- x 1))))
(define (c x) (if (= x 0) 'c (a (- x 1))))
(and (eq? 'a (a 0) (a 3))
(eq? 'b (a 1) (a 4))
(eq? 'c (a 2) (a 5))))
(interaction-environment)))
(expect-fail "internal defines with begin"
(false-if-exception
(eval '(let ((a identity) (b identity) (c identity))
(define (a x) (if (= x 0) 'a (b (- x 1))))
(begin
(define (b x) (if (= x 0) 'b (c (- x 1)))))
(define (c x) (if (= x 0) 'c (a (- x 1))))
(and (eq? 'a (a 0) (a 3))
(eq? 'b (a 1) (a 4))
(eq? 'c (a 2) (a 5))))
(interaction-environment))))
(expect-fail "internal defines with empty begin"
(false-if-exception
(eval '(let ((a identity) (b identity) (c identity))
(define (a x) (if (= x 0) 'a (b (- x 1))))
(begin)
(define (b x) (if (= x 0) 'b (c (- x 1))))
(define (c x) (if (= x 0) 'c (a (- x 1))))
(and (eq? 'a (a 0) (a 3))
(eq? 'b (a 1) (a 4))
(eq? 'c (a 2) (a 5))))
(interaction-environment))))
(pass-if-exception "missing body expression"
exception:missing-body-expr
(eval '(let () (define x #t))
(interaction-environment))))
(with-test-prefix "set!"
(with-test-prefix "missing or extra expressions"