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

Wed Jan 4 12:05:30 PST 2006

Author: yamaken
Date: 2006-01-04 12:05:25 -0800 (Wed, 04 Jan 2006)
New Revision: 2785

Modified:
   branches/r5rs/sigscheme/TODO
   branches/r5rs/sigscheme/operations-srfi2.c
   branches/r5rs/sigscheme/test/test-srfi2.scm
Log:
* sigscheme/operations-srfi2.c
  - (scm_initialize_srfi2): Cosmetic change
  - (scm_s_srfi2_and_letstar):
    * Fix SEGV on dot list as claws
    * Cleanup variable declaration
* sigscheme/test/test-srfi2.scm
  - Add tests for the SEGV condition
* sigscheme/TODO
  - Update


Modified: branches/r5rs/sigscheme/TODO
===================================================================

--- branches/r5rs/sigscheme/TODO	2006-01-04 19:36:21 UTC (rev 2784)
+++ branches/r5rs/sigscheme/TODO	2006-01-04 20:05:25 UTC (rev 2785)
@@ -12,9 +12,8 @@
 * Fix all destructive expression on macros
 
 * Review and refactor all functions in syntax.c(listran, vectran,
-  qquote_internal, scm_s_quasiquote, scm_s_do), operations-srfi{1,2}.c,
-  encoding.[hc] and *port.[hc] (other files had already been done except for
-  the destructive exp on macros)
+  qquote_internal, scm_s_quasiquote, scm_s_do), encoding.[hc] and *port.[hc]
+  (other files had already been done except for the destructive exp on macros)
 
 * Investigate behavior of other Scheme implementations about constant vector
   and list
@@ -49,6 +48,9 @@
 
 * Add Big5 to encoding.c
 
+* Complete operations-srfi1.c and make it production quality if considerable
+  benefit exists against SLIB version of SRFI-1 implementation
+
 ==============================================================================
 Performance improvements:
 

Modified: branches/r5rs/sigscheme/operations-srfi2.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi2.c	2006-01-04 19:36:21 UTC (rev 2784)
+++ branches/r5rs/sigscheme/operations-srfi2.c	2006-01-04 20:05:25 UTC (rev 2785)
@@ -1,6 +1,7 @@
 /*===========================================================================
  *  FileName : operations-srfi2.c
- *  About    : AND-LET*: an AND with local bindings, a guarded LET* special form
+ *  About    : SRFI-2 AND-LET*: an AND with local bindings, a guarded LET*
+ *             special form
  *
  *  Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.jp>
  *
@@ -64,22 +65,17 @@
 void
 scm_initialize_srfi2(void)
 {
-    /*=======================================================================
-      SRFI-2 Procedure
-    =======================================================================*/
     REGISTER_FUNC_TABLE(srfi2_func_info_table);
 }
 
 ScmObj
 scm_s_srfi2_and_letstar(ScmObj claws, ScmObj body, ScmEvalState *eval_state)
 {
-    ScmObj env  = eval_state->env;
-    ScmObj claw = SCM_FALSE;
-    ScmObj var  = SCM_FALSE;
-    ScmObj val  = SCM_FALSE;
-    ScmObj exp  = SCM_FALSE;
+    ScmObj env, claw, var, val, exp;
     DECLARE_FUNCTION("and-let*", syntax_variadic_tailrec_1);
 
+    env = eval_state->env;
+
     /*========================================================================
       (and-let* <claws> <body>)
 
@@ -88,8 +84,7 @@
                    | <bound-variable>
     ========================================================================*/
     if (CONSP(claws)) {
-        for (; !NULLP(claws); claws = CDR(claws)) {
-            claw = CAR(claws);
+        while (claw = POP_ARG(claws), VALIDP(claw)) {
             if (CONSP(claw)) {
                 if (NULLP(CDR(claw))) {
                     /* (<expression>) */
@@ -115,6 +110,8 @@
             if (FALSEP(val))
                 return SCM_FALSE;
         }
+        if (!NULLP(claws))
+            goto err;
     } else if (NULLP(claws)) {
         env = scm_extend_environment(SCM_NULL, SCM_NULL, env);
     } else {

Modified: branches/r5rs/sigscheme/test/test-srfi2.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-srfi2.scm	2006-01-04 19:36:21 UTC (rev 2784)
+++ branches/r5rs/sigscheme/test/test-srfi2.scm	2006-01-04 20:05:25 UTC (rev 2785)
@@ -31,6 +31,9 @@
 ;;  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (load "./test/unittest.scm")
+
+(define tn test-name)
+
 (use srfi-2)
 
 ;; (and-let* <claws> <body>)
@@ -42,6 +45,10 @@
 (define true #t)
 (define false #f)
 
+(tn "and-let* invalid form")
+(assert-error (tn) (lambda () (and-let* ((#t) . #t) #t)))
+(assert-error (tn) (lambda () (and-let* ((foo #t) . #t) #t)))
+
 ; and-let*
 (assert-true  "and-let* test 1" (and-let* () #t))
 (assert-true  "and-let* test 2" (and-let* () #t #t))

