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

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-11-08 11:14:06 -0800 (Tue, 08 Nov 2005)
New Revision: 2094

Modified:
   branches/r5rs/sigscheme/eval.c
   branches/r5rs/sigscheme/test/test-exp.scm
Log:
* sigscheme/eval.c
  - (ScmExp_cond):
    * Add proper 'else' handlings
    * Add syntax checkings
    * Simplify
* sigscheme/test/test-exp.scm
  - Mark all test passed


Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c	2005-11-08 18:25:41 UTC (rev 2093)
+++ branches/r5rs/sigscheme/eval.c	2005-11-08 19:14:06 UTC (rev 2094)
@@ -951,22 +951,27 @@
      *     (else <expression1> <expression2> ...)
      */
     ScmObj env    = eval_state->env;
-    ScmObj clause = SCM_NULL;
-    ScmObj test   = SCM_NULL;
-    ScmObj exps   = SCM_NULL;
-    ScmObj proc   = SCM_NULL;
+    ScmObj clause = SCM_FALSE;
+    ScmObj test   = SCM_FALSE;
+    ScmObj exps   = SCM_FALSE;
+    ScmObj proc   = SCM_FALSE;
     DECLARE_FUNCTION("cond", SyntaxVariadicTailRec0);
 
+    if (NO_MORE_ARG(args))
+        ERR("cond: syntax error: at least one clause required");
+
     /* looping in each clause */
-    for (; !NULLP(args); args = CDR(args)) {
-        clause = CAR(args);
+    while (clause = POP_ARG(args), VALIDP(clause)) {
         if (!CONSP(clause))
             ERR_OBJ("bad clause", clause);
 
         test = CAR(clause);
         exps = CDR(clause);
 
-        test = EVAL(test, env);
+        if (EQ(test, SYM_ELSE))
+            ASSERT_NO_MORE_ARG(args);
+        else
+            test = EVAL(test, env);
 
         if (NFALSEP(test)) {
             /*
@@ -974,8 +979,12 @@
              * <expression>s, then the value of the <test> is returned as the
              * result.
              */
-            if (NULLP(exps))
-                return test;
+            if (NULLP(exps)) {
+                if (EQ(test, SYM_ELSE))
+                    ERR_OBJ("bad clause: else with no expressions", clause);
+                else
+                    return test;
+            }
 
             /*
              * If the selected <clause> uses the => alternate form, then the
@@ -984,10 +993,12 @@
              * of the <test> and the value returned by this procedure is
              * returned by the cond expression.
              */
-            if (EQ(SYM_YIELDS, CAR(exps)) && !NULLP(CDR(exps))) {
+            if (EQ(SYM_YIELDS, CAR(exps)) && CONSP(CDR(exps))) {
+                if (!NULLP(CDDR(exps)))
+                    ERR_OBJ("bad clause", clause);
                 proc = EVAL(CADR(exps), env);
-                if (FALSEP(ScmOp_procedurep(proc)))
-                    ERR_OBJ("the value of exp after => must be the procedure but got", proc);
+                if (!PROCEDUREP(proc))
+                    ERR_OBJ("exp after => must be the procedure but got", proc);
 
                 return Scm_call(proc, LIST_1(test));
             }

Modified: branches/r5rs/sigscheme/test/test-exp.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-exp.scm	2005-11-08 18:25:41 UTC (rev 2093)
+++ branches/r5rs/sigscheme/test/test-exp.scm	2005-11-08 19:14:06 UTC (rev 2094)
@@ -74,7 +74,6 @@
 ;; cond
 ;;
 
-;; FAILED
 (assert-error  "cond invalid form #1"
                (lambda ()
                  (cond)))
@@ -87,14 +86,12 @@
                  (cond
                   ()
                   (else #t))))
-;; FAILED
 ;; 'else' followed by another caluse
 (assert-error  "cond invalid form #4"
                (lambda ()
                  (cond
                   (else #t)
                   (#t))))
-;; FAILED
 ;; not specified in R5RS, but SigScheme should cause error
 (if (provided? "sigscheme")
     (assert-error  "cond invalid form #5"