* Eliminated use of SCM_ASSERT to check for range errors.
authorDirk Herrmann <dirk@dirk-herrmanns-seiten.de>
Fri, 30 Jun 2000 10:46:35 +0000 (10:46 +0000)
committerDirk Herrmann <dirk@dirk-herrmanns-seiten.de>
Fri, 30 Jun 2000 10:46:35 +0000 (10:46 +0000)
* Fix some error reporting code in list.c
* Added some test cases.

13 files changed:
doc/ChangeLog
doc/data-rep.texi
libguile/ChangeLog
libguile/__scm.h
libguile/error.c
libguile/hashtab.c
libguile/hooks.c
libguile/list.c
libguile/strings.c
libguile/unif.c
libguile/vectors.c
test-suite/ChangeLog
test-suite/tests/list.test

index 9b7bd46..bdde435 100644 (file)
@@ -1,3 +1,7 @@
+2000-06-30  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+       * data-rep.tex:  Removed documentation for SCM_OUTOFRANGE.
+
 2000-06-20  Mikael Djurfeldt  <mdj@thalamus.nada.kth.se>
 
        * data-rep.texi: Center discussion around the standard interface
index d515d3a..407a796 100644 (file)
@@ -46,7 +46,7 @@ by the Free Software Foundation.
 @sp 10
 @comment The title is printed in a large font.
 @title Data Representation in Guile
-@subtitle $Id: data-rep.texi,v 1.11 2000-06-20 03:22:56 mdj Exp $
+@subtitle $Id: data-rep.texi,v 1.12 2000-06-30 10:46:33 dirk Exp $
 @subtitle For use with Guile @value{VERSION}
 @author Jim Blandy
 @author Free Software Foundation
@@ -1077,11 +1077,6 @@ naming the function.  Usually, Guile catches these errors before ever
 invoking the subr, so we don't run into these problems.
 @end deftypefn
 
-@deftypefn Macro int SCM_OUTOFRANGE
-Signal an error complaining that @var{obj} is ``out of range'' for
-@var{subr}.
-@end deftypefn
-
 
 @node Defining New Types (Smobs),  , How Guile does it, Top
 @section Defining New Types (Smobs)
