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

kzk at freedesktop.org kzk at freedesktop.org
Tue Jul 19 05:49:01 EST 2005


Author: kzk
Date: 2005-07-18 12:48:58 -0700 (Mon, 18 Jul 2005)
New Revision: 975

Added:
   branches/r5rs/sigscheme/test/test-map.scm
   branches/r5rs/sigscheme/test/test-quote.scm
   branches/r5rs/sigscheme/test/test-vector.scm
Removed:
   branches/r5rs/sigscheme/test/map.scm
   branches/r5rs/sigscheme/test/quote.scm
   branches/r5rs/sigscheme/test/vector.scm
Modified:
   branches/r5rs/sigscheme/bench/bench-fib.scm
   branches/r5rs/sigscheme/datas.c
   branches/r5rs/sigscheme/debug.c
   branches/r5rs/sigscheme/operations.c
   branches/r5rs/sigscheme/sigscheme.c
   branches/r5rs/sigscheme/sigscheme.h
   branches/r5rs/sigscheme/sigschemetype.h
   branches/r5rs/sigscheme/test/test-equation.scm
   branches/r5rs/sigscheme/test/test-num.scm
   branches/r5rs/sigscheme/test/test-string.scm
Log:
* I have implemented "equal?" procedure. And by using this,
  many test cases are added.

* sigscheme/sigscheme.c
  - (SigScm_Initialize): added "equal?", fixed typo "remainder"
    and protect current_input_port and current_output_port from
    gc.
* sigscheme/sigscheme.h
  - (SigScm_gc_protect): new func
  - (Scm_NewVector): now second arg's type is int
  - (ScmOp_equalp): new func
  - (ScmOp_remainder): fixed typo
* sigscheme/operations.c
  - (ScmOp_equalp): new func
  - (ScmOp_remainder): fixed typo
  - now SCM_VECTOR_LEN returns int value
* sigscheme/debug.c
  - now SCM_VECTOR_LEN returns int value
* sigscheme/datas.c
  - now SCM_VECTOR_LEN returns int value
  - (SigScm_gc_protect): new func

* test/test-vector.scm
  - renamed from vector.scm
* test/test-equation.scm
  - add "equal?" test case
* test/test-quote.scm
  - renamed from quote.scm
* test/test-num.scm
  - add "abs", "quotient", "modulo", "remainder" test cases
* test/test-string.scm
  - add "string->list" test case
* test/test-map.scm
  - renamed from map.scm


Modified: branches/r5rs/sigscheme/bench/bench-fib.scm
===================================================================

Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c	2005-07-17 22:38:50 UTC (rev 974)
+++ branches/r5rs/sigscheme/datas.c	2005-07-18 19:48:58 UTC (rev 975)
@@ -39,7 +39,7 @@
  *
  * [1] Mark phase : gc_mark()
  *   - gc_mark_protected_obj()
- *       marking protected Scheme object which are protected by calling gc_protect().
+ *       marking protected Scheme object which are protected by calling SigScm_gc_protect().
  *
  *   - gc_mark_stack()
  *       marking the Scheme object which are pushed to the stack, so we need to
@@ -110,9 +110,6 @@
 static void add_heap(ScmObjHeap **heaps, int *num_heap, int HEAP_SIZE, ScmObj *freelist);
 static void finalize_heap(void);
 
-static void gc_protect(ScmObj obj);
-
-
 static void gc_preprocess(void);
 static void gc_mark_and_sweep(void);
 
@@ -313,18 +310,16 @@
 	    goto mark_loop;
 	    break;
 	case ScmVector:
-	    for (i = 0; i < SCM_INT_VALUE(SCM_VECTOR_LEN(obj)); i++) {
+	    for (i = 0; i < SCM_VECTOR_LEN(obj); i++) {
 		mark_obj(SCM_VECTOR_VEC(obj)[i]);
 	    }
-	    obj = SCM_VECTOR_LEN(obj);
-	    goto mark_loop;
 	    break;
 	default:
 	    break;
     }
 }
 
-static void gc_protect(ScmObj obj)
+void SigScm_gc_protect(ScmObj obj)
 {
     gc_protected_obj *item = (gc_protected_obj*)malloc(sizeof(gc_protected_obj));
     item->obj = obj;
@@ -584,7 +579,7 @@
     return obj;
 }
 
