[uim-commit] r2312 - in branches/r5rs/sigscheme: . test

Thu Dec 1 11:40:16 PST 2005

Author: kzk
Date: 2005-12-01 11:40:10 -0800 (Thu, 01 Dec 2005)
New Revision: 2312

Modified:
   branches/r5rs/sigscheme/eval.c
   branches/r5rs/sigscheme/test/test-define.scm
Log:
* sigscheme/test/test-define.scm
  - add testcases for "define" invalid forms

* sigscheme/eval.c
  - (ScmExp_define): fix crash bug, more strict check for argument
    extraction.


Modified: branches/r5rs/sigscheme/eval.c
===================================================================

--- branches/r5rs/sigscheme/eval.c	2005-12-01 19:10:49 UTC (rev 2311)
+++ branches/r5rs/sigscheme/eval.c	2005-12-01 19:40:10 UTC (rev 2312)
@@ -1535,8 +1535,11 @@
     if (SYMBOLP(var)) {
         if (NULLP(rest))
             SigScm_Error("define : missing expression");
+        if (!CONSP(rest))
+            ERR_OBJ("proper list is required as <expression> but got", rest);
 
         define_internal(var, POP_ARG(rest), env);
+        ASSERT_NO_MORE_ARG(rest);
     }
 
     /*========================================================================
@@ -1552,6 +1555,8 @@
 
         if (NULLP(body))
             SigScm_Error("define : missing function body");
+        if (!CONSP(body))
+            ERR_OBJ("proper list is required as <body> but got", body);
 
         if (!SYMBOLP(procname))
             ERR_OBJ("symbol required but got", procname);

Modified: branches/r5rs/sigscheme/test/test-define.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-define.scm	2005-12-01 19:10:49 UTC (rev 2311)
+++ branches/r5rs/sigscheme/test/test-define.scm	2005-12-01 19:40:10 UTC (rev 2312)
@@ -1,5 +1,25 @@
 (load "./test/unittest.scm")
 
+; invalid form
+(assert-error "define invalid form #1"
+	      (lambda ()
+		(define)))
+(assert-error "define invalid form #2"
+	      (lambda ()
+		(define a)))
+(assert-error "define invalid form #3"
+	      (lambda ()
+		(define 1 1)))
+(assert-error "define invalid form #4"
+	      (lambda ()
+		(define a 1 'excessive)))
+(assert-error "define invalid form #5"
+	      (lambda ()
+		(define a . 2)))
+(assert-error "define invalid form #6"
+	      (lambda ()
+		(define (f x) . x)))
+
 ; basic define
 (define val1 3)
 (assert-equal? "basic define check" 3 val1)
@@ -69,7 +89,6 @@
 ; set!
 (define (set-dot a . b)
   (set! b '(1 2))
-  (display b)
   b)
 
 (assert-equal? "set dot test" '(1 2) (set-dot '()))