index 31cd6ea..daeabdc 100644 (file)
@@ -1,3 +1,36 @@
+2000-06-30  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+       * __scm.h (SCM_OUTOFRANGE):  Removed.
+
+       * error.c (scm_wta):  Removed sick dispatch code for range
+       errors.  (More sick dispatches still to be removed.)
+
+       * hashtab.c (scm_hash_fn_get_handle, scm_hash_fn_create_handle_x,
+       scm_hash_fn_remove_x):  Eliminate redundant test for if unsigned
+       value is non-negative.  Use scm_out_of_range to signal range
+       errors.
+
+       * hooks.c (make_hook), unif.c (scm_aind):  Use scm_out_of_range to
+       signal range errors.
+
+       * list.c (scm_list_ref, scm_list_set_x, scm_list_cdr_set_x):  Fix
+       error reporting (now uses original input parameter to report wrong
+       type argument errors).  Use SCM_OUT_OF_RANGE to report range
+       errors and SCM_WRONG_TYPE_ARG to report type errors.
+
+       * strings.c (scm_substring):  Make range checks for negative
+       values explicit (former behaviour relied on an implicit
+       conversion from signed to unsigned).  Don't use SCM_ASSERT for
+       range checks.
+
+       * unif.c (scm_aind, scm_transpose_array, scm_bit_set_star_x,
+       scm_bit_count_star):  Use scm_out_of_range to signal range
+       errors.
+
+       * unif.c (scm_transpose_array, scm_bit_position), vectors.c
+       (scm_vector_ref, scm_vector_set_x, scm_vector_move_left_x,
+       scm_vector_move_right_x):  Use SCM_ASSERT_RANGE to check ranges.
+
 2000-06-30  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
        * validate.h (SCM_VALIDATE_INUM_MIN_COPY,
index 13eaa82..f1aa50a 100644 (file)
@@ -554,7 +554,6 @@ extern SCM scm_apply_generic (SCM gf, SCM args);
 /* SCM_WNA must follow the last SCM_ARGn in sequence.
  */
 #define SCM_WNA                8
-#define SCM_OUTOFRANGE                 10
 
 #endif /* SCM_MAGIC_SNARFER */
 
index 88e6fc0..067b3cd 100644 (file)
@@ -316,8 +316,6 @@ scm_wta (SCM arg, const char *pos, const char *s_subr)
          scm_wrong_type_arg (s_subr, 7, arg);
        case SCM_WNA:
          scm_wrong_num_args (arg);
-       case SCM_OUTOFRANGE:
-         scm_out_of_range (s_subr, arg);
        default:
          /* this shouldn't happen.  */
          scm_misc_error (s_subr, "Unknown error", SCM_EOL);
index f8e20e8..6b169c6 100644 (file)
@@ -66,10 +66,8 @@ scm_hash_fn_get_handle (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_
   if (SCM_LENGTH (table) == 0)
     return SCM_EOL;
   k = hash_fn (obj, SCM_LENGTH (table), closure);
-  SCM_ASSERT ((0 <= k) && (k < SCM_LENGTH (table)),
-             scm_ulong2num (k),
-             SCM_OUTOFRANGE,
-             "hash_fn_get_handle");
+  if (k >= SCM_LENGTH (table))
+    scm_out_of_range ("hash_fn_get_handle", scm_ulong2num (k));
   h = assoc_fn (obj, SCM_VELTS (table)[k], closure);
   return h;
 }
@@ -87,10 +85,8 @@ scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned int (*hash_fn)(
   if (SCM_LENGTH (table) == 0)
     return SCM_EOL;
   k = hash_fn (obj, SCM_LENGTH (table), closure);
-  SCM_ASSERT ((0 <= k) && (k < SCM_LENGTH (table)),
-             scm_ulong2num (k),
-             SCM_OUTOFRANGE,
-             "hash_fn_create_handle_x");
+  if (k >= SCM_LENGTH (table))
+    scm_out_of_range ("hash_fn_create_handle_x", scm_ulong2num (k));
   SCM_REDEFER_INTS;
   it = assoc_fn (obj, SCM_VELTS (table)[k], closure);
   if (SCM_NIMP (it))
@@ -154,10 +150,8 @@ scm_hash_fn_remove_x (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_fn
   if (SCM_LENGTH (table) == 0)
     return SCM_EOL;
   k = hash_fn (obj, SCM_LENGTH (table), closure);
-  SCM_ASSERT ((0 <= k) && (k < SCM_LENGTH (table)),
-             scm_ulong2num (k),
-             SCM_OUTOFRANGE,
-             "hash_fn_remove_x");
+  if (k >= SCM_LENGTH (table))
+    scm_out_of_range ("hash_fn_remove_x", scm_ulong2num (k));
   h = assoc_fn (obj, SCM_VELTS (table)[k], closure);
   SCM_VELTS(table)[k] = delete_fn (h, SCM_VELTS(table)[k]);
   return h;
index 862b55a..712debd 100644 (file)
@@ -164,7 +164,8 @@ make_hook (SCM n_args, const char *subr)
     {
       SCM_ASSERT (SCM_INUMP (n_args), n_args, SCM_ARGn, subr);
       n = SCM_INUM (n_args);
-      SCM_ASSERT (n >= 0 && n <= 16, n_args, SCM_OUTOFRANGE, subr);
+      if (n < 0 || n > 16)
+       scm_out_of_range (subr, n_args);
     }
   SCM_RETURN_NEWSMOB (scm_tc16_hook + (n << 16), SCM_EOL);
 }
index 25aac03..cabdba4 100644 (file)
@@ -346,44 +346,55 @@ SCM_DEFINE (scm_reverse_x, "reverse!", 1, 1, 0,
 }
 #undef FUNC_NAME
 
-
 \f
+
 /* indexing lists by element number */
 
 SCM_DEFINE (scm_list_ref, "list-ref", 2, 0, 0,
-           (SCM lst, SCM k),
-           "Return the Kth element from list LST.")
+           (SCM list, SCM k),
+           "Return the Kth element from LIST.")
 #define FUNC_NAME s_scm_list_ref
 {
-  register long i;
+  SCM lst = list;
+  unsigned long int i;
   SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
-  while (i-- > 0) {
-    SCM_ASRTGO(SCM_CONSP(lst), erout);
-    lst = SCM_CDR(lst);
-  }
- erout:        
-  SCM_ASSERT(SCM_CONSP(lst),
-             SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, FUNC_NAME);
-  return SCM_CAR(lst);
+  while (SCM_CONSP (lst)) {
+    if (i == 0)
+      return SCM_CAR (lst);
+    else {
+      --i;
+      lst = SCM_CDR (lst);
+    }
+  };
+  if (SCM_NULLP (lst))
+    SCM_OUT_OF_RANGE (2, k);
+  else
+    SCM_WRONG_TYPE_ARG (1, list);
 }
 #undef FUNC_NAME
 
+
 SCM_DEFINE (scm_list_set_x, "list-set!", 3, 0, 0,
-           (SCM lst, SCM k, SCM val),
-           "Set the @var{k}th element of @var{lst} to @var{val}.")
+           (SCM list, SCM k, SCM val),
+           "Set the @var{k}th element of @var{list} to @var{val}.")
 #define FUNC_NAME s_scm_list_set_x
 {
-  register long i;
+  SCM lst = list;
+  unsigned long int i;
   SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
-  while (i-- > 0) {
-    SCM_ASRTGO(SCM_CONSP(lst), erout);
-    lst = SCM_CDR(lst);
-  }
- erout:        
-  SCM_ASSERT(SCM_CONSP(lst),
-             SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, FUNC_NAME);
-  SCM_SETCAR (lst, val);
-  return val;
+  while (SCM_CONSP (lst)) {
+    if (i == 0) {
+      SCM_SETCAR (lst, val);
+      return val;
+    } else {
+      --i;
+      lst = SCM_CDR (lst);
+    }
+  };
+  if (SCM_NULLP (lst))
+    SCM_OUT_OF_RANGE (2, k);
+  else
+    SCM_WRONG_TYPE_ARG (1, list);
 }
 #undef FUNC_NAME
 