-ScmObj Scm_NewVector(ScmObj *vec, ScmObj len)
+ScmObj Scm_NewVector(ScmObj *vec, int len)
 {
     ScmObj obj = SCM_NIL;
     SCM_NEW_OBJ_INTERNAL(obj);

Modified: branches/r5rs/sigscheme/debug.c
===================================================================
--- branches/r5rs/sigscheme/debug.c	2005-07-17 22:38:50 UTC (rev 974)
+++ branches/r5rs/sigscheme/debug.c	2005-07-18 19:48:58 UTC (rev 975)
@@ -175,7 +175,7 @@
 static void print_vector(FILE *f, ScmObj vec)
 {
     ScmObj *v = SCM_VECTOR_VEC(vec); 
-    int c_len = SCM_INT_VALUE(SCM_VECTOR_LEN(vec));
+    int c_len = SCM_VECTOR_LEN(vec);
     int i     = 0;
 
     /* print left parenthesis with '#' */

Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c	2005-07-17 22:38:50 UTC (rev 974)
+++ branches/r5rs/sigscheme/operations.c	2005-07-18 19:48:58 UTC (rev 975)
@@ -134,6 +134,111 @@
     return ScmOp_eqvp(obj1, obj2);
 }
 
+ScmObj ScmOp_equalp(ScmObj obj1, ScmObj obj2)
+{
+    int  i = 0;
+    enum ScmObjType type = (enum ScmObjType)SCM_GETTYPE(obj1);
+
+    /* different type */
+    if (type != SCM_GETTYPE(obj2))
+        return SCM_FALSE;
+
+    /* same type */
+    switch (type) {
+        case ScmInt:
+            /* both numbers, are numerically equal */
+            if ((SCM_INT_VALUE(obj1) == SCM_INT_VALUE(obj2)))
+            {
+                return SCM_TRUE;
+            }
+            break;
+        case ScmSymbol:
+            /* symbols which have same name */
+            if (strcmp(SCM_SYMBOL_NAME(obj1), SCM_SYMBOL_NAME(obj2)) == 0)
+            {
+                return SCM_TRUE;
+            }
+            break;
+        case ScmChar:
+            /* chars and are the same character according to the char=? */
+            if (EQ(ScmOp_char_equal(obj1, obj2), SCM_TRUE))
+	    {
+                return SCM_TRUE;
+            }
+            break;
+        case ScmCons:
+	    for (; !SCM_NULLP(obj1); obj1 = SCM_CDR(obj1), obj2 = SCM_CDR(obj2))
+	    {
+		/* check contents */
+		if (EQ(ScmOp_equalp(SCM_CAR(obj1), SCM_CAR(obj2)), SCM_FALSE))
+		{
+		    return SCM_FALSE;
+		}
+
+		/* check next cdr's type */
+		if (SCM_GETTYPE(SCM_CDR(obj1)) != SCM_GETTYPE(SCM_CDR(obj2)))
+		{
+		    return SCM_FALSE;
+		}
+		
+		/* check dot pair */
+		if (!SCM_CONSP(SCM_CDR(obj1)))
+		{
+		    if(EQ(ScmOp_equalp(SCM_CDR(obj1), SCM_CDR(obj2)), SCM_FALSE))
+			return SCM_FALSE;
+		    else
+			return SCM_TRUE;
+		}
+	    }
+	    return SCM_TRUE;
+        case ScmVector:
+	    /* check len */
+	    if (SCM_VECTOR_LEN(obj1) != SCM_VECTOR_LEN(obj2))
+	    {
+		return SCM_FALSE;
+	    }
+	    /* check contents */
+	    for (i = 0; i < SCM_VECTOR_LEN(obj1); i++)
+	    {
+		if (EQ(ScmOp_equalp(SCM_VECTOR_CREF(obj1, i), SCM_VECTOR_CREF(obj2, i)), SCM_FALSE))
+		    return SCM_FALSE;
+	    }
+	    return SCM_TRUE;
+        case ScmString:
+	    /* check string data */
+	    if (strcmp(SCM_STRING_STR(obj1), SCM_STRING_STR(obj2)) == 0)
+	    {
+		return SCM_TRUE;
+	    }
+	    break;
+        case ScmFunc:
+        case ScmClosure:
+	case ScmPort:
+            {
+                return SCM_UNSPECIFIED;
+            }
+            break;
+        case ScmEtc:
+            /* obj1 and obj2 are both #t or both #f */
+            if (((EQ(obj1, SCM_TRUE) && EQ(obj2, SCM_TRUE)))
+                || (EQ(obj1, SCM_FALSE) && EQ(obj2, SCM_FALSE)))
+            {
+                return SCM_TRUE;
+            }
+            /* both obj1 and obj2 are the empty list */
+            if (SCM_NULLP(obj1) && SCM_NULLP(obj2))
+            {
+                return SCM_TRUE;
+            }
+            break;
+        case ScmFreeCell:
+            SigScm_Error("equal? : cannnot compare freecell, gc broken?\n");
+            break;
+    }
+
+    return SCM_FALSE;
+}
+
 /*==============================================================================
   R5RS : 6.2 Numbers
 ==============================================================================*/
@@ -500,7 +605,7 @@
     return Scm_NewInt(rem);
 }
 
