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

kzk at freedesktop.org kzk at freedesktop.org
Sun Aug 21 21:48:34 EST 2005


Author: kzk
Date: 2005-08-21 04:48:30 -0700 (Sun, 21 Aug 2005)
New Revision: 1267

Modified:
   branches/r5rs/sigscheme/datas.c
   branches/r5rs/sigscheme/operations.c
   branches/r5rs/sigscheme/sigscheme.c
   branches/r5rs/sigscheme/sigscheme.h
   branches/r5rs/sigscheme/test/bigloo-list.scm
   branches/r5rs/sigscheme/test/io.scm
   branches/r5rs/sigscheme/test/test-apply.scm
   branches/r5rs/sigscheme/test/test-continuation.scm
   branches/r5rs/sigscheme/test/test-define.scm
   branches/r5rs/sigscheme/test/test-delay-force.scm
   branches/r5rs/sigscheme/test/test-equation.scm
   branches/r5rs/sigscheme/test/test-eval.scm
   branches/r5rs/sigscheme/test/test-exp.scm
   branches/r5rs/sigscheme/test/test-list.scm
   branches/r5rs/sigscheme/test/test-num.scm
   branches/r5rs/sigscheme/test/test-string.scm
   branches/r5rs/sigscheme/test/unittest-bigloo.scm
Log:
* Apply big patch from Jun Inoue<jun.lambda at gmail.com>. Thank you very much!
* Using assert-equal? instead of assert-eq? in test case

* test/test-eval.scm
* test/test-define.scm
* test/test-exp.scm
* test/test-string.scm
* test/test-equation.scm
* test/test-apply.scm
* test/test-delay-force.scm
* test/test-num.scm
* test/test-continuation.scm
* test/test-list.scm
  - use assert-equal? instead of assert-eq? for value comparison

* test/unittest-bigloo.scm
  - (test): fix mistake
* test/io.scm
  - show message

* sigscheme/sigscheme.c
  - (SigScm_Initialize)
    : change "<", ">", "<=" and ">=" funcname.
    : change "+", "*", "-", "/" type
    : change "number->string" type
    : move scm_return_value's declaration place
* sigscheme/sigscheme.h
  - (ScmOp_less): renamed from ScmOp_bigger
  - (ScmOp_greater): renamed from ScmOp_smaller
  - (ScmOp_lessEq): renamed from ScmOp_biggerEq
  - (ScmOp_greaterEq): renamed from ScmOp_smallerEq
  - (ScmOp_plus2n, ScmOp_minus2n, ScmOp_multi2n, ScmOp_divide2n): removed
  - (ScmOp_plus, ScmOp_minus, ScmOp_times, ScmOp_divide): new func
  - (ScmOp_number_to_string): support radix
* sigscheme/operations.c
  - (list_gettail, ScmOp_append_internal): removed
  - (ScmOp_less): renamed from ScmOp_bigger
  - (ScmOp_greater): renamed from ScmOp_smaller
  - (ScmOp_lessEq): renamed from ScmOp_biggerEq
  - (ScmOp_greaterEq): renamed from ScmOp_smallerEq
  - (ScmOp_plus2n, ScmOp_minus2n, ScmOp_multi2n, ScmOp_divide2n): removed
  - (ScmOp_plus, ScmOp_minus, ScmOp_times, ScmOp_divide): new func
  - (ScmOp_number_to_string): support radix
  - (ScmOp_equal): more proper arg len check
  - (ScmOp_c_length): remove unnecessary check
  - (ScmOp_append): not to destruct given list
  - (ScmOp_listtail_internal): change to while loop from recursive call
  - (ScmOp_list_ref): more informational error message
  - (ScmOp_memq): remove unnecessary check
  - (ScmOp_assq, ScmOp_assv, ScmOp_member): strict check when SCM_STRICT_R5RS is
    defined
  - (ScmOp_symbol_to_string): goto error when non-symbol is given as argument
  - (ScmOp_string_to_symbol): use Scm_NewStringCopying
* sigscheme/datas.c
  - (allocate_heap, add_heap): optimize



Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/datas.c	2005-08-21 11:48:30 UTC (rev 1267)
@@ -124,8 +124,8 @@
 /*=======================================
   Variable Declarations
 =======================================*/
-static int           SCM_HEAP_SIZE = 16384;
-static int           scm_heap_num  = 64;
+static int           SCM_HEAP_SIZE = 10240;
+static int           scm_heap_num  = 8;
 static ScmObjHeap   *scm_heaps     = NULL;
 static ScmObj        scm_freelist  = NULL;
 