@@ -411,21 +422,26 @@ SCM_DEFINE (scm_list_tail, "list-tail", 2, 0, 0,
 
 
 SCM_DEFINE (scm_list_cdr_set_x, "list-cdr-set!", 3, 0, 0,
-           (SCM lst, SCM k, SCM val),
-           "Set the @var{k}th cdr of @var{lst} to @var{val}.")
+           (SCM list, SCM k, SCM val),
+           "Set the @var{k}th cdr of @var{list} to @var{val}.")
 #define FUNC_NAME s_scm_list_cdr_set_x
 {
-  register long i;
+  SCM lst = list;
+  unsigned long int i;
   SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
-  while (i-- > 0) {
-    SCM_ASRTGO(SCM_CONSP(lst), erout);
-    lst = SCM_CDR(lst);
-  }
-erout:
-  SCM_ASSERT(SCM_CONSP(lst),
-             SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, FUNC_NAME);
-  SCM_SETCDR (lst, val);
-  return val;
+  while (SCM_CONSP (lst)) {
+    if (i == 0) {
+      SCM_SETCDR (lst, val);
+      return val;
+    } else {
+      --i;
+      lst = SCM_CDR (lst);
+    }
+  };
+  if (SCM_NULLP (lst))
+    SCM_OUT_OF_RANGE (2, k);
+  else
+    SCM_WRONG_TYPE_ARG (1, list);
 }
 #undef FUNC_NAME
 