-ScmObj ScmOp_reminder(ScmObj scm_n1, ScmObj scm_n2)
+ScmObj ScmOp_remainder(ScmObj scm_n1, ScmObj scm_n2)
 {
     int n1  = 0;
     int n2  = 0;
@@ -1409,7 +1514,7 @@
         vec[i] = fill;
     }
 
-    return Scm_NewVector(vec, scm_k);
+    return Scm_NewVector(vec, c_k);
 }
 
 ScmObj ScmOp_vector(ScmObj arg, ScmObj env )
@@ -1425,7 +1530,7 @@
         arg = SCM_CDR(arg);
     }
 
-    return Scm_NewVector(vec, scm_len);
+    return Scm_NewVector(vec, c_len);
 }
 
 ScmObj ScmOp_vector_length(ScmObj vec)
@@ -1433,7 +1538,7 @@
     if (!SCM_VECTORP(vec))
         SigScm_Error("vector-length : vector required\n");
 
-    return SCM_VECTOR_LEN(vec);
+    return Scm_NewInt(SCM_VECTOR_LEN(vec));
 }
 
 ScmObj ScmOp_vector_ref(ScmObj vec, ScmObj scm_k)
@@ -1471,7 +1576,7 @@
         SigScm_Error("vector->list : vector required\n");
 
     v = SCM_VECTOR_VEC(vec);
-    c_len = SCM_INT_VALUE(SCM_VECTOR_LEN(vec));
+    c_len = SCM_VECTOR_LEN(vec);
     if (c_len == 0)
         return SCM_NIL;
 
@@ -1509,7 +1614,7 @@
         list = SCM_CDR(list);
     }
 
-    return Scm_NewVector(v, scm_len);
+    return Scm_NewVector(v, c_len);
 }
 
 ScmObj ScmOp_vector_fill(ScmObj vec, ScmObj fill)
@@ -1520,7 +1625,7 @@
     if (!SCM_VECTORP(vec))
         SigScm_Error("vector->list : vector required\n");
 
-    c_len = SCM_INT_VALUE(SCM_VECTOR_LEN(vec));
+    c_len = SCM_VECTOR_LEN(vec);
     for (i = 0; i < c_len; i++) {
         SCM_VECTOR_VEC(vec)[i] = fill;
     }
@@ -1581,7 +1686,7 @@
 
     /* 1proc and many args case */
     arg_vector = ScmOp_list_to_vector(SCM_CDR(map_arg));