@@ -204,9 +204,7 @@
 static void allocate_heap(ScmObjHeap **heaps, int num_heap, int HEAP_SIZE, ScmObj *freelist)
 {
     int i = 0;
-    int j = 0;
-    ScmObj prev = NULL;
-    ScmObj next = NULL;
+    ScmObj heap, cell;
 
 #if DEBUG_GC
     printf("allocate_heap num:%d size:%d\n", num_heap, HEAP_SIZE);
@@ -219,27 +217,17 @@
     /* fill with zero and construct free_list */
     for (i = 0; i < num_heap; i++) {
         /* Initialize Heap */
-        (*heaps)[i] = (ScmObj)malloc_aligned(sizeof(ScmObjInternal) * HEAP_SIZE);
-        memset((*heaps)[i], 0, sizeof(ScmObjInternal) * HEAP_SIZE);
+	heap = (ScmObj)malloc_aligned(sizeof(ScmObjInternal) * HEAP_SIZE);
+        (*heaps)[i] = heap;
 
         /* link in order */
-        prev = NULL;
-        next = NULL;
-        for (j = 0; j < HEAP_SIZE; j++) {
-            next = &(*heaps)[i][j];
-	    SCM_SETFREECELL(next);
-
-	    /* prev's cdr is next */
-	    if (prev)
-		SCM_SETFREECELL_CDR(prev, next);
-
-            /* the last cons' cdr is freelist */
-            if (j == HEAP_SIZE - 1)
-		SCM_SETFREECELL_CDR(next, (*freelist));
-
-            prev = next;
+        for (cell=heap; cell-heap < HEAP_SIZE; cell++) {
+	    SCM_SETFREECELL(cell);
+	    SCM_DO_UNMARK(cell);
+	    SCM_SETFREECELL_CDR(cell, cell+1);
         }
 
+	SCM_SETFREECELL_CDR(cell-1, (*freelist));
 	/* and freelist is head of the heap */
 	(*freelist) = (*heaps)[i];
     }
@@ -247,10 +235,8 @@
 
 static void add_heap(ScmObjHeap **heaps, int *orig_num_heap, int HEAP_SIZE, ScmObj *freelist)
 {
-    int    i = 0;
     int    num_heap = 0;
-    ScmObj prev     = NULL;
-    ScmObj next     = NULL;
+    ScmObj heap, cell;
 
 #if DEBUG_GC
     printf("add_heap current num of heaps:%d\n", *orig_num_heap);
@@ -264,24 +250,17 @@
     (*heaps) = (ScmObj*)realloc((*heaps), sizeof(ScmObj) * num_heap);
 
     /* allocate heap */
-    (*heaps)[num_heap - 1] = (ScmObj)malloc_aligned(sizeof(ScmObjInternal) * HEAP_SIZE);
-    memset((*heaps)[num_heap - 1], 0, sizeof(ScmObjInternal) * HEAP_SIZE);
+    heap = (ScmObj)malloc_aligned(sizeof(ScmObjInternal) * HEAP_SIZE);
+    (*heaps)[num_heap - 1] = heap;
     
     /* link in order */
-    for (i = 0; i < HEAP_SIZE; i++) {
-        next = &(*heaps)[num_heap - 1][i];
-	SCM_SETFREECELL(next);
-
-        if (prev)
-	    SCM_SETFREECELL_CDR(prev, next);
-
-        /* the last cons' cdr is freelist */
-        if (i == HEAP_SIZE - 1)
-	    SCM_SETFREECELL_CDR(next, (*freelist));
-
-        prev = next;
+    for (cell=heap; cell-heap < HEAP_SIZE; cell++) {
+	SCM_SETFREECELL(cell);
+	SCM_DO_UNMARK(cell);
+	SCM_SETFREECELL_CDR(cell, cell+1);
     }
 
+    SCM_SETFREECELL_CDR(cell-1, *freelist);
     (*freelist) = (*heaps)[num_heap - 1];
 }
 

Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/operations.c	2005-08-21 11:48:30 UTC (rev 1267)
@@ -36,6 +36,7 @@
 =======================================*/
 #include <string.h>
 #include <stdlib.h>
+#include <limits.h>
 
 /*=======================================
   Local Include
@@ -49,6 +50,7 @@
 /*=======================================
   File Local Macro Declarations
 =======================================*/
+#define SCM_INVALID NULL
 
 /*=======================================
   Variable Declarations
@@ -58,10 +60,8 @@
 /*=======================================
   File Local Function Declarations
 =======================================*/
-static ScmObj list_gettail(ScmObj head);
 static int ScmOp_c_length(ScmObj list);
 static ScmObj ScmOp_listtail_internal(ScmObj obj, int k);
-static ScmObj ScmOp_append_internal(ScmObj head, ScmObj tail);
 
 /*=======================================
   Function Implementations
@@ -243,64 +243,94 @@
 /*==============================================================================
   R5RS : 6.2 Numbers : 6.2.5 Numerical Operations
 ==============================================================================*/
-ScmObj ScmOp_plus2n(ScmObj obj1, ScmObj obj2)
+/* Note: SigScheme supports only the integer part of the numerical tower. */
+
+ScmObj ScmOp_plus(ScmObj args, ScmObj env)
 {
-    if (SCM_NULLP(obj1) && SCM_NULLP(obj2))
-	return Scm_NewInt(0);
+    int result = 0;
+    ScmObj ls;
+    ScmObj operand;
 
-    if (!SCM_INTP(obj1))
-	SigScm_ErrorObj("+ : integer required but got ", obj1);
+    for (ls = args; !SCM_NULLP(ls); ls = SCM_CDR(ls)) {
+	operand = SCM_CAR(ls);
+	if (!SCM_INTP(operand))
+	    SigScm_ErrorObj("+ : integer required but got ", operand);
+	result += SCM_INT_VALUE(operand);
+    }
 
-    if (SCM_NULLP(obj2))
-	return Scm_NewInt(SCM_INT_VALUE(obj1));
+    return Scm_NewInt(result);
+}
 
-    if (!SCM_INTP(obj2))
-	SigScm_ErrorObj("+ : integer required but got ", obj2);
+ScmObj ScmOp_times(ScmObj args, ScmObj env)
+{
+    int result = 1;
+    ScmObj operand;
+    ScmObj ls;
 
-    return Scm_NewInt(SCM_INT_VALUE(obj1) + SCM_INT_VALUE(obj2));
+    for (ls=args; !SCM_NULLP(ls); ls = SCM_CDR(ls)) {
+	operand = SCM_CAR(ls);
+	if (!SCM_INTP(operand))
+	    SigScm_ErrorObj("* : integer required but got ", operand);
+	result *= SCM_INT_VALUE(operand);
+    }
+
+    return Scm_NewInt(result);
 }
 
-ScmObj ScmOp_minus2n(ScmObj obj1, ScmObj obj2)
+ScmObj ScmOp_minus(ScmObj args, ScmObj env)
 {
-    if (!SCM_INTP(obj1))
-        SigScm_ErrorObj("- : integer required but got ", obj1);
+    int result;
+    ScmObj operand;
+    ScmObj ls;
 
-    if (SCM_NULLP(obj2))
-	return Scm_NewInt(-(SCM_INT_VALUE(obj1)));
+    ls = args;
+    if (SCM_NULLP(ls))
+	SigScm_Error("- : at least 1 argument required");
 
-    if (!SCM_INTP(obj2))
-        SigScm_ErrorObj("- : integer required but got ", obj2);
+    result = SCM_INT_VALUE(SCM_CAR(ls));
+    ls = SCM_CDR(ls);
 
-    return Scm_NewInt(SCM_INT_VALUE(obj1) - SCM_INT_VALUE(obj2));
+    /* single arg */
+    if (SCM_NULLP(ls))
+	return Scm_NewInt(-result);
+
+    for (; !SCM_NULLP(ls); ls = SCM_CDR(ls)) {
+	operand = SCM_CAR(ls);
+	if (!SCM_INTP(operand))
+	    SigScm_ErrorObj("- : integer required but got ", operand);
+	result -= SCM_INT_VALUE(operand);
+    }
+    
+    return Scm_NewInt(result);
 }
 
-ScmObj ScmOp_multi2n(ScmObj obj1, ScmObj obj2)
+ScmObj ScmOp_divide(ScmObj args, ScmObj env)
 {
-    if (SCM_NULLP(obj1) && SCM_NULLP(obj2))
-	return Scm_NewInt(1);
+    int result;
+    ScmObj operand;
+    ScmObj ls;
 
-    if (!SCM_INTP(obj1))
-        SigScm_ErrorObj("* : integer required but got ", obj1);
+    if (SCM_NULLP(args))
+	SigScm_Error("/ : at least 1 argument required");
 
-    if (SCM_NULLP(obj2))
-	return Scm_NewInt(SCM_INT_VALUE(obj1));
+    result = SCM_INT_VALUE(SCM_CAR(args));
+    ls = SCM_CDR(args);
 
-    if (!SCM_INTP(obj2))
-        SigScm_ErrorObj("* : integer required but got ", obj2);
+    /* single arg */
+    if (SCM_NULLP(ls))
+	return Scm_NewInt(1 / result);
 
-    return Scm_NewInt(SCM_INT_VALUE(obj1) * SCM_INT_VALUE(obj2));
-}
+    for (; !SCM_NULLP(ls); ls = SCM_CDR(ls)) {
+	operand = SCM_CAR(ls);
+	if (!SCM_INTP(operand))
+	    SigScm_ErrorObj("/ : integer required but got ", operand);
 
-ScmObj ScmOp_divide2n(ScmObj obj1, ScmObj obj2)
-{
-    if (!SCM_INTP(obj1))
-        SigScm_ErrorObj("/ : integer required but got ", obj1);
-    if (!SCM_INTP(obj2))
-        SigScm_ErrorObj("/ : integer required but got ", obj2);
-    if (EQ(ScmOp_zerop(obj2), SCM_TRUE))
-        SigScm_Error("/ : divide by zero\n");
+	if (SCM_INT_VALUE(operand) == 0)
+	    SigScm_ErrorObj("/ : division by zero ", args);
+	result /= SCM_INT_VALUE(operand);
+    }
 
-    return Scm_NewInt(SCM_INT_VALUE(obj1) / SCM_INT_VALUE(obj2));
+    return Scm_NewInt(result);
 }
 
 ScmObj ScmOp_numberp(ScmObj obj)
@@ -316,14 +346,14 @@
     int    val = 0;
     ScmObj obj = SCM_NIL;
 
+    /* arglen check */
+    if CHECK_2_ARGS(args)
+        SigScm_Error("= : Wrong number of arguments\n");
+
     /* type check */
     if (EQ(ScmOp_numberp(SCM_CAR(args)), SCM_FALSE))
         SigScm_ErrorObj("= : number required but got ", SCM_CAR(args));
 
-    /* arglen check */
-    if CHECK_2_ARGS(args)
-        SigScm_Error("= : Wrong number of arguments\n");
-
     /* Get first value */
     val = SCM_INT_VALUE(SCM_CAR(args));
 
@@ -342,7 +372,7 @@
     return SCM_TRUE;
 }
 
-ScmObj ScmOp_bigger(ScmObj args, ScmObj env )
+ScmObj ScmOp_less(ScmObj args, ScmObj env )
 {
     int    val     = 0;
     int    car_val = 0;
@@ -374,7 +404,7 @@
     return SCM_TRUE;
 }
 
-ScmObj ScmOp_smaller(ScmObj args, ScmObj env )
+ScmObj ScmOp_greater(ScmObj args, ScmObj env )
 {
     int    val     = 0;
     int    car_val = 0;
@@ -407,7 +437,7 @@
     return SCM_TRUE;
 }
 
-ScmObj ScmOp_biggerEq(ScmObj args, ScmObj env )
+ScmObj ScmOp_lessEq(ScmObj args, ScmObj env )
 {
     int    val     = 0;
     int    car_val = 0;
@@ -441,7 +471,7 @@
     return SCM_TRUE;
 }
 
-ScmObj ScmOp_smallerEq(ScmObj args, ScmObj env )
+ScmObj ScmOp_greaterEq(ScmObj args, ScmObj env )
 {
     int    val     = 0;
     int    car_val = 0;
@@ -529,6 +559,7 @@
     int    max     = 0;
     int    car_val = 0;
     ScmObj car     = SCM_NIL;
+    ScmObj maxobj  = SCM_NIL;
 
     if (SCM_NULLP(args))
 	SigScm_Error("max : at least 1 number required\n");
@@ -538,9 +569,11 @@
         if (EQ(ScmOp_numberp(car), SCM_FALSE))
             SigScm_ErrorObj("max : number required but got ", car);
 
-        car_val = SCM_INT_VALUE(SCM_CAR(args));
-        if (max < car_val)
+        car_val = SCM_INT_VALUE(car);
+        if (max < car_val) {
             max = car_val;
+	    maxobj = car;
+	}
     }
 
     return Scm_NewInt(max);
@@ -551,6 +584,7 @@
     int    min     = 0;
     int    car_val = 0;
     ScmObj car     = SCM_NIL;
+    ScmObj minobj  = SCM_NIL;
 
     if (SCM_NULLP(args))
 	SigScm_Error("min : at least 1 number required\n");
@@ -560,12 +594,14 @@
         if (EQ(ScmOp_numberp(car), SCM_FALSE))
             SigScm_ErrorObj("min : number required but got ", car);
 
-        car_val = SCM_INT_VALUE(SCM_CAR(args));
-        if (car_val < min)
+        car_val = SCM_INT_VALUE(car);
+        if (car_val < min) {
             min = car_val;
+	    minobj = car;
+	}
     }
 
-    return Scm_NewInt(min);
+    return minobj;
 }
 
 