index a20607d..44ae621 100644 (file)
@@ -278,7 +278,6 @@ SCM_DEFINE (scm_string_set_x, "string-set!", 3, 0, 0,
 #undef FUNC_NAME
 
 
-
 SCM_DEFINE (scm_substring, "substring", 2, 1, 0,
            (SCM str, SCM start, SCM end),
            "Returns a newly allocated string formed from the characters\n"
@@ -288,18 +287,23 @@ SCM_DEFINE (scm_substring, "substring", 2, 1, 0,
             "0 <= START <= END <= (string-length STR).")
 #define FUNC_NAME s_scm_substring
 {
-  long l;
+  long int from;
+  long int to;
+
   SCM_VALIDATE_ROSTRING (1,str);
-  SCM_VALIDATE_INUM (2,start);
+  SCM_VALIDATE_INUM (2, start);
   SCM_VALIDATE_INUM_DEF (3,end,SCM_ROLENGTH(str));
-  SCM_ASSERT_RANGE (2,start,SCM_INUM (start) <= SCM_ROLENGTH (str));
-  SCM_ASSERT_RANGE (2,end,SCM_INUM (end) <= SCM_ROLENGTH (str));
-  l = SCM_INUM (end)-SCM_INUM (start);
-  SCM_ASSERT (l >= 0, SCM_MAKINUM (l), SCM_OUTOFRANGE, FUNC_NAME);
-  return scm_makfromstr (&SCM_ROCHARS (str)[SCM_INUM (start)], (scm_sizet)l, 0);
+
+  from = SCM_INUM (start);
+  SCM_ASSERT_RANGE (2, start, 0 <= from && from <= SCM_ROLENGTH (str));
+  to = SCM_INUM (end);
+  SCM_ASSERT_RANGE (3, end, from <= to && to <= SCM_ROLENGTH (str));
+
+  return scm_makfromstr (&SCM_ROCHARS (str)[from], (scm_sizet) (to - from), 0);
 }
 #undef FUNC_NAME
 
+
 SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1, 
             (SCM args),
            "Returns a newly allocated string whose characters form the\n"
index 19f7ace..cc02915 100644 (file)
@@ -480,7 +480,8 @@ scm_aind (SCM ra, SCM args, const char *what)
       args = SCM_CDR (args);
       SCM_ASSERT (SCM_INUMP (ind), ind, s_bad_ind, what);
       j = SCM_INUM (ind);
-      SCM_ASSERT (j >= (s->lbnd) && j <= (s->ubnd), ind, SCM_OUTOFRANGE, what);
+      if (j < s->lbnd || j > s->ubnd)
+       scm_out_of_range (what, ind);
       pos += (j - s->lbnd) * (s->inc);
       k--;
       s++;
@@ -831,8 +832,8 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
                  scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL);
       SCM_ASSERT (SCM_INUMP (SCM_CAR (args)), SCM_CAR (args), SCM_ARG2,
                  FUNC_NAME);
-      SCM_ASSERT (SCM_EQ_P (SCM_INUM0, SCM_CAR (args)), SCM_CAR (args), SCM_OUTOFRANGE,
-                 FUNC_NAME);
+      SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args), 
+                       SCM_EQ_P (SCM_INUM0, SCM_CAR (args)));
       return ra;
     case scm_tc7_smob:
       SCM_ASRTGO (SCM_ARRAYP (ra), badarg);
@@ -846,8 +847,8 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
          SCM_ASSERT (SCM_INUMP (ve[k]), ve[k], (SCM_ARG2 + k),
                      FUNC_NAME);
          i = SCM_INUM (ve[k]);
-         SCM_ASSERT (i >= 0 && i < SCM_ARRAY_NDIM (ra), ve[k],
-                     SCM_OUTOFRANGE, FUNC_NAME);
+         if (i < 0 || i >= SCM_ARRAY_NDIM (ra))
+           scm_out_of_range (FUNC_NAME, ve[k]);
          if (ndim < i)
            ndim = i;
        }
@@ -1770,8 +1771,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
   register unsigned long w;
   SCM_VALIDATE_NIM (2,v);
   SCM_VALIDATE_INUM_COPY (3,k,pos);
-  SCM_ASSERT ((pos <= SCM_LENGTH (v)) && (pos >= 0),
-         k, SCM_OUTOFRANGE, FUNC_NAME);
+  SCM_ASSERT_RANGE (3, k, (pos <= SCM_LENGTH (v)) && (pos >= 0));
   if (pos == SCM_LENGTH (v))
     return SCM_BOOL_F;
   switch SCM_TYP7 (v)
