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

(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.

libguile/ChangeLog

@@ -1,3 +1,13 @@
+2003-11-08  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+	* eval.c (s_missing_body_expression): New static identifier.
+
+	(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.
+
 2003-11-02  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
 	* eval.c (canonicalize_define): New static helper function.

libguile/eval.c

@@ -114,6 +114,12 @@ static const char s_expression[] = "Missing or extra expression in";
  * context, a 'Missing expression' error is signalled.  */
 static const char s_missing_expression[] = "Missing expression in";
 
+/* A body may hold an arbitrary number of internal defines, followed by a
+ * non-empty sequence of expressions.  If a body with an empty sequence of
+ * expressions is detected, a 'Missing body expression' error is signalled.
+ */
+static const char s_missing_body_expression[] = "Missing body expression in";
+
 /* If a form is detected that holds more expressions than are allowed in that
  * context, an 'Extra expression' error is signalled.  */
 static const char s_extra_expression[] = "Extra expression in";
@@ -408,7 +414,6 @@ SCM_REC_MUTEX (source_mutex);
 
 
 static const char s_test[] = "bad test";
-static const char s_body[] = "bad body";
 static const char s_bindings[] = "bad bindings";
 static const char s_duplicate_bindings[] = "duplicate bindings";
 static const char s_variable[] = "bad variable";
@@ -1826,7 +1831,6 @@ SCM
 scm_m_expand_body (SCM xorig, SCM env)
 {
   SCM x = SCM_CDR (xorig), defs = SCM_EOL;
-  char *what = SCM_ISYMCHARS (SCM_CAR (xorig)) + 2;
 
   while (SCM_NIMP (x))
     {
@@ -1861,6 +1865,10 @@ scm_m_expand_body (SCM xorig, SCM env)
 	}
     }
 
+  /* FIXME: xorig is already partially memoized and does not hold information
+   * about the file location.  */
+  ASSERT_SYNTAX (SCM_CONSP (x), s_missing_body_expression, xorig);
+
   if (!SCM_NULLP (defs))
     {
       SCM rvars, inits, body, letrec;
@@ -1873,7 +1881,6 @@ scm_m_expand_body (SCM xorig, SCM env)
     }
   else
     {
-      SCM_ASSYNT (SCM_CONSP (x), s_body, what);
       SCM_SETCAR (xorig, SCM_CAR (x));
       SCM_SETCDR (xorig, SCM_CDR (x));
     }

test-suite/ChangeLog

@@ -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.

test-suite/tests/syntax.test

@@ -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"