+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
@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
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)
+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,
/* SCM_WNA must follow the last SCM_ARGn in sequence.
*/
#define SCM_WNA 8
-#define SCM_OUTOFRANGE 10
#endif /* SCM_MAGIC_SNARFER */
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);
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;
}
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))
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;
{
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);
}
}
#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
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
#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"
"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"
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++;
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);
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;
}
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)
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
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++;
}
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++;
}
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);
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),
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,
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;
}
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;
+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.
;;; 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