@@ -1856,14 +1856,16 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
            for (i = SCM_LENGTH (kv); i;)
              {
                k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
-               SCM_ASSERT ((k < vlen), SCM_MAKINUM (k), SCM_OUTOFRANGE, FUNC_NAME);
+               if (k >= vlen)
+                 scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
                SCM_BITVEC_CLR(v,k);
              }
          else if (SCM_EQ_P (obj, SCM_BOOL_T))
            for (i = SCM_LENGTH (kv); i;)
              {
                k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
-               SCM_ASSERT ((k < vlen), SCM_MAKINUM (k), SCM_OUTOFRANGE, FUNC_NAME);
+               if (k >= vlen)
+                 scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
                SCM_BITVEC_SET(v,k);
              }
          else
@@ -1920,7 +1922,8 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
            for (i = SCM_LENGTH (kv); i;)
              {
                k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
-               SCM_ASSERT ((k < vlen), SCM_MAKINUM (k), SCM_OUTOFRANGE, FUNC_NAME);
+               if (k >= vlen)
+                 scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
                if (!SCM_BITVEC_REF(v,k))
                  count++;
              }
@@ -1928,7 +1931,8 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
            for (i = SCM_LENGTH (kv); i;)
              {
                k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
-               SCM_ASSERT ((k < vlen), SCM_MAKINUM (k), SCM_OUTOFRANGE, FUNC_NAME);
+               if (k >= vlen)
+                 scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
                if (SCM_BITVEC_REF (v,k))
                  count++;
              }
index 2ffe130..1c59b96 100644 (file)
@@ -200,15 +200,16 @@ SCM_GPROC (s_vector_ref, "vector-ref", 2, 0, 0, scm_vector_ref, g_vector_ref);
 
 SCM
 scm_vector_ref (SCM v, SCM k)
+#define FUNC_NAME s_vector_ref
 {
   SCM_GASSERT2 (SCM_VECTORP (v),
                g_vector_ref, v, k, SCM_ARG1, s_vector_ref);
   SCM_GASSERT2 (SCM_INUMP (k),
                g_vector_ref, v, k, SCM_ARG2, s_vector_ref);
-  SCM_ASSERT (SCM_INUM (k) < SCM_LENGTH (v) && SCM_INUM (k) >= 0,
-              k, SCM_OUTOFRANGE, s_vector_ref);
+  SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_LENGTH (v) && SCM_INUM (k) >= 0);
   return SCM_VELTS (v)[(long) SCM_INUM (k)];
 }
+#undef FUNC_NAME
 
 SCM_GPROC (s_vector_set_x, "vector-set!", 3, 0, 0, scm_vector_set_x, g_vector_set_x);
 
@@ -233,6 +234,7 @@ The value returned by @samp{vector-set!} is unspecified.
 
 SCM
 scm_vector_set_x (SCM v, SCM k, SCM obj)
+#define FUNC_NAME s_vector_set_x
 {
   SCM_GASSERTn (SCM_VECTORP (v),
                g_vector_set_x, SCM_LIST3 (v, k, obj),
@@ -240,11 +242,11 @@ scm_vector_set_x (SCM v, SCM k, SCM obj)
   SCM_GASSERTn (SCM_INUMP (k),
                g_vector_set_x, SCM_LIST3 (v, k, obj),
                SCM_ARG2, s_vector_set_x);
-  SCM_ASSERT ((SCM_INUM (k) < SCM_LENGTH (v)) && (SCM_INUM (k) >= 0),
-             k, SCM_OUTOFRANGE, s_vector_set_x);
+  SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_LENGTH (v) && SCM_INUM (k) >= 0);
   SCM_VELTS(v)[(long) SCM_INUM(k)] = obj;
   return SCM_UNSPECIFIED;
 }
+#undef FUNC_NAME
 
 
 SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0,
@@ -342,10 +344,10 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0,
   SCM_VALIDATE_INUM_COPY (3,end1,e);
   SCM_VALIDATE_VECTOR (4,vec2);
   SCM_VALIDATE_INUM_COPY (5,start2,j);