-    vector_len = SCM_INT_VALUE(SCM_VECTOR_LEN(arg_vector));
+    vector_len = SCM_VECTOR_LEN(arg_vector);
     while (1) {
         /* create arg */
         arg1 = SCM_NIL;

Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c	2005-07-17 22:38:50 UTC (rev 974)
+++ branches/r5rs/sigscheme/sigscheme.c	2005-07-18 19:48:58 UTC (rev 975)
@@ -123,6 +123,7 @@
     Scm_InitSubr1("quote"                , ScmOp_quote);
     Scm_InitSubr2("eqv?"                 , ScmOp_eqvp);
     Scm_InitSubr2("eq?"                  , ScmOp_eqp);
+    Scm_InitSubr2("equal?"               , ScmOp_equalp);
     Scm_InitSubr1("number?"              , ScmOp_numberp);
     Scm_InitSubrL("="                    , ScmOp_equal);
     Scm_InitSubrL("<"                    , ScmOp_bigger);
@@ -143,7 +144,7 @@
     Scm_InitSubr1("abs"                  , ScmOp_abs);
     Scm_InitSubr2("quotient"             , ScmOp_quotient);
     Scm_InitSubr2("modulo"               , ScmOp_modulo);
-    Scm_InitSubr2("reminder"             , ScmOp_reminder);
+    Scm_InitSubr2("remainder"            , ScmOp_remainder);
     Scm_InitSubr1("not"                  , ScmOp_not);
     Scm_InitSubr1("boolean?"             , ScmOp_booleanp);
     Scm_InitSubr1("pairp?"               , ScmOp_pairp);
@@ -255,7 +256,9 @@
       Current Input & Output Initialization
     =======================================================================*/
     current_input_port  = Scm_NewPort(stdin,  PORT_INPUT);
+    SigScm_gc_protect(current_input_port);
     current_output_port = Scm_NewPort(stdout, PORT_OUTPUT);
+    SigScm_gc_protect(current_output_port);
 
     stack_start_pointer = NULL;
 }

Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h	2005-07-17 22:38:50 UTC (rev 974)
+++ branches/r5rs/sigscheme/sigscheme.h	2005-07-18 19:48:58 UTC (rev 975)
@@ -106,6 +106,7 @@
 /* datas.c */
 void   SigScm_InitStorage(void);
 void   SigScm_FinalizeStorage(void);
+void   SigScm_gc_protect(ScmObj obj);
 ScmObj Scm_NewCons(ScmObj a, ScmObj b);
 ScmObj Scm_NewInt(int val);
 ScmObj Scm_NewSymbol(char *name, ScmObj v_cell);
@@ -114,7 +115,7 @@
 ScmObj Scm_NewString_With_StrLen(char *str, int len);
 ScmObj Scm_NewFunc(enum ScmFuncArgNum num_arg, ScmFuncType func);
 ScmObj Scm_NewClosure(ScmObj exp, ScmObj env);
-ScmObj Scm_NewVector(ScmObj *vec, ScmObj len);
+ScmObj Scm_NewVector(ScmObj *vec, int len);
 ScmObj Scm_NewPort(FILE *file, enum ScmPortType ptype);
 ScmObj Scm_Intern(const char *name);
 
@@ -143,7 +144,8 @@
 
 /* operations.c */
 ScmObj ScmOp_eqvp(ScmObj obj1, ScmObj obj2);
-ScmObj ScmOp_eqp(ScmObj Obj1, ScmObj obj2);
+ScmObj ScmOp_eqp(ScmObj obj1, ScmObj obj2);
+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);
@@ -164,7 +166,7 @@
 ScmObj ScmOp_abs(ScmObj num);
 ScmObj ScmOp_quotient(ScmObj n1, ScmObj n2);
 ScmObj ScmOp_modulo(ScmObj n1, ScmObj n2);
