dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* Eliminated use of SCM_ASSERT to check for range errors.

Browse source 
* Fix some error reporting code in list.c
* Added some test cases.
This commit is contained in:
Dirk Herrmann 2000-06-30 10:46:35 +00:00
commit 685c0d7116
13 changed files with 339 additions and 89 deletions
Download patch file Download diff file Expand all files Collapse all files

4
doc/ChangeLog
View 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

7
doc/data-rep.texi
View 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)

33
libguile/ChangeLog
View 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,

1
libguile/__scm.h
View 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 */

2
libguile/error.c
View 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);

18
libguile/hashtab.c
View 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;

3
libguile/hooks.c
View 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);
}

88
libguile/list.c
View file

@ -346,44 +346,55 @@ SCM_DEFINE (scm_reverse_x, "reverse!", 1, 1, 0,
}
#undef FUNC_NAME
/* 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

20
libguile/strings.c
View 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"

26
libguile/unif.c
View 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++;
}

26
libguile/vectors.c
View 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;

5
test-suite/ChangeLog
View 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.

195
test-suite/tests/list.test
View file

@ -451,9 +451,138 @@
;;; 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
@ -463,6 +592,72 @@
;;; 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