-  SCM_ASSERT (i <= SCM_LENGTH (vec1) && i >= 0, start1, SCM_OUTOFRANGE, FUNC_NAME);
-  SCM_ASSERT (j <= SCM_LENGTH (vec2) && j >= 0, start2, SCM_OUTOFRANGE, FUNC_NAME);
-  SCM_ASSERT (e <= SCM_LENGTH (vec1) && e >= 0, end1, SCM_OUTOFRANGE, FUNC_NAME);
-  SCM_ASSERT (e-i+j <= SCM_LENGTH (vec2), start2, SCM_OUTOFRANGE, FUNC_NAME);
+  SCM_ASSERT_RANGE (2, start1, i <= SCM_LENGTH (vec1) && i >= 0);
+  SCM_ASSERT_RANGE (5, start2, j <= SCM_LENGTH (vec2) && j >= 0);
+  SCM_ASSERT_RANGE (3, end1, e <= SCM_LENGTH (vec1) && e >= 0);
+  SCM_ASSERT_RANGE (5, start2, e-i+j <= SCM_LENGTH (vec2));
   while (i<e) SCM_VELTS (vec2)[j++] = SCM_VELTS (vec1)[i++];
   return SCM_UNSPECIFIED;
 }
@@ -365,11 +367,11 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
   SCM_VALIDATE_INUM_COPY (3,end1,e);
   SCM_VALIDATE_VECTOR (4,vec2);
   SCM_VALIDATE_INUM_COPY (5,start2,j);
-  SCM_ASSERT (i <= SCM_LENGTH (vec1) && i >= 0, start1, SCM_OUTOFRANGE, FUNC_NAME);
-  SCM_ASSERT (j <= SCM_LENGTH (vec2) && j >= 0, start2, SCM_OUTOFRANGE, FUNC_NAME);
-  SCM_ASSERT (e <= SCM_LENGTH (vec1) && e >= 0, end1, SCM_OUTOFRANGE, FUNC_NAME);
+  SCM_ASSERT_RANGE (2, start1, i <= SCM_LENGTH (vec1) && i >= 0);
+  SCM_ASSERT_RANGE (5, start2, j <= SCM_LENGTH (vec2) && j >= 0);
+  SCM_ASSERT_RANGE (3, end1, e <= SCM_LENGTH (vec1) && e >= 0);
   j = e - i + j;
-  SCM_ASSERT (j <= SCM_LENGTH (vec2), start2, SCM_OUTOFRANGE, FUNC_NAME);
+  SCM_ASSERT_RANGE (5, start2, j <= SCM_LENGTH (vec2));
   while (i < e)
     SCM_VELTS (vec2)[--j] = SCM_VELTS (vec1)[--e];
   return SCM_UNSPECIFIED;
index a6b768e..9bcf4fe 100644 (file)
@@ -1,3 +1,8 @@
+2000-06-30  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+       * tests/list.test:  Added tests for list-ref, list-set! and
+       list-cdr-set!
+
 2000-06-21  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
        * tests/common-list.test:  Added.
index c3546a6..99e9b3f 100644 (file)
 
 ;;; list-ref
 