@@ -648,36 +684,60 @@
 /*==============================================================================
   R5RS : 6.2 Numbers : 6.2.6 Numerical input and output
 ==============================================================================*/
-/* TODO : support radix */
-ScmObj ScmOp_number_to_string(ScmObj z)
+ScmObj ScmOp_number_to_string (ScmObj args, ScmObj env)
 {
-    int n = 0;
-    int i = 0;
-    int size = 0;
-    char *str = NULL;
+  char buf[sizeof(int)*CHAR_BIT + 1];
+  char *p;
+  unsigned int n, r;
+  ScmObj number, radix;
 
-    if (EQ(ScmOp_numberp(z), SCM_FALSE))
-	SigScm_ErrorObj("number->string : number required but got ", z);
+  if (CHECK_1_ARG(args))
+      SigScm_ErrorObj("number->string: requires 1 or 2 arguments: ", args);
 
-    /* get value */
-    n = SCM_INT_VALUE(z);
+  number = SCM_CAR(args);
+  if (!SCM_INTP(number))
+      SigScm_ErrorObj("number->string: integer required but got ", number);
 
-    /* get size */
-    for (size = 1; (int)(n / 10) != 0; size++)
-	n /= 10;
+  n = SCM_INT_VALUE(number);
 
-    /* allocate str */
-    str = (char *)malloc(sizeof(char) * size + 1);
+  /* r = radix */
+  if (SCM_NULLP(SCM_CDR(args)))
+      r = 10;
+  else {
+#ifdef SCM_STRICT_ARGCHECK
+      if (!SCM_NULLP(SCM_CDDR(args)))
+	  SigScm_ErrorObj("number->string: too many arguments: ", args);
+#endif
+      radix = SCM_CADR(args);
+      if (!SCM_INTP(radix))
+	  SigScm_ErrorObj("number->string: integer required but got ", radix);
+      r = SCM_INT_VALUE(radix);
 
-    /* fill str */
-    n = SCM_INT_VALUE(z);
-    str[size] = '\0';
-    for (i = size; 0 < i; i--) {
-	str[i - 1] = '0' + (n % 10);
-	n /= 10;
+      if (!(2 <= r && r <= 16))
+	  SigScm_ErrorObj("number->string: invalid or unsupported radix: ",
+			  radix);
+  }
+
+  /* no signs for nondecimals */
+  if (r != 10)
+      n = abs(n);
+
+  /* initialize buffer */
+  p = &buf[sizeof(buf)-1];
+  *p = 0;
+
+  do
+    {
+      if (n % r > 9)
+	*--p = 'A' + n % r - 10;
+      else
+	*--p = '0' + n % r;
     }
+  while (n /= r);
+  if (r == 10 && SCM_INT_VALUE (number) < 0)
+    *--p = '-';
 
-    return Scm_NewString(str);
+  return Scm_NewStringCopying(p);
 }
 
 /* TODO : support radix */
@@ -697,7 +757,7 @@
 	    return SCM_FALSE;
     }
 
-    return Scm_NewInt((int)atof(SCM_STRING_STR(string)));
+    return Scm_NewInt((int)atoi(SCM_STRING_STR(string)));
 }
 
 /*===================================
@@ -944,34 +1004,16 @@
     return SCM_TRUE;
 }
 
-static ScmObj list_gettail(ScmObj head)
-{
-    ScmObj tail = head;
-
-    if (SCM_NULLP(head)) return SCM_NIL;
-
-    while (1) {
-        if (!SCM_CONSP(tail) || SCM_NULLP(SCM_CDR(tail)))
-            return tail;
-
-        tail = SCM_CDR(tail);
-    }
-
-    return SCM_NIL;
-}
-
 /*
  * Notice
  *
  * This function is ported from Gauche, by Shiro Kawai(shiro at acm.org)
  */