-ScmObj ScmOp_reminder(ScmObj n1, ScmObj n2);
+ScmObj ScmOp_remainder(ScmObj n1, ScmObj n2);
 ScmObj ScmOp_not(ScmObj obj);
 ScmObj ScmOp_booleanp(ScmObj obj);
 ScmObj ScmOp_pairp(ScmObj obj);

Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h	2005-07-17 22:38:50 UTC (rev 974)
+++ branches/r5rs/sigscheme/sigschemetype.h	2005-07-18 19:48:58 UTC (rev 975)
@@ -162,7 +162,7 @@
 
         struct ScmVector {
             ScmObj *vec;
-            ScmObj len;
+            int len;
         } vector;
 
         struct ScmPort {            

Deleted: branches/r5rs/sigscheme/test/map.scm
===================================================================
--- branches/r5rs/sigscheme/test/map.scm	2005-07-17 22:38:50 UTC (rev 974)
+++ branches/r5rs/sigscheme/test/map.scm	2005-07-18 19:48:58 UTC (rev 975)
@@ -1,8 +0,0 @@
-(print (map cadr '((1 2) (1 2) (1 2))))
-(print (map + '(1 2 3) '(1 2 3)))
-(print (map (lambda (x y) (+ x y))
-	    '(1 2 3) '(1 2 3)))
-(print (map print '(1 2 3)))
-
-(print (map print '(1 2 3)))
-(print (map (lambda (x) (+ x x)) '(1 2 3)))

Deleted: branches/r5rs/sigscheme/test/quote.scm
===================================================================
--- branches/r5rs/sigscheme/test/quote.scm	2005-07-17 22:38:50 UTC (rev 974)
+++ branches/r5rs/sigscheme/test/quote.scm	2005-07-18 19:48:58 UTC (rev 975)
@@ -1,9 +0,0 @@
-(load "test/unittest.scm")
-
-(print '(1 2 3))
-(print `(1 2 3))
-
-;(assert-eq? "quasiquote check" '(1 2 3) `(1 2 3))
-;(assert-eq? "unquote check" `(1 2 3) `(1 ,(+ 1 1) ,(+ 1 2)))
-;(assert-eq? "unquote-splicing check" `(1 2 3) `(1 ,@(car '(1 2)) 3))
-;(assert-eq? "mixed check" '(a 3 c 7 8 9) `(a ,(+ 1 2) c ,@(cdr '(6 7 8 9))))

Modified: branches/r5rs/sigscheme/test/test-equation.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-equation.scm	2005-07-17 22:38:50 UTC (rev 974)
+++ branches/r5rs/sigscheme/test/test-equation.scm	2005-07-18 19:48:58 UTC (rev 975)
@@ -4,8 +4,8 @@
 ;; check eqv?
 (assert "check both #t" (eqv? #t #t))
 (assert "check both #f" (eqv? #f #f))
-;(assert "check symbol"  (string=? (symbol->string 'obj)
-; (symbol->string 'obj)))
+(assert "check symbol"  (string=? (symbol->string 'obj)
+				  (symbol->string 'obj)))
 (assert "check num"  (eqv? 10 10))
 (assert "check alphabet char" (eqv? #\a  #\a))
 (assert "check hiragana char" (eqv? #\¤¢ #\¤¢))
@@ -22,4 +22,14 @@
 
 (assert-eq? "check func" + +)
 
+;; check equal?
+(assert "basic equal? test1" (equal? 'a 'a))
+(assert "basic equal? test2" (equal? '(a) '(a)))
+(assert "basic equal? test3" (equal? '(a (b) c)
+				     '(a (b) c)))
+(assert "basic equal? test4" (equal? "abc" "abc"))
+(assert "basic equal? test5" (equal? 2 2))
+(assert "basic equal? test6" (equal? (make-vector 5 'a)
+				     (make-vector 5 'a)))
+
 (total-report)

Copied: branches/r5rs/sigscheme/test/test-map.scm (from rev 973, branches/r5rs/sigscheme/test/map.scm)
===================================================================
--- branches/r5rs/sigscheme/test/map.scm	2005-07-17 21:10:29 UTC (rev 973)
+++ branches/r5rs/sigscheme/test/test-map.scm	2005-07-18 19:48:58 UTC (rev 975)
@@ -0,0 +1,8 @@
+(load "test/unittest.scm")
+
+(assert "basic map test1" (equal? '(2 2 2) (map cadr '((1 2) (1 2) (1 2)))))
+(assert "basic map test2" (equal? '(2 4 6) (map + '(1 2 3) '(1 2 3))))
+(assert "basic map test3" (equal? '(2 4 6) (map (lambda (x y) (+ x y))
+						'(1 2 3) '(1 2 3))))
+
+(total-report)

Modified: branches/r5rs/sigscheme/test/test-num.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-num.scm	2005-07-17 22:38:50 UTC (rev 974)
+++ branches/r5rs/sigscheme/test/test-num.scm	2005-07-18 19:48:58 UTC (rev 975)
@@ -4,7 +4,23 @@
 (assert-eq? "+ test" 3  (+ 1 2))
 (assert-eq? "- test" -1 (- 1 2))
 (assert-eq? "* test" 2  (* 1 2))
-(assert-eq? "/ test" 0  (/ 1 2))
-(assert-eq? "/ test" -1 (/ -2 2))
+(assert-eq? "/ test1" 0  (/ 1 2))
+(assert-eq? "/ test2" -1 (/ -2 2))
 
+(assert-eq? "abs test1" 7 (abs -7))
+(assert-eq? "abs test2" 7 (abs 7))
+
+(assert-eq? "quotient test1" 0  (/ 1 2))
+(assert-eq? "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-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))
+
 (total-report)

Copied: branches/r5rs/sigscheme/test/test-quote.scm (from rev 973, branches/r5rs/sigscheme/test/quote.scm)
===================================================================
--- branches/r5rs/sigscheme/test/quote.scm	2005-07-17 21:10:29 UTC (rev 973)
+++ branches/r5rs/sigscheme/test/test-quote.scm	2005-07-18 19:48:58 UTC (rev 975)
@@ -0,0 +1,8 @@
+(load "test/unittest.scm")
+
+(assert "quasiquote check" (equal? '(1 2 3) `(1 2 3)))
+(assert "unquote check" (equal? `(1 2 3) `(1 ,(+ 1 1) ,(+ 1 2))))
+(assert "unquote-splicing check" (equal? `(1 2 3) `(1 ,@(cdr '(1 2)) 3)))
+(assert "mixed check" (equal? '(a 3 c 7 8 9) `(a ,(+ 1 2) c ,@(cdr '(6 7 8 9)))))
+
+(total-report)

Modified: branches/r5rs/sigscheme/test/test-string.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-string.scm	2005-07-17 22:38:50 UTC (rev 974)
+++ branches/r5rs/sigscheme/test/test-string.scm	2005-07-18 19:48:58 UTC (rev 975)
@@ -59,8 +59,7 @@
 (assert "mixed 3 string-append check" (string=? "¤¢i¤¦" (string-append "¤¢" "i" "¤¦")))
 
 ;; string->list
-; TODO : cannot write test now
-;(assert "string->list check" (string->list "¤¢i¤¦e¤ª"))
+(assert "string->list check" (equal? '(#\¤¢ #\i #\¤¦ #\e #\¤ª) (string->list "¤¢i¤¦e¤ª")))
 
 
 ;; list->string

Copied: branches/r5rs/sigscheme/test/test-vector.scm (from rev 973, branches/r5rs/sigscheme/test/vector.scm)
===================================================================
--- branches/r5rs/sigscheme/test/vector.scm	2005-07-17 21:10:29 UTC (rev 973)
+++ branches/r5rs/sigscheme/test/test-vector.scm	2005-07-18 19:48:58 UTC (rev 975)
@@ -0,0 +1,24 @@
+(load "test/unittest.scm")
+
+(define vec (vector 'a 'b 'c 'd))
+
+(assert "vector test"  (equal? '#(a b c d) vec))
+(assert "vector? test" (vector? vec))
+(assert-eq? "vector-length test" 4 (vector-length vec))
+(assert-eq? "vector-ref test" 'd (vector-ref vec 3))
+(assert "vector-set! test" (equal? '#(1 a "aiue" #t) (begin
+							(define tmpvec (vector 1 'a "aiue" #f))
+							(vector-set! tmpvec 3 #t)
+							tmpvec)))
+
+(assert "vector->list test" (equal? '(a b c d) (vector->list vec)))
+(assert "list->vector test" (equal? '#(a b c d) (list->vector '(a b c d))))
+(assert "vector-fill! test" (equal? '#(#f #f #f #f) (begin
+						      (define tmpvec (vector #t #t #t #t))
+						      (vector-fill! tmpvec #f)
+						      tmpvec)))
+
+;(print (make-vector 3))
+(assert "make-vector test" (equal? '#(#f #f #f) (make-vector 3 #f)))
+
+(total-report)

Deleted: branches/r5rs/sigscheme/test/vector.scm
===================================================================
--- branches/r5rs/sigscheme/test/vector.scm	2005-07-17 22:38:50 UTC (rev 974)
+++ branches/r5rs/sigscheme/test/vector.scm	2005-07-18 19:48:58 UTC (rev 975)
@@ -1,15 +0,0 @@
-(define vec (vector 'a 'b 'c 'd))
-
-(print vec)
-(print (vector? vec))
-(print (vector-length vec))
-(print (vector-ref vec 3))
-(vector-set! vec 3 #t)
-(print vec)
-(print (vector->list vec))
-(print (list->vector (vector->list vec)))
-(vector-fill! vec #f)
-(print vec)
-
-(print (make-vector 3))
-(print (make-vector 3 #f))



More information about the uim-commit mailing list