+(with-test-prefix "list-ref"
+
+  ;; Is documentation available?
+
+  (pass-if "documented?" (object-documentation list-ref))
+
+  (with-test-prefix "argument error"
+    
+    (with-test-prefix "non list argument"
+      #t)
+
+    (with-test-prefix "improper list argument"
+      #t)
+
+    (with-test-prefix "non integer index"
+      #t)
+
+    (with-test-prefix "index out of range"
+
+      (with-test-prefix "empty list"
+
+       (pass-if "index 0"
+         (catch 'out-of-range
+           (lambda ()
+             (list-ref '() 0)
+             #f)
+           (lambda (key . args)
+             #t)))
+
+       (pass-if "index > 0"
+         (catch 'out-of-range
+           (lambda ()
+             (list-ref '() 1)
+             #f)
+           (lambda (key . args)
+             #t)))
+
+       (pass-if "index < 0"
+         (catch 'out-of-range
+           (lambda ()
+             (list-ref '() -1)
+             #f)
+           (lambda (key . args)
+             #t))))
+
+      (with-test-prefix "non-empty list"
+
+       (pass-if "index > length"
+         (catch 'out-of-range
+           (lambda ()
+             (list-ref '(1) 1)
+             #f)
+           (lambda (key . args)
+             #t)))
+
+       (pass-if "index < 0"
+         (catch 'out-of-range
+           (lambda ()
+             (list-ref '(1) -1)
+             #f)
+           (lambda (key . args)
+             #t)))))))
+
 
 ;;; list-set!
 
+(with-test-prefix "list-set!"
+
+  ;; Is documentation available?
+
+  (pass-if "documented?" (object-documentation list-set!))
+
+  (with-test-prefix "argument error"
+    
+    (with-test-prefix "non list argument"
+      #t)
+
+    (with-test-prefix "improper list argument"
+      #t)
+
+    (with-test-prefix "read-only list argument"
+      #t)
+
+    (with-test-prefix "non integer index"
+      #t)
+
+    (with-test-prefix "index out of range"
+
+      (with-test-prefix "empty list"
+
+       (pass-if "index 0"
+         (catch 'out-of-range
+           (lambda ()
+             (list-set! (list) 0 #t)
+             #f)
+           (lambda (key . args)
+             #t)))
+
+       (pass-if "index > 0"
+         (catch 'out-of-range
+           (lambda ()
+             (list-set! (list) 1 #t)
+             #f)
+           (lambda (key . args)
+             #t)))
+
+       (pass-if "index < 0"
+         (catch 'out-of-range
+           (lambda ()
+             (list-set! (list) -1 #t)
+             #f)
+           (lambda (key . args)
+             #t))))
+
+      (with-test-prefix "non-empty list"
+
+       (pass-if "index > length"
+         (catch 'out-of-range
+           (lambda ()
+             (list-set! (list 1) 1 #t)
+             #f)
+           (lambda (key . args)
+             #t)))
+
+       (pass-if "index < 0"
+         (catch 'out-of-range
+           (lambda ()
+             (list-set! (list 1) -1 #t)
+             #f)
+           (lambda (key . args)
+             #t)))))))
+
 
 ;;; list-cdr-ref
 
 
 ;;; list-cdr-set!
 
+(with-test-prefix "list-cdr-set!"
+
+  ;; Is documentation available?
+
+  (pass-if "documented?" (object-documentation list-cdr-set!))
+
+  (with-test-prefix "argument error"
+    
+    (with-test-prefix "non list argument"
+      #t)
+
+    (with-test-prefix "improper list argument"
+      #t)
+
+    (with-test-prefix "read-only list argument"
+      #t)
+
+    (with-test-prefix "non integer index"
+      #t)
+
+    (with-test-prefix "index out of range"
+
+      (with-test-prefix "empty list"
+
+       (pass-if "index 0"
+         (catch 'out-of-range
+           (lambda ()
+             (list-cdr-set! (list) 0 #t)
+             #f)
+           (lambda (key . args)
+             #t)))
+
+       (pass-if "index > 0"
+         (catch 'out-of-range
+           (lambda ()
+             (list-cdr-set! (list) 1 #t)
+             #f)
+           (lambda (key . args)
+             #t)))
+
+       (pass-if "index < 0"
+         (catch 'out-of-range
+           (lambda ()
+             (list-cdr-set! (list) -1 #t)
+             #f)
+           (lambda (key . args)
+             #t))))
+
+      (with-test-prefix "non-empty list"
+
+       (pass-if "index > length"
+         (catch 'out-of-range
+           (lambda ()
+             (list-cdr-set! (list 1) 1 #t)
+             #f)
+           (lambda (key . args)
+             #t)))
+
+       (pass-if "index < 0"
+         (catch 'out-of-range
+           (lambda ()
+             (list-cdr-set! (list 1) -1 #t)
+             #f)
+           (lambda (key . args)
+             #t)))))))
+
 
 ;;; list-head