-int ScmOp_c_length(ScmObj obj)
+static int ScmOp_c_length(ScmObj obj)
 {
     ScmObj slow = obj;
     int len = 0;
 
-    if (SCM_NULLP(obj)) return 0;
-
     for (;;) {
         if (SCM_NULLP(obj)) break;
         if (!SCM_CONSP(obj)) return -1;
@@ -996,91 +1038,85 @@
     return Scm_NewInt(ScmOp_c_length(obj));
 }
 
-ScmObj ScmOp_append_internal(ScmObj head, ScmObj tail)
+ScmObj ScmOp_append(ScmObj args, ScmObj env)
 {
-    ScmObj head_tail = SCM_NIL;
+    ScmObj ret_list = SCM_NIL;
+    ScmObj *ret_tail = &ret_list;
 
-    /* TODO : need to rewrite using ScmOp_listp? */
-    if (SCM_NULLP(head))
-        return tail;
+    ScmObj ls;
+    ScmObj obj = SCM_NIL;
 
-    if (!SCM_CONSP(head))
-        SigScm_ErrorObj("append : list required but got ", head);
+    if (SCM_NULLP(args))
+	return SCM_NIL;
 
-    head_tail = list_gettail(head);
-    if (SCM_NULLP(head_tail)) {
-        return tail;
-    } else if (SCM_CONSP(head_tail)) {
-        SCM_SETCDR(head_tail, tail);
-    } else {
-        SigScm_ErrorObj("append : list required but got ", head_tail);
+    /* duplicate and merge all but the last argument */
+    for (; !SCM_NULLP(SCM_CDR(args)); args = SCM_CDR(args)) {
+	for (ls = SCM_CAR(args); SCM_CONSP(ls); ls = SCM_CDR(ls)) {
+	    obj = SCM_CAR(ls);
+	    *ret_tail = Scm_NewCons(obj, SCM_NIL);
+	    ret_tail = &SCM_CDR(*ret_tail);
+	}
+	if (!SCM_NULLP(ls))
+	    SigScm_ErrorObj("append: proper list required but got: ",
+			    SCM_CAR(args));
     }
 
-    return head;
-}
+    /* append the last argument */
+    *ret_tail = SCM_CAR(args);
 
-ScmObj ScmOp_append(ScmObj args, ScmObj env)
-{
-    ScmObj ret = SCM_NIL;
-    ScmObj obj = SCM_NIL;
-    for (; !SCM_NULLP(args); args = SCM_CDR(args)) {
-	obj = SCM_CAR(args);
-	ret = ScmOp_append_internal(ret, obj);
-    }
-
-    return ret;
+    return ret_list;
 }
 
 ScmObj ScmOp_reverse(ScmObj list)
 {
     ScmObj ret_list  = SCM_NIL;
 
-    /* TODO : canbe optimized not to use ScmOp_listp */
-    if (EQ(ScmOp_listp(list), SCM_FALSE))
-        SigScm_ErrorObj("reverse : list required but got ", list);
-
-    for (; !SCM_NULLP(list); list = SCM_CDR(list)) {
+    for (; SCM_CONSP(list); list = SCM_CDR(list))
         ret_list = Scm_NewCons(SCM_CAR(list), ret_list);
-    }
 
+    if (!SCM_NULLP(list))
+	SigScm_ErrorObj("reverse: got improper list: ", list);
+
     return ret_list;
 }
 
-/* TODO : not to use recursive call for avoiding stack overflow*/
-ScmObj ScmOp_listtail_internal(ScmObj obj, int k)
+static ScmObj ScmOp_listtail_internal(ScmObj list, int k)
 {
-    if (k == 0) {
-        return obj;
+    while (k--) {
+	if (!SCM_CONSP(list))
+	    return SCM_INVALID;
+	list = SCM_CDR(list);
     }
 
-    if (SCM_NULLP(obj))
-        SigScm_Error("already reached tail\n");
-
-    return ScmOp_listtail_internal(SCM_CDR(obj), k - 1);
+    return list;
 }
 
 ScmObj ScmOp_list_tail(ScmObj list, ScmObj scm_k)
 {
-    if (EQ(ScmOp_listp(list), SCM_FALSE))
-        SigScm_ErrorObj("list-tail : list required but got ", list);
+    ScmObj ret;
+
     if (EQ(ScmOp_numberp(scm_k), SCM_FALSE))
-        SigScm_ErrorObj("list-tail : number required but got ", scm_k);
+        SigScm_ErrorObj("list-tail: number required but got ", scm_k);
 
-    return ScmOp_listtail_internal(list, SCM_INT_VALUE(scm_k));
+    ret = ScmOp_listtail_internal(list, SCM_INT_VALUE(scm_k));
+
+    if (EQ(ret, SCM_INVALID))
+	SigScm_ErrorObj("list-tail: out of range or bad list, arglist is: ",
+			Scm_NewCons(list, scm_k));
+    return ret;
 }
 
 ScmObj ScmOp_list_ref(ScmObj list, ScmObj scm_k)
 {
     ScmObj list_tail = SCM_NIL;
 
-    if (EQ(ScmOp_listp(list), SCM_FALSE))
-        SigScm_ErrorObj("list-ref : list required but got ", list);
     if (EQ(ScmOp_numberp(scm_k), SCM_FALSE))
         SigScm_ErrorObj("list-ref : int required but got ", scm_k);
 
     list_tail = ScmOp_listtail_internal(list, SCM_INT_VALUE(scm_k));
-    if (SCM_NULLP(list_tail))
-        SigScm_ErrorObj("list-ref : out of range ", scm_k);
+    if (EQ(list_tail, SCM_INVALID))
+        SigScm_ErrorObj("list-ref : out of range or bad list, arglist is: ",
+			Scm_NewCons(list, scm_k));
 
     return SCM_CAR(list_tail);
 }
@@ -1088,10 +1124,8 @@
 ScmObj ScmOp_memq(ScmObj obj, ScmObj list)
 {
     ScmObj tmplist = SCM_NIL;
-    ScmObj tmpobj  = SCM_NIL;
     for (tmplist = list; SCM_CONSP(tmplist); tmplist = SCM_CDR(tmplist)) {
-        tmpobj = SCM_CAR(tmplist);
-        if (EQ(ScmOp_eqp(obj, tmpobj), SCM_TRUE)) {
+        if (EQ(obj, SCM_CAR(tmplist))) {
             return tmplist;
         }
     }
@@ -1131,10 +1165,20 @@
 {
     ScmObj tmplist = SCM_NIL;
     ScmObj tmpobj  = SCM_NIL;
+    ScmObj car;
+
     for (tmplist = alist; SCM_CONSP(tmplist); tmplist = SCM_CDR(tmplist)) {
         tmpobj = SCM_CAR(tmplist);
-        if (SCM_CONSP(tmpobj) && EQ(ScmOp_eqp(SCM_CAR(tmpobj), obj), SCM_TRUE))
+	car = SCM_CAR(tmpobj);
+#if SCM_STRICT_R5RS
+	if (!SCM_CONSP(tmpobj))
+	    SigScm_ErrorObj("assq: invalid alist: ", alist);
+	if (EQ(SCM_CAR(tmpobj), obj))
+	    return tmpobj;
+#else
+        if (SCM_CONSP(tmpobj) && EQ(SCM_CAR(tmpobj), obj))
             return tmpobj;
+#endif
     }
 
     return SCM_FALSE;
@@ -1144,10 +1188,20 @@
 {
     ScmObj tmplist = SCM_NIL;
     ScmObj tmpobj  = SCM_NIL;
+    ScmObj car;
+
     for (tmplist = alist; SCM_CONSP(tmplist); tmplist = SCM_CDR(tmplist)) {
         tmpobj = SCM_CAR(tmplist);
-        if (SCM_CONSP(tmpobj) && EQ(ScmOp_eqvp(SCM_CAR(tmpobj), obj), SCM_TRUE))
+	car = SCM_CAR(tmpobj);
+#if SCM_STRICT_R5RS
+	if (!SCM_CONSP(tmpobj))
+	    SigScm_ErrorObj("assv: invalid alist: ", alist);
+	if (EQ(ScmOp_eqvp(car, obj), SCM_TRUE))
+	    return tmpobj;
+#else
+        if (SCM_CONSP(tmpobj) && EQ(ScmOp_eqvp(car, obj), SCM_TRUE))
             return tmpobj;
+#endif
     }
 
     return SCM_FALSE;
@@ -1157,10 +1211,20 @@
 {
     ScmObj tmplist = SCM_NIL;
     ScmObj tmpobj  = SCM_NIL;
+    ScmObj car;
+
     for (tmplist = alist; SCM_CONSP(tmplist); tmplist = SCM_CDR(tmplist)) {
         tmpobj = SCM_CAR(tmplist);
-        if (SCM_CONSP(tmpobj) && EQ(ScmOp_equalp(SCM_CAR(tmpobj), obj), SCM_TRUE))
+	car = SCM_CAR(tmpobj);
+#if SCM_STRICT_R5RS
+	if (!SCM_CONSP(tmpobj))
+	    SigScm_ErrorObj("assoc: invalid alist: ", alist);
+	if (EQ(ScmOp_equalp(car, obj), SCM_TRUE))
+	    return tmpobj;
+#else
+        if (SCM_CONSP(tmpobj) && EQ(ScmOp_equalp(car, obj), SCM_TRUE))
             return tmpobj;
+#endif
     }
 
     return SCM_FALSE;
@@ -1181,22 +1245,17 @@
 ScmObj ScmOp_symbol_to_string(ScmObj obj)
 {
     if (!SCM_SYMBOLP(obj))
-        return SCM_FALSE;
+        SigScm_ErrorObj("symbol->string: symbol required, but got ", obj);
 
     return Scm_NewStringCopying(SCM_SYMBOL_NAME(obj));
 }
 
 ScmObj ScmOp_string_to_symbol(ScmObj str)
 {
-    char *name = NULL;
-
     if(!SCM_STRINGP(str))
-        return SCM_FALSE;
+        SigScm_ErrorObj("string->symbol: string required, but got ", str);
 
-    name = (char*)alloca(strlen(SCM_STRING_STR(str)) + 1);
-    strcpy(name, SCM_STRING_STR(str));
-
-    return Scm_Intern(name);
+    return Scm_Intern(SCM_STRING_STR(str));
 }
 
 /*==============================================================================

Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/sigscheme.c	2005-08-21 11:48:30 UTC (rev 1267)
@@ -66,6 +66,10 @@
 
 extern ScmObj continuation_thrown_obj, letrec_env;
 
+#if SCM_COMPAT_SIOD
+extern ScmObj scm_return_value;
+#endif
+
 /*=======================================
   Function Implementations
 =======================================*/
@@ -143,10 +147,10 @@
     Scm_RegisterFunc1("number?"              , ScmOp_numberp);
     Scm_RegisterFunc1("integer?"             , ScmOp_numberp);
     Scm_RegisterFuncL("="                    , ScmOp_equal);
-    Scm_RegisterFuncL("<"                    , ScmOp_bigger);
-    Scm_RegisterFuncL(">"                    , ScmOp_smaller);
-    Scm_RegisterFuncL("<="                   , ScmOp_biggerEq);
-    Scm_RegisterFuncL(">="                   , ScmOp_smallerEq);
+    Scm_RegisterFuncL("<"                    , ScmOp_less);
+    Scm_RegisterFuncL(">"                    , ScmOp_greater);
+    Scm_RegisterFuncL("<="                   , ScmOp_lessEq);
+    Scm_RegisterFuncL(">="                   , ScmOp_greaterEq);
     Scm_RegisterFunc1("zero?"                , ScmOp_zerop);
     Scm_RegisterFunc1("positive?"            , ScmOp_positivep);
     Scm_RegisterFunc1("negative?"            , ScmOp_negativep);
@@ -154,15 +158,15 @@
     Scm_RegisterFunc1("even?"                , ScmOp_evenp);
     Scm_RegisterFuncL("max"                  , ScmOp_max);
     Scm_RegisterFuncL("min"                  , ScmOp_min);
-    Scm_RegisterFunc2N("+"                   , ScmOp_plus2n);
-    Scm_RegisterFunc2N("*"                   , ScmOp_multi2n);
-    Scm_RegisterFunc2N("-"                   , ScmOp_minus2n);
-    Scm_RegisterFunc2N("/"                   , ScmOp_divide2n);
+    Scm_RegisterFuncL("+"                    , ScmOp_plus);
+    Scm_RegisterFuncL("*"                    , ScmOp_times);
+    Scm_RegisterFuncL("-"                    , ScmOp_minus);
+    Scm_RegisterFuncL("/"                    , ScmOp_divide);
     Scm_RegisterFunc1("abs"                  , ScmOp_abs);
     Scm_RegisterFunc2("quotient"             , ScmOp_quotient);
     Scm_RegisterFunc2("modulo"               , ScmOp_modulo);
     Scm_RegisterFunc2("remainder"            , ScmOp_remainder);
-    Scm_RegisterFunc1("number->string"       , ScmOp_number_to_string);
+    Scm_RegisterFuncL("number->string"       , ScmOp_number_to_string);
     Scm_RegisterFunc1("string->number"       , ScmOp_string_to_number);
     Scm_RegisterFunc1("not"                  , ScmOp_not);
     Scm_RegisterFunc1("boolean?"             , ScmOp_booleanp);
@@ -330,7 +334,6 @@
     Scm_RegisterFuncL("the-environment"      , ScmOp_the_environment);
     Scm_RegisterFunc1("%%closure-code"       , ScmOp_closure_code);
     /* datas.c */
-    extern ScmObj scm_return_value;
     scm_return_value = SCM_NIL;
 #endif
 

Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/sigscheme.h	2005-08-21 11:48:30 UTC (rev 1267)
@@ -209,10 +209,10 @@
 ScmObj ScmOp_equalp(ScmObj obj1, ScmObj obj2);
 ScmObj ScmOp_numberp(ScmObj obj);
 ScmObj ScmOp_equal(ScmObj list, ScmObj env);
-ScmObj ScmOp_bigger(ScmObj list, ScmObj env);
-ScmObj ScmOp_smaller(ScmObj list, ScmObj env);
-ScmObj ScmOp_biggerEq(ScmObj list, ScmObj env);
-ScmObj ScmOp_smallerEq(ScmObj list, ScmObj env);
+ScmObj ScmOp_less(ScmObj list, ScmObj env);
+ScmObj ScmOp_greater(ScmObj list, ScmObj env);
+ScmObj ScmOp_lessEq(ScmObj list, ScmObj env);
+ScmObj ScmOp_greaterEq(ScmObj list, ScmObj env);
 ScmObj ScmOp_zerop(ScmObj num);
 ScmObj ScmOp_positivep(ScmObj num);
 ScmObj ScmOp_negativep(ScmObj num);
@@ -220,15 +220,15 @@
 ScmObj ScmOp_evenp(ScmObj num);
 ScmObj ScmOp_max(ScmObj list, ScmObj env);
 ScmObj ScmOp_min(ScmObj list, ScmObj env);
-ScmObj ScmOp_plus2n(ScmObj obj1, ScmObj obj2);
-ScmObj ScmOp_minus2n(ScmObj obj1, ScmObj obj2);
-ScmObj ScmOp_multi2n(ScmObj obj1, ScmObj obj2);
-ScmObj ScmOp_divide2n(ScmObj obj1, ScmObj obj2);
+ScmObj ScmOp_plus(ScmObj args, ScmObj env);
+ScmObj ScmOp_minus(ScmObj args, ScmObj env);
+ScmObj ScmOp_times(ScmObj args, ScmObj env);
+ScmObj ScmOp_divide(ScmObj args, ScmObj env);
 ScmObj ScmOp_abs(ScmObj num);
 ScmObj ScmOp_quotient(ScmObj n1, ScmObj n2);
 ScmObj ScmOp_modulo(ScmObj n1, ScmObj n2);
 ScmObj ScmOp_remainder(ScmObj n1, ScmObj n2);
-ScmObj ScmOp_number_to_string(ScmObj z);
+ScmObj ScmOp_number_to_string(ScmObj args, ScmObj env);
 ScmObj ScmOp_string_to_number(ScmObj string);
 ScmObj ScmOp_not(ScmObj obj);
 ScmObj ScmOp_booleanp(ScmObj obj);

Modified: branches/r5rs/sigscheme/test/bigloo-list.scm
===================================================================
--- branches/r5rs/sigscheme/test/bigloo-list.scm	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/test/bigloo-list.scm	2005-08-21 11:48:30 UTC (rev 1267)
@@ -99,7 +99,11 @@
 ;   (test "remq!" (let ((x '(1 2 3 4))) (remq! 2 x) x) '(1 3 4))
 ;   (test "delete" (let ((x '(1 2 (3 4) 5))) (delete '(3 4) x)) '(1 2 5))
 ;   (test "delete!" (let ((x '(1 2 (3 4) 5))) (delete! '(3 4) x) x) '(1 2 5))
-   (test "memq.1" (memq 3 '(1 2 3 4 5)) '(3 4 5))
+
+; Changed expected value from '(3 4 5) to #f, since eq? on numbers
+; return #f.  When we deploy tagged pointers, this may change.
+;   (test "memq.1" (memq 3 '(1 2 3 4 5)) '(3 4 5))
+   (test "memq.1" (memq 3 '(1 2 3 4 5)) #f)
    (test "memq.2" (memq #\a '(1 2 3 4 5)) #f)
    (test "member.2" (member '(2 3) '((1 2) (2 3) (3 4) (4 5)))
 	 '((2 3) (3 4) (4 5)))

Modified: branches/r5rs/sigscheme/test/io.scm
===================================================================
--- branches/r5rs/sigscheme/test/io.scm	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/test/io.scm	2005-08-21 11:48:30 UTC (rev 1267)
@@ -1 +1,2 @@
+(display "type an sexp:")
 (print (read-char))

Modified: branches/r5rs/sigscheme/test/test-apply.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-apply.scm	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/test/test-apply.scm	2005-08-21 11:48:30 UTC (rev 1267)
@@ -1,14 +1,14 @@
 (load "./test/unittest.scm")
 
 ;; check apply
-(assert-eq? "apply check1" #t (apply = '(1 1 1)))
-(assert-eq? "apply check2" 6  (apply + `(1 2 ,(+ 1 2))))
+(assert-equal? "apply check1" #t (apply = '(1 1 1)))
+(assert-equal? "apply check2" 6  (apply + `(1 2 ,(+ 1 2))))
 (assert-equal? "apply check3" '(3) (apply cddr '((1 2 3))))
 (assert-equal? "apply check4" #t (apply equal? '((1 2) (1 2))))
 (assert-equal? "apply check5" "iu" (apply substring '("aiueo" 1 3)))
 
-(assert-eq? "apply check6" 4  (apply (lambda (x y) (+ x y)) '(1 3)))
-(assert-eq? "apply check7" 4  (apply (lambda (x y) (+ x y)) '(1 3)))
+(assert-equal? "apply check6" 4  (apply (lambda (x y) (+ x y)) '(1 3)))
+(assert-equal? "apply check7" 4  (apply (lambda (x y) (+ x y)) '(1 3)))
 (assert-equal? "apply check8" '(1 2 3) (apply (lambda x x) '(1 2 3)))
 (assert-equal? "apply check9" 1 (apply (lambda (x) x) '(1)))
 (assert-equal? "apply check10" '(1) (apply (lambda x x) '(1)))

Modified: branches/r5rs/sigscheme/test/test-continuation.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-continuation.scm	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/test/test-continuation.scm	2005-08-21 11:48:30 UTC (rev 1267)
@@ -1,6 +1,6 @@
 (load "test/unittest.scm")
 
-(assert-eq? "call/cc test1" -3  (call-with-current-continuation
+(assert-equal? "call/cc test1" -3  (call-with-current-continuation
 				 (lambda (exit)
 				   (for-each (lambda (x)
 					       (if (negative? x)
@@ -21,7 +21,7 @@
 			  (return #f))))))
       (re obj))))))
 
-(assert-eq? "call/cc test2" 4  (list-length '(1 2 3 4)))
-(assert-eq? "call/cc test3" #f (list-length '(a b . c)))
+(assert-equal? "call/cc test2" 4  (list-length '(1 2 3 4)))
+(assert-equal? "call/cc test3" #f (list-length '(a b . c)))
 
 (total-report)

Modified: branches/r5rs/sigscheme/test/test-define.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-define.scm	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/test/test-define.scm	2005-08-21 11:48:30 UTC (rev 1267)
@@ -2,21 +2,21 @@
 
 ; basic define
 (define val1 3)
-(assert-eq? "basic define check" 3 val1)
+(assert-equal? "basic define check" 3 val1)
 
 ; redefine
 (define val1 5)
-(assert-eq? "redefine check" 5 val1)
+(assert-equal? "redefine check" 5 val1)
 
 ; define lambda
 (define (what? x)
   "DEADBEEF" x)
-(assert-eq? "func define" 10 (what? 10))
+(assert-equal? "func define" 10 (what? 10))
 
 (define what2?
   (lambda (x)
     "DEADBEEF" x))
-(assert-eq? "func define" 10 (what2? 10))
+(assert-equal? "func define" 10 (what2? 10))
 
 (define (nullarg)
   "nullarg")
@@ -24,7 +24,7 @@
 
 (define (add x y)
   (+ x y))
-(assert-eq? "func define" 10 (add 2 8))
+(assert-equal? "func define" 10 (add 2 8))
 
 ; tests for dot list arguments
 (define (dotarg1 . a)
@@ -33,7 +33,7 @@
 
 (define (dotarg2 a . b)
   a)
-(assert-eq? "dot arg test 2" 1 (dotarg2 1 2))
+(assert-equal? "dot arg test 2" 1 (dotarg2 1 2))
 
 (define (dotarg3 a . b)
   b)
@@ -43,7 +43,7 @@
 
 (define (dotarg4 a b . c)
   b)
-(assert-eq? "dot arg test 5" 2 (dotarg4 1 2 3))
+(assert-equal? "dot arg test 5" 2 (dotarg4 1 2 3))
 
 (define (dotarg5 a b . c)
   c)
@@ -55,7 +55,7 @@
     (+ c 3))
   (idefine-i a))
 
-(assert-eq? "internal define1" 5 (idefine-o 2))
+(assert-equal? "internal define1" 5 (idefine-o 2))
 
 (define (idefine0 a)
   (define (idefine1 . args)
@@ -64,7 +64,7 @@
     (+ c 2))
   (+ (idefine1 1 2 3 4 5) (idefine2 a)))
 
-(assert-eq? "internal define2" 17 (idefine0 0))
+(assert-equal? "internal define2" 17 (idefine0 0))
 
 (total-report)
 

Modified: branches/r5rs/sigscheme/test/test-delay-force.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-delay-force.scm	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/test/test-delay-force.scm	2005-08-21 11:48:30 UTC (rev 1267)
@@ -1,10 +1,9 @@
 (load "test/unittest.scm")
 
 ;; check delay and force
-(assert-eq? "delay-force check" 6 (begin
-				    (define foo (delay
-						  (+ 1 2 3)))
+(assert-equal? "delay-force check" 6 (begin
+				       (define foo (delay
+						     (+ 1 2 3)))
+				       (force foo)))
 
-				    (force foo)))
-
 (total-report)

Modified: branches/r5rs/sigscheme/test/test-equation.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-equation.scm	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/test/test-equation.scm	2005-08-21 11:48:30 UTC (rev 1267)
@@ -31,17 +31,17 @@
 			          )))
 
 ;; check eq?
-(assert-eq? "eq? check empty list" '() '())
+(assert-equal? "eq? check empty list" '() '())
 
 (define pair1 (cons 'a 'b))
 (define pair2 pair1)
-(assert-eq? "eq? check cons" pair1 pair2)
+(assert-equal? "eq? check cons" pair1 pair2)
 
 (define str1 (string #\a))
 (define str2 str1)
-(assert-eq? "eq? check cons" str1 str2)
+(assert-equal? "eq? check cons" str1 str2)
 
-(assert-eq? "eq? check func" + +)
+(assert-equal? "eq? check func" + +)
 
 ;; check equal?
 (assert "basic equal? test1" (equal? 'a 'a))

Modified: branches/r5rs/sigscheme/test/test-eval.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-eval.scm	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/test/test-eval.scm	2005-08-21 11:48:30 UTC (rev 1267)
@@ -1,8 +1,8 @@
 (load "test/unittest.scm")
 
 ;; check eval
-(assert-eq? "eval check" 3 (eval '(+ 1 2) '()))
+(assert-equal? "eval check" 3 (eval '(+ 1 2) '()))
 
-(assert-eq? "eval check" 3 (eval '((lambda (x y) (+ x y)) 1 2) '()))
+(assert-equal? "eval check" 3 (eval '((lambda (x y) (+ x y)) 1 2) '()))
 
 (total-report)

Modified: branches/r5rs/sigscheme/test/test-exp.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-exp.scm	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/test/test-exp.scm	2005-08-21 11:48:30 UTC (rev 1267)
@@ -1,14 +1,14 @@
 (load "./test/unittest.scm")
 
 ;; lambda
-(assert-eq? "basic lambda test1" 8 ((lambda (x) (+ x x)) 4))
+(assert-equal? "basic lambda test1" 8 ((lambda (x) (+ x x)) 4))
 (define reverse-subtract
   (lambda (x y) (- y x)))
-(assert-eq? "basic lambda test2" 3 (reverse-subtract 7 10))
+(assert-equal? "basic lambda test2" 3 (reverse-subtract 7 10))
 (define add4
   (let ((x 4))
     (lambda (y) (+ x y))))
-(assert-eq? "basic lambda test3" 10 (add4 6))
+(assert-equal? "basic lambda test3" 10 (add4 6))
 (assert-equal? "basic lambda test4" '(3 4 5 6) ((lambda x x) 3 4 5 6))
 (assert-equal? "basic lambda test5" '(5) ((lambda (x y . z) z) 3 4 5))
 (assert-equal? "basic lambda test6" '(5 6) ((lambda (x y . z) z) 3 4 5 6))
@@ -33,45 +33,45 @@
 						  (else #f)))
 
 ;; case
-(assert-eq? "basic case check1" 'case1 (case 1
+(assert-equal? "basic case check1" 'case1 (case 1
 					 ((1) 'case1)
 					 ((2) 'case2)))
 
-(assert-eq? "basic case check2" 'case2 (case 2
+(assert-equal? "basic case check2" 'case2 (case 2
 					 ((1) 'case1)
 					 ((2) 'case2)))
 
-(assert-eq? "basic case check3" #t (case (* 2 3)
+(assert-equal? "basic case check3" #t (case (* 2 3)
 			      ((2 3 4 7)   #f)
 			      ((1 4 6 8 9) #t)))
 
-(assert-eq? "basic case else"  'caseelse (case 3
+(assert-equal? "basic case else"  'caseelse (case 3
 					   ((1) 'case1)
 					   ((2) 'case2)
 					   (else
 					    'caseelse)))
 
 ;; and
-(assert-eq? "and test 1" #t (and (= 2 2) (> 2 1)))
-(assert-eq? "and test 2" #f (and (= 2 2) (< 2 1)))
+(assert-equal? "and test 1" #t (and (= 2 2) (> 2 1)))
+(assert-equal? "and test 2" #f (and (= 2 2) (< 2 1)))
 (assert-equal? "and test 3" '(f g) (and 1 2 'c '(f g)))
 (assert-equal? "and test 4" #t (and))
 
 ;; or
-(assert-eq? "or test1" #t (or (= 2 2) (> 2 1)))
-(assert-eq? "or test2" #t (or (= 2 2) (< 2 1)))
-(assert-eq? "or test3" #f (or #f #f #f))
+(assert-equal? "or test1" #t (or (= 2 2) (> 2 1)))
+(assert-equal? "or test2" #t (or (= 2 2) (< 2 1)))
+(assert-equal? "or test3" #f (or #f #f #f))
 (assert-equal? "or test4" '(b c) (or (memq 'b '(a b c))
 				     (/ 3 0)))
 
 ;; let
-(assert-eq? "basic let test1" 0 (let ((n 0))
+(assert-equal? "basic let test1" 0 (let ((n 0))
 				 n))
-(assert-eq? "basic let test2" 1 (let ((n 0))
+(assert-equal? "basic let test2" 1 (let ((n 0))
 				  (set! n 1)))
-(assert-eq? "basic let test3" 1 (let ((n 0))
+(assert-equal? "basic let test3" 1 (let ((n 0))
 				  (set! n (+ n 1))))
-(assert-eq? "basic let test4" 3 (let ((n1 2)
+(assert-equal? "basic let test4" 3 (let ((n1 2)
 				      (n2 1))
 				  (+ n1 n2)))
 (define count
@@ -79,16 +79,16 @@
     (lambda ()
       (set! n (+ n 1)))))
 
-(assert-eq? "lexical scope test1" 1 (count))
-(assert-eq? "lexical scope test2" 2 (count))
+(assert-equal? "lexical scope test1" 1 (count))
+(assert-equal? "lexical scope test2" 2 (count))
 
 (define a 3)
 (define (lexical-test)
   (let ((a 1))
-    (assert-eq? "lexical scope test3" 1 a)
+    (assert-equal? "lexical scope test3" 1 a)
     (let* ((a 2))
-      (assert-eq? "lexical scope test4" 2 a))
-    (assert-eq? "lexical scope test5" 1 a)))
+      (assert-equal? "lexical scope test4" 2 a))
+    (assert-equal? "lexical scope test5" 1 a)))
 (lexical-test)
 
 (assert-equal? "named let test" '((6 1 3) (-5 -2)) (let loop ((numbers '(3 -2 1 6 -5))
@@ -105,13 +105,13 @@
 								  (cons (car numbers) neg))))))
 
 ;; let*
-(assert-eq? "basic let* test1" 70 (let ((x 2) (y 3))
+(assert-equal? "basic let* test1" 70 (let ((x 2) (y 3))
 				    (let* ((x 7)
 					   (z (+ x y)))
 				      (* z x))))
 
 ;; letrec
-(assert-eq? "basic letrec test1" #t (letrec ((even?
+(assert-equal? "basic letrec test1" #t (letrec ((even?
 					   (lambda (n)
 					     (if (zero? n)
 						 #t
@@ -141,15 +141,15 @@
 
 ;; begin
 (define x 0)
-(assert-eq? "basic begin test1" 6 (begin
+(assert-equal? "basic begin test1" 6 (begin
 				    (set! x 5)
 				    (+ x 1)))
-(assert-eq? "basic begin test2" 0 (begin
+(assert-equal? "basic begin test2" 0 (begin
 				    0))
-(assert-eq? "basic begin test3" 1 (begin
+(assert-equal? "basic begin test3" 1 (begin
 				    0
 				    1))
-(assert-eq? "basic begin test4" 1 (begin
+(assert-equal? "basic begin test4" 1 (begin
 				    (define n 0)
 				    (set! n 1)))
 ;; do
@@ -167,7 +167,7 @@
        (y 1))
       ((= i n) y)
     (set! y (* x y))))
-(assert-eq? "do test3" 1024 (expt-do 2 10))
+(assert-equal? "do test3" 1024 (expt-do 2 10))
 
 (define (nreverse rev-it)
   (do ((reved '() rev-it)

Modified: branches/r5rs/sigscheme/test/test-list.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-list.scm	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/test/test-list.scm	2005-08-21 11:48:30 UTC (rev 1267)
@@ -3,8 +3,8 @@
 ; pair?
 (assert "pair? test1" (pair? '(a . b)))
 (assert "pair? test2" (pair? '(a b c)))
-(assert-eq? "pair? test3" #f (pair? '()))
-(assert-eq? "pair? test4" #f (pair? '#(a b)))
+(assert-equal? "pair? test3" #f (pair? '()))
+(assert-equal? "pair? test4" #f (pair? '#(a b)))
 
 ; cons
 (assert-equal? "cons test1" '(a) (cons 'a '()))
@@ -13,24 +13,24 @@
 (assert-equal? "cons test4" '((a b) . c) (cons '(a b) 'c))
 
 ; car
-(assert-eq? "car test1" 'a (car '(a b c)))
+(assert-equal? "car test1" 'a (car '(a b c)))
 (assert-equal? "car test2" '(a) (car '((a) b c)))
-(assert-eq? "car test3" 1 (car '(1 . 2)))
+(assert-equal? "car test3" 1 (car '(1 . 2)))
 
 ; cdr
 (assert-equal? "cdr test1" '(b c d) (cdr '((a) b c d)))
-(assert-eq? "cdr test2" 2 (cdr '(1 . 2)))
+(assert-equal? "cdr test2" 2 (cdr '(1 . 2)))
 
 ; null?
 (assert "null? test1" (null? '()))
-(assert-eq? "null? test2" #f (null? "aiueo"))
+(assert-equal? "null? test2" #f (null? "aiueo"))
 
 ; list?
 (assert "list? test1" (list? '(a b c)))
 (assert "list? test2" (list? '()))
-(assert-eq? "list? test3" #f (list? '(a . b)))
+(assert-equal? "list? test3" #f (list? '(a . b)))
 ; TODO : check finite length of the list!
-;(assert-eq? "list? test4" #f (let ((x (list 'a)))
+;(assert-equal? "list? test4" #f (let ((x (list 'a)))
 ;			       (set-cdr! x x)
 ;			       (list? x)))
 
@@ -39,14 +39,21 @@
 (assert-equal? "list test2" '() (list))
 
 ; length
-(assert-eq? "length test1" 3 (length '(a b c)))
-(assert-eq? "length test2" 3 (length '(a (b) (c d e))))
-(assert-eq? "length test2" 0 (length '()))
+(assert-equal? "length test1" 3 (length '(a b c)))
+(assert-equal? "length test2" 3 (length '(a (b) (c d e))))
+(assert-equal? "length test2" 0 (length '()))
 
 ; append
 (assert-equal? "append test1" '(x y) (append '(x) '(y)))
 (assert-equal? "append test2" '(a b c d) (append '(a) '(b c d)))
 (assert-equal? "append test3" '(a (b) (c)) (append '(a (b)) '((c))))
+(define w '(n o))
+(define x '(d o))
+(define y '(car))
+(define z '(why))
+(assert-equal? "append test4" '(n o d o car why . ta) (append w x y () z 'ta))
+(assert-equal? "append test5" '(n o) w)	; test non-destructiveness
+(assert-equal? "append test6" x (cdr (append '((Calpis hosi-)) x))) ; share last
 
 ; reverse
 (assert-equal? "reverse test1" '(c b a) (reverse '(a b c)))
@@ -59,7 +66,7 @@
 (assert-equal? "list-tail test4" '() (list-tail '(a b c) 3))
 
 ; list-ref
-(assert-eq? "list-ref test1" 'c (list-ref '(a b c d) 2))
+(assert-equal? "list-ref test1" 'c (list-ref '(a b c d) 2))
 
 ; memq
 (assert-equal? "memq test1" '(a b c) (memq 'a '(a b c)))

Modified: branches/r5rs/sigscheme/test/test-num.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-num.scm	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/test/test-num.scm	2005-08-21 11:48:30 UTC (rev 1267)
@@ -1,41 +1,41 @@
 (load "test/unittest.scm")
 
-(assert-eq? "= test" #t (= 1 1))
-(assert-eq? "+ test1" 0  (+))
-(assert-eq? "+ test2" 3  (+ 3))
-(assert-eq? "+ test3" 3  (+ 1 2))
-(assert-eq? "+ test4" 6  (+ 1 2 3))
-(assert-eq? "- test1" -3 (- 3))
-(assert-eq? "- test2" -1 (- 1 2))
-(assert-eq? "- test3" -4 (- 1 2 3))
-(assert-eq? "* test1" 1  (*))
-(assert-eq? "* test2" 2  (* 2))
-(assert-eq? "* test3" 24 (* 2 3 4))
-(assert-eq? "/ test1" 0  (/ 1 2))
-(assert-eq? "/ test2" -1 (/ -2 2))
+(assert-equal? "= test" #t (= 1 1))
+(assert-equal? "+ test1" 0  (+))
+(assert-equal? "+ test2" 3  (+ 3))
+(assert-equal? "+ test3" 3  (+ 1 2))
+(assert-equal? "+ test4" 6  (+ 1 2 3))
+(assert-equal? "- test1" -3 (- 3))
+(assert-equal? "- test2" -1 (- 1 2))
+(assert-equal? "- test3" -4 (- 1 2 3))
+(assert-equal? "* test1" 1  (*))
+(assert-equal? "* test2" 2  (* 2))
+(assert-equal? "* test3" 24 (* 2 3 4))
+(assert-equal? "/ test1" 0  (/ 1 2))
+(assert-equal? "/ test2" -1 (/ -2 2))
 
-(assert-eq? "abs test1" 7 (abs -7))
-(assert-eq? "abs test2" 7 (abs 7))
+(assert-equal? "abs test1" 7 (abs -7))
+(assert-equal? "abs test2" 7 (abs 7))
 
-(assert-eq? "quotient test1" 0  (/ 1 2))
-(assert-eq? "quotient test2" -1 (/ -2 2))
+(assert-equal? "quotient test1" 0  (/ 1 2))
+(assert-equal? "quotient test2" -1 (/ -2 2))
 
-(assert-eq? "modulo test1" 1 (modulo 13 4))
-(assert-eq? "modulo test2" 3 (modulo -13 4))
-(assert-eq? "modulo test3" -3 (modulo 13 -4))
-(assert-eq? "modulo test4" -1 (modulo -13 -4))
+(assert-equal? "modulo test1" 1 (modulo 13 4))
+(assert-equal? "modulo test2" 3 (modulo -13 4))
+(assert-equal? "modulo test3" -3 (modulo 13 -4))
+(assert-equal? "modulo test4" -1 (modulo -13 -4))
 
-(assert-eq? "remainder test1" 1 (remainder 13 4))
-(assert-eq? "remainder test2" -1 (remainder -13 4))
-(assert-eq? "remainder test3" 1 (remainder 13 -4))
-(assert-eq? "remainder test4" -1 (remainder -13 -4))
+(assert-equal? "remainder test1" 1 (remainder 13 4))
+(assert-equal? "remainder test2" -1 (remainder -13 4))
+(assert-equal? "remainder test3" 1 (remainder 13 -4))
+(assert-equal? "remainder test4" -1 (remainder -13 -4))
 
 (assert-equal? "number->string test1" "1" (number->string 1))
 (assert-equal? "number->string test2" "10" (number->string 10))
 (assert-equal? "number->string test3" "100" (number->string 100))
 
-(assert-eq? "string->number test1" 1   (string->number "1"))
-(assert-eq? "string->number test2" 10  (string->number "10"))
-(assert-eq? "string->number test2" 100 (string->number "100"))
+(assert-equal? "string->number test1" 1   (string->number "1"))
+(assert-equal? "string->number test2" 10  (string->number "10"))
+(assert-equal? "string->number test2" 100 (string->number "100"))
 
 (total-report)

Modified: branches/r5rs/sigscheme/test/test-string.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-string.scm	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/test/test-string.scm	2005-08-21 11:48:30 UTC (rev 1267)
@@ -9,11 +9,11 @@
 (assert "hiragana make-string check" (string=? "¤¢¤¢¤¢" (make-string 3 #\¤¢)))
 
 ;; check string-ref
-(assert-eq? "alphabet string-ref check" #\o  (string-ref "aiueo" 4))
-(assert-eq? "hiragena string-ref check" #\¤ª (string-ref "¤¢¤¤¤¦¤¨¤ª" 4))
-(assert-eq? "mixed string-ref check"    #\¤ª (string-ref "¤¢iue¤ª" 4))
-(assert-eq? "alphabet string-ref 0 check" #\a  (string-ref "aiueo" 0))
-(assert-eq? "hiragena string-ref 0 check" #\¤¢ (string-ref "¤¢¤¤¤¦¤¨¤ª" 0))
+(assert-equal? "alphabet string-ref check" #\o  (string-ref "aiueo" 4))
+(assert-equal? "hiragena string-ref check" #\¤ª (string-ref "¤¢¤¤¤¦¤¨¤ª" 4))
+(assert-equal? "mixed string-ref check"    #\¤ª (string-ref "¤¢iue¤ª" 4))
+(assert-equal? "alphabet string-ref 0 check" #\a  (string-ref "aiueo" 0))
+(assert-equal? "hiragena string-ref 0 check" #\¤¢ (string-ref "¤¢¤¤¤¦¤¨¤ª" 0))
 
 ;; check string-set!
 (assert "alphabet string-set! check" (string=? "aikeo"
@@ -33,13 +33,13 @@
 					      str)))
 
 ;; check string-length
-(assert-eq? "alphabet string-length check" 5 (string-length "aiueo"))
-(assert-eq? "hiragana string-length check" 5 (string-length "¤¢¤¤¤¦¤¨¤ª"))
+(assert-equal? "alphabet string-length check" 5 (string-length "aiueo"))
+(assert-equal? "hiragana string-length check" 5 (string-length "¤¢¤¤¤¦¤¨¤ª"))
 
 ;; string=? check
-(assert-eq? "alphabet string=? check" #t (string=? "aiueo" "aiueo"))
-(assert-eq? "hiragana string=? check" #t (string=? "¤¢¤¤¤¦¤¨¤ª" "¤¢¤¤¤¦¤¨¤ª"))
-(assert-eq? "mixed string=? check"    #t (string=? "a¤¤¤¦¤¨o" "a¤¤¤¦¤¨o"))
+(assert-equal? "alphabet string=? check" #t (string=? "aiueo" "aiueo"))
+(assert-equal? "hiragana string=? check" #t (string=? "¤¢¤¤¤¦¤¨¤ª" "¤¢¤¤¤¦¤¨¤ª"))
+(assert-equal? "mixed string=? check"    #t (string=? "a¤¤¤¦¤¨o" "a¤¤¤¦¤¨o"))
 
 
 ;; substring check

Modified: branches/r5rs/sigscheme/test/unittest-bigloo.scm
===================================================================
--- branches/r5rs/sigscheme/test/unittest-bigloo.scm	2005-08-21 11:15:38 UTC (rev 1266)
+++ branches/r5rs/sigscheme/test/unittest-bigloo.scm	2005-08-21 11:48:30 UTC (rev 1267)
@@ -3,7 +3,8 @@
 ;*---------------------------------------------------------------------*/
 ;* For Bigloo Test                                                     */
 ;*---------------------------------------------------------------------*/
-(define test assert-equal?)
+(define (test name val expected-val)
+  (assert-equal? name expected-val val))
 (define (foo1 x)
    x)
 (define (foo2 . x)



More information about the uim-commit mailing list