diff options
-rw-r--r-- | NEWS | 10 | ||||
-rw-r--r-- | RELEASE | 5 | ||||
-rw-r--r-- | libguile/ChangeLog | 28 | ||||
-rw-r--r-- | libguile/__scm.h | 24 | ||||
-rw-r--r-- | libguile/error.c | 11 | ||||
-rw-r--r-- | libguile/error.h | 2 | ||||
-rw-r--r-- | libguile/numbers.c | 2 | ||||
-rw-r--r-- | libguile/read.c | 3 | ||||
-rw-r--r-- | libguile/unif.c | 88 | ||||
-rw-r--r-- | libguile/validate.h | 52 |
10 files changed, 140 insertions, 85 deletions
@@ -572,7 +572,9 @@ SCM_SUBSTRP, SCM_SUBSTR_STR, SCM_SUBSTR_OFFSET, SCM_COERCE_SUBSTR, SCM_ROSTRINGP, SCM_RWSTRINGP, SCM_VALIDATE_RWSTRING, SCM_ROCHARS, SCM_ROUCHARS, SCM_SETLENGTH, SCM_SETCHARS, SCM_LENGTH_MAX, SCM_GC8MARKP, SCM_SETGC8MARK, SCM_CLRGC8MARK, SCM_GCTYP16, SCM_GCCDR, SCM_SUBR_DOC, -SCM_OPDIRP, SCM_VALIDATE_OPDIR, SCM_WTA, RETURN_SCM_WTA, SCM_CONST_LONG +SCM_OPDIRP, SCM_VALIDATE_OPDIR, SCM_WTA, RETURN_SCM_WTA, SCM_CONST_LONG, +SCM_WNA, SCM_FUNC_NAME, SCM_VALIDATE_NUMBER_COPY, +SCM_VALIDATE_NUMBER_DEF_COPY Use SCM_ASSERT_RANGE or SCM_VALIDATE_XXX_RANGE instead of SCM_OUTOFRANGE. Use scm_memory_error instead of SCM_NALLOC. @@ -600,6 +602,7 @@ Use SCM_DIR_OPEN_P instead of SCM_OPDIRP. Use SCM_MISC_ERROR or SCM_WRONG_TYPE_ARG instead of SCM_WTA. Use SCM_MISC_ERROR or SCM_WRONG_TYPE_ARG instead of RETURN_SCM_WTA. Use SCM_VCELL_INIT instead of SCM_CONST_LONG. +Use SCM_WRONG_NUM_ARGS instead of SCM_WNA. ** Removed function: scm_struct_init @@ -646,6 +649,11 @@ This can be used to set an apply function to a smob type. Use scm_object_to_string instead. +** Deprecated function: scm_wta + +Use scm_wrong_type_arg, or another appropriate error signalling function +instead. + Changes since Guile 1.3.4: @@ -59,7 +59,9 @@ In release 1.6: SCM_COERCE_SUBSTR, SCM_ROSTRINGP, SCM_RWSTRINGP, SCM_VALIDATE_RWSTRING, SCM_ROCHARS, SCM_ROUCHARS, SCM_SETLENGTH, SCM_SETCHARS, SCM_LENGTH_MAX, SCM_GC8MARKP, SCM_SETGC8MARK, SCM_CLRGC8MARK, SCM_GCTYP16, SCM_GCCDR, - SCM_SUBR_DOC, SCM_OPDIRP, SCM_VALIDATE_OPDIR, SCM_WTA, RETURN_SCM_WTA + SCM_SUBR_DOC, SCM_OPDIRP, SCM_VALIDATE_OPDIR, SCM_WTA, RETURN_SCM_WTA, + SCM_WNA, SCM_FUNC_NAME, SCM_VALIDATE_NUMBER_COPY, + SCM_VALIDATE_NUMBER_DEF_COPY - remove scm_vector_set_length_x - remove function scm_call_catching_errors (replaced by catch functions from throw.[ch]) @@ -80,6 +82,7 @@ In release 1.6: - remove scm_close_all_ports_except - remove scm_strprint_obj - remove SCM_CONST_LONG +- remove scm_wta Modules sort.c and random.c should be factored out into separate modules (but still be distributed with guile-core) when we get a new diff --git a/libguile/ChangeLog b/libguile/ChangeLog index bbf67e72e..b6e4a09fc 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,33 @@ 2001-03-17 Dirk Herrmann <D.Herrmann@tu-bs.de> + * __scm.h (SCM_ASSERT, SCM_WTA_DISPATCH_0, SCM_WTA_DISPATCH_1, + SCM_WTA_DISPATCH_2, SCM_WTA_DISPATCH_n): Don't call scm_wta, call + scm_wrong_type_arg instead. + + (SCM_WNA): Deprecated. + + * error.[ch] (scm_wta): Deprecated. + + * numbers.c (s_i_log): Minor comment fix. + + * read.c (scm_lreadr), unif.c (scm_aind, scm_shap2ra, + scm_make_shared_array, scm_transpose_array, scm_enclose_array, + scm_array_in_bounds_p): Don't use SCM_ASSERT to check for + wrong-num-args or misc errors. + + * unif.c (scm_make_shared_array, scm_transpose_array, + scm_enclose_array, scm_array_in_bounds_p, scm_array_set_x): + Validate the rest argument (note: this is only done when guile is + built with SCM_DEBUG_REST_ARGUMENT=1) + + (scm_array_in_bounds_p, scm_uniform_vector_ref, scm_array_set_x): + Replace calls to scm_wrong_num_args by SCM_WRONG_NUM_ARGS. + + * validate.h (SCM_FUNC_NAME, SCM_VALIDATE_NUMBER_COPY, + SCM_VALIDATE_NUMBER_DEF_COPY): Deprecated. + +2001-03-17 Dirk Herrmann <D.Herrmann@tu-bs.de> + * validate.h (SCM_WRONG_NUM_ARGS): Call scm_error_num_args_subr instead of scm_wrong_num_args. diff --git a/libguile/__scm.h b/libguile/__scm.h index d48ae66d6..97d0a903a 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -2,7 +2,7 @@ #ifndef __SCMH #define __SCMH -/* Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -488,7 +488,7 @@ do { \ #else #define SCM_ASSERT(_cond, _arg, _pos, _subr) \ if (!(_cond)) \ - scm_wta(_arg, (char *)(_pos), _subr) + scm_wrong_type_arg (_subr, _pos, _arg) #define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr, _msg) \ if (!(_cond)) \ scm_wrong_type_arg_msg(_subr, _pos, _arg, _msg) @@ -511,7 +511,7 @@ extern SCM scm_call_generic_0 (SCM gf); #define SCM_WTA_DISPATCH_0(gf, arg, pos, subr) \ return (SCM_UNPACK (gf) \ ? scm_call_generic_0 ((gf)) \ - : scm_wta ((arg), (char *) (pos), (subr))) + : scm_wrong_type_arg ((subr), (pos), (arg)), 0) #define SCM_GASSERT0(cond, gf, arg, pos, subr) \ if (!(cond)) SCM_WTA_DISPATCH_0((gf), (arg), (pos), (subr)) @@ -520,7 +520,7 @@ extern SCM scm_call_generic_1 (SCM gf, SCM a1); #define SCM_WTA_DISPATCH_1(gf, a1, pos, subr) \ return (SCM_UNPACK (gf) \ ? scm_call_generic_1 ((gf), (a1)) \ - : scm_wta ((a1), (char *) (pos), (subr))) + : scm_wrong_type_arg ((subr), (pos), (a1)), 0) #define SCM_GASSERT1(cond, gf, a1, pos, subr) \ if (!(cond)) SCM_WTA_DISPATCH_1((gf), (a1), (pos), (subr)) @@ -529,7 +529,8 @@ extern SCM scm_call_generic_2 (SCM gf, SCM a1, SCM a2); #define SCM_WTA_DISPATCH_2(gf, a1, a2, pos, subr) \ return (SCM_UNPACK (gf) \ ? scm_call_generic_2 ((gf), (a1), (a2)) \ - : scm_wta ((pos) == SCM_ARG1 ? (a1) : (a2), (char *) (pos), (subr))) + : scm_wrong_type_arg ((subr), (pos), \ + (pos) == SCM_ARG1 ? (a1) : (a2)), 0) #define SCM_GASSERT2(cond, gf, a1, a2, pos, subr) \ if (!(cond)) SCM_WTA_DISPATCH_2((gf), (a1), (a2), (pos), (subr)) @@ -538,9 +539,9 @@ extern SCM scm_apply_generic (SCM gf, SCM args); #define SCM_WTA_DISPATCH_n(gf, args, pos, subr) \ return (SCM_UNPACK (gf) \ ? scm_apply_generic ((gf), (args)) \ - : scm_wta (scm_list_ref ((args), SCM_MAKINUM ((pos) - 1)), \ - (char *) (pos), \ - (subr))) + : scm_wrong_type_arg ((subr), (pos), \ + scm_list_ref ((args), \ + SCM_MAKINUM ((pos) - 1))), 0) #define SCM_GASSERTn(cond, gf, args, pos, subr) \ if (!(cond)) SCM_WTA_DISPATCH_n((gf), (args), (pos), (subr)) @@ -562,12 +563,11 @@ extern SCM scm_apply_generic (SCM gf, SCM args); #define SCM_ARG6 6 #define SCM_ARG7 7 -/* SCM_WNA must follow the last SCM_ARGn in sequence. - */ -#define SCM_WNA 8 - #if (SCM_DEBUG_DEPRECATED == 0) +/* Use SCM_WRONG_NUM_ARGS instead of: */ +#define SCM_WNA 8 + /* Use SCM_ASSERT_RANGE or SCM_VALIDATE_XXX_RANGE instead of: */ #define SCM_OUTOFRANGE 10 diff --git a/libguile/error.c b/libguile/error.c index 7d8b30900..9073e2afe 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -314,7 +314,8 @@ scm_misc_error (const char *subr, const char *message, SCM args) scm_error (scm_misc_error_key, subr, message, args, SCM_BOOL_F); } -/* implements the SCM_ASSERT interface. */ +#if (SCM_DEBUG_DEPRECATED == 0) + SCM scm_wta (SCM arg, const char *pos, const char *s_subr) { @@ -350,16 +351,10 @@ 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); - -#if (SCM_DEBUG_DEPRECATED == 0) - case SCM_OUTOFRANGE: scm_out_of_range (s_subr, arg); case SCM_NALLOC: scm_memory_error (s_subr); - -#endif /* SCM_DEBUG_DEPRECATED == 0 */ - default: /* this shouldn't happen. */ scm_misc_error (s_subr, "Unknown error", SCM_EOL); @@ -368,6 +363,8 @@ scm_wta (SCM arg, const char *pos, const char *s_subr) return SCM_UNSPECIFIED; } +#endif /* SCM_DEBUG_DEPRECATED == 0 */ + void scm_init_error () { diff --git a/libguile/error.h b/libguile/error.h index 180e70d3f..ea7d8d2fc 100644 --- a/libguile/error.h +++ b/libguile/error.h @@ -81,7 +81,6 @@ extern void scm_wrong_type_arg_msg (const char *subr, int pos, extern void scm_memory_error (const char *subr) SCM_NORETURN; extern void scm_misc_error (const char *subr, const char *message, SCM args) SCM_NORETURN; -extern SCM scm_wta (SCM arg, const char *pos, const char *s_subr); extern void scm_init_error (void); @@ -89,6 +88,7 @@ extern void scm_init_error (void); #if (SCM_DEBUG_DEPRECATED == 0) extern void scm_sysmissing (const char *subr) SCM_NORETURN; +extern SCM scm_wta (SCM arg, const char *pos, const char *s_subr); #endif /* SCM_DEBUG_DEPRECATED == 0 */ diff --git a/libguile/numbers.c b/libguile/numbers.c index 335c5c233..37dcb106e 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -4000,7 +4000,7 @@ SCM_GPROC1 (s_i_exp, "$exp", scm_tc7_cxr, (SCM (*)()) exp, g_i_exp); /* "Return the @var{x}th power of e." */ SCM_GPROC1 (s_i_log, "$log", scm_tc7_cxr, (SCM (*)()) log, g_i_log); -/* "Return the natural logarithm of the real number@var{x}." +/* "Return the natural logarithm of the real number @var{x}." */ SCM_GPROC1 (s_i_sin, "$sin", scm_tc7_cxr, (SCM (*)()) sin, g_i_sin); /* "Return the sine of the real number @var{x}." diff --git a/libguile/read.c b/libguile/read.c index a3ad5daea..578e35330 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -445,7 +445,8 @@ tryagain_no_flush_ws: j = 0; while ('"' != (c = scm_getc (port))) { - SCM_ASSERT (EOF != c, SCM_UNDEFINED, "end of file in ", "string"); + if (c == EOF) + SCM_MISC_ERROR ("end of file in string constant", SCM_EOL); while (j + 2 >= SCM_STRING_LENGTH (*tok_buf)) scm_grow_tok_buf (tok_buf); diff --git a/libguile/unif.c b/libguile/unif.c index f45236078..eb2fcb409 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998, 2000, 2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -485,6 +485,7 @@ static char s_bad_ind[] = "Bad scm_array index"; long scm_aind (SCM ra, SCM args, const char *what) +#define FUNC_NAME what { SCM ind; register long j; @@ -493,14 +494,16 @@ scm_aind (SCM ra, SCM args, const char *what) scm_array_dim *s = SCM_ARRAY_DIMS (ra); if (SCM_INUMP (args)) { - SCM_ASSERT (1 == k, scm_makfrom0str (what), SCM_WNA, NULL); + if (k != 1) + scm_error_num_args_subr (what); return pos + (SCM_INUM (args) - s->lbnd) * (s->inc); } while (k && SCM_NIMP (args)) { ind = SCM_CAR (args); args = SCM_CDR (args); - SCM_ASSERT (SCM_INUMP (ind), ind, s_bad_ind, what); + if (!SCM_INUMP (ind)) + scm_misc_error (what, s_bad_ind, SCM_EOL); j = SCM_INUM (ind); if (j < s->lbnd || j > s->ubnd) scm_out_of_range (what, ind); @@ -508,11 +511,12 @@ scm_aind (SCM ra, SCM args, const char *what) k--; s++; } - SCM_ASSERT (0 == k && SCM_NULLP (args), scm_makfrom0str (what), SCM_WNA, - NULL); + if (k != 0 || !SCM_NULLP (args)) + scm_error_num_args_subr (what); + return pos; } - +#undef FUNC_NAME SCM @@ -539,7 +543,9 @@ scm_shap2ra (SCM args, const char *what) scm_array_dim *s; SCM ra, spec, sp; int ndim = scm_ilength (args); - SCM_ASSERT (0 <= ndim, args, s_bad_spec, what); + if (ndim < 0) + scm_misc_error (what, s_bad_spec, SCM_EOL); + ra = scm_make_ra (ndim); SCM_ARRAY_BASE (ra) = 0; s = SCM_ARRAY_DIMS (ra); @@ -548,20 +554,22 @@ scm_shap2ra (SCM args, const char *what) spec = SCM_CAR (args); if (SCM_INUMP (spec)) { - SCM_ASSERT (SCM_INUM (spec) >= 0, spec, s_bad_spec, what); + if (SCM_INUM (spec) < 0) + scm_misc_error (what, s_bad_spec, SCM_EOL); s->lbnd = 0; s->ubnd = SCM_INUM (spec) - 1; s->inc = 1; } else { - SCM_ASSERT (SCM_CONSP (spec) && SCM_INUMP (SCM_CAR (spec)), spec, - s_bad_spec, what); + if (!SCM_CONSP (spec) || !SCM_INUMP (SCM_CAR (spec))) + scm_misc_error (what, s_bad_spec, SCM_EOL); s->lbnd = SCM_INUM (SCM_CAR (spec)); sp = SCM_CDR (spec); - SCM_ASSERT (SCM_CONSP (sp) - && SCM_INUMP (SCM_CAR (sp)) && SCM_NULLP (SCM_CDR (sp)), - spec, s_bad_spec, what); + if (!SCM_CONSP (sp) + || !SCM_INUMP (SCM_CAR (sp)) + || !SCM_NULLP (SCM_CDR (sp))) + scm_misc_error (what, s_bad_spec, SCM_EOL); s->ubnd = SCM_INUM (SCM_CAR (sp)); s->inc = 1; } @@ -670,6 +678,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, scm_sizet i, k; long old_min, new_min, old_max, new_max; scm_array_dim *s; + + SCM_VALIDATE_REST_ARGUMENT (dims); SCM_VALIDATE_ARRAY (1,oldra); SCM_VALIDATE_PROC (2,mapfunc); ra = scm_shap2ra (dims, FUNC_NAME); @@ -715,8 +725,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, if (SCM_NINUMP (imap)) { - SCM_ASSERT (1 == scm_ilength (imap) && SCM_INUMP (SCM_CAR (imap)), - imap, s_bad_ind, FUNC_NAME); + if (scm_ilength (imap) != 1 || !SCM_INUMP (SCM_CAR (imap))) + SCM_MISC_ERROR (s_bad_ind, SCM_EOL); imap = SCM_CAR (imap); } i = SCM_INUM (imap); @@ -736,10 +746,9 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, else { if (SCM_NINUMP (imap)) - { - SCM_ASSERT (1 == scm_ilength (imap) && SCM_INUMP (SCM_CAR (imap)), - imap, s_bad_ind, FUNC_NAME); + if (scm_ilength (imap) != 1 || !SCM_INUMP (SCM_CAR (imap))) + SCM_MISC_ERROR (s_bad_ind, SCM_EOL); imap = SCM_CAR (imap); } s[k].inc = (long) SCM_INUM (imap) - i; @@ -754,8 +763,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, s[k].inc = new_max - new_min + 1; /* contiguous by default */ indptr = SCM_CDR (indptr); } - SCM_ASSERT (old_min <= new_min && old_max >= new_max, SCM_UNDEFINED, - "mapping out of range", FUNC_NAME); + if (old_min > new_min || old_max < new_max) + SCM_MISC_ERROR ("mapping out of range", SCM_EOL); if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra)) { SCM v = SCM_ARRAY_V (ra); @@ -797,6 +806,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, scm_array_dim *s, *r; int ndim, i, k; + SCM_VALIDATE_REST_ARGUMENT (args); SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, FUNC_NAME); switch (SCM_TYP7 (ra)) { @@ -814,19 +824,18 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, #ifdef HAVE_LONG_LONGS case scm_tc7_llvect: #endif - SCM_ASSERT (!SCM_NULLP (args) && SCM_NULLP (SCM_CDR (args)), - scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL); - SCM_ASSERT (SCM_INUMP (SCM_CAR (args)), SCM_CAR (args), SCM_ARG2, - FUNC_NAME); + if (SCM_NULLP (args) || !SCM_NULLP (SCM_CDR (args))) + SCM_WRONG_NUM_ARGS (); + SCM_VALIDATE_INUM (SCM_ARG2, SCM_CAR (args)); 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); vargs = scm_vector (args); - SCM_ASSERT (SCM_VECTOR_LENGTH (vargs) == SCM_ARRAY_NDIM (ra), - scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL); - ve = SCM_VELTS (vargs); + if (SCM_VECTOR_LENGTH (vargs) != SCM_ARRAY_NDIM (ra)) + SCM_WRONG_NUM_ARGS (); + ve = SCM_VELTS (vargs); ndim = 0; for (k = 0; k < SCM_ARRAY_NDIM (ra); k++) { @@ -871,7 +880,8 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, r->inc += s->inc; } } - SCM_ASSERT (ndim <= 0, args, "bad argument list", FUNC_NAME); + if (ndim > 0) + SCM_MISC_ERROR ("bad argument list", SCM_EOL); scm_ra_set_contp (res); return res; } @@ -905,10 +915,12 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, scm_array_dim vdim, *s = &vdim; int ndim, j, k, ninr, noutr; + SCM_VALIDATE_REST_ARGUMENT (axes); if (SCM_NULLP (axes)) axes = scm_cons ((SCM_ARRAYP (ra) ? SCM_MAKINUM (SCM_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL); ninr = scm_ilength (axes); - SCM_ASSERT (0 <= ninr, scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL); + if (ninr < 0) + SCM_WRONG_NUM_ARGS (); ra_inr = scm_make_ra (ninr); SCM_ASRTGO (SCM_NIMP (ra), badarg1); switch SCM_TYP7 (ra) @@ -945,14 +957,16 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, break; } noutr = ndim - ninr; + if (noutr < 0) + SCM_WRONG_NUM_ARGS (); axv = scm_make_string (SCM_MAKINUM (ndim), SCM_MAKE_CHAR (0)); - SCM_ASSERT (0 <= noutr, scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL); res = scm_make_ra (noutr); SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra_inr); SCM_ARRAY_V (res) = ra_inr; for (k = 0; k < ninr; k++, axes = SCM_CDR (axes)) { - SCM_ASSERT (SCM_INUMP (SCM_CAR (axes)), SCM_CAR (axes), "bad axis", FUNC_NAME); + if (!SCM_INUMP (SCM_CAR (axes))) + SCM_MISC_ERROR ("bad axis", SCM_EOL); j = SCM_INUM (SCM_CAR (axes)); SCM_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd; SCM_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd; @@ -986,6 +1000,7 @@ SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1, register long j; scm_array_dim *s; + SCM_VALIDATE_REST_ARGUMENT (args); SCM_ASRTGO (SCM_NIMP (v), badarg1); if (SCM_NIMP (args)) @@ -1000,7 +1015,7 @@ tail: { default: badarg1:SCM_WRONG_TYPE_ARG (1, v); - wna: scm_wrong_num_args (scm_makfrom0str (FUNC_NAME)); + wna: SCM_WRONG_NUM_ARGS (); case scm_tc7_smob: k = SCM_ARRAY_NDIM (v); s = SCM_ARRAY_DIMS (v); @@ -1025,7 +1040,8 @@ tail: ind = SCM_CAR (args); args = SCM_CDR (args); s++; - SCM_ASSERT (SCM_INUMP (ind), ind, s_bad_ind, FUNC_NAME); + if (!SCM_INUMP (ind)) + SCM_MISC_ERROR (s_bad_ind, SCM_EOL); } SCM_ASRTGO (0 == k, wna); v = SCM_ARRAY_V (v); @@ -1104,7 +1120,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, outrng: scm_out_of_range (FUNC_NAME, SCM_MAKINUM (pos)); wna: - scm_wrong_num_args (SCM_FUNC_NAME); + SCM_WRONG_NUM_ARGS (); case scm_tc7_smob: { /* enclosed */ int k = SCM_ARRAY_NDIM (v); @@ -1242,6 +1258,8 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, #define FUNC_NAME s_scm_array_set_x { long pos = 0; + + SCM_VALIDATE_REST_ARGUMENT (args); SCM_ASRTGO (SCM_NIMP (v), badarg1); if (SCM_ARRAYP (v)) { @@ -1273,7 +1291,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, outrng: scm_out_of_range (FUNC_NAME, SCM_MAKINUM (pos)); wna: - scm_wrong_num_args (SCM_FUNC_NAME); + SCM_WRONG_NUM_ARGS (); case scm_tc7_smob: /* enclosed */ goto badarg1; case scm_tc7_bvect: diff --git a/libguile/validate.h b/libguile/validate.h index a75e7eea2..0a147df49 100644 --- a/libguile/validate.h +++ b/libguile/validate.h @@ -1,4 +1,4 @@ -/* $Id: validate.h,v 1.29 2001-03-17 12:20:36 dirk Exp $ */ +/* $Id: validate.h,v 1.30 2001-03-17 13:34:21 dirk Exp $ */ /* Copyright (C) 1999, 2000 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify @@ -45,8 +45,6 @@ #ifndef SCM_VALIDATE_H__ #define SCM_VALIDATE_H__ -#define SCM_FUNC_NAME (scm_makfrom0str (FUNC_NAME)) - #define SCM_SYSERROR do { scm_syserror (FUNC_NAME); } while (0) #define SCM_MEMORY_ERROR do { scm_memory_error (FUNC_NAME); } while (0) @@ -149,29 +147,6 @@ #define SCM_VALIDATE_NUMBER(pos, z) SCM_MAKE_VALIDATE (pos, z, NUMBERP) -#define SCM_VALIDATE_NUMBER_COPY(pos, z, cvar) \ - do { \ - if (SCM_INUMP (z)) \ - cvar = (double) SCM_INUM (z); \ - else if (SCM_REALP (z)) \ - cvar = SCM_REAL_VALUE (z); \ - else if (SCM_BIGP (z)) \ - cvar = scm_big2dbl (z); \ - else \ - { \ - cvar = 0.0; \ - SCM_WRONG_TYPE_ARG (pos, z); \ - } \ - } while (0) - -#define SCM_VALIDATE_NUMBER_DEF_COPY(pos, number, def, cvar) \ - do { \ - if (SCM_UNBNDP (number)) \ - cvar = def; \ - else \ - SCM_VALIDATE_NUMBER_COPY(pos, number, cvar); \ - } while (0) - #define SCM_VALIDATE_INUM(pos, k) SCM_MAKE_VALIDATE (pos, k, INUMP) #define SCM_VALIDATE_INUM_COPY(pos, k, cvar) \ @@ -405,12 +380,37 @@ #if (SCM_DEBUG_DEPRECATED == 0) +#define SCM_FUNC_NAME (scm_makfrom0str (FUNC_NAME)) + #define SCM_WTA(pos, scm) \ do { scm_wta (scm, (char *) pos, FUNC_NAME); } while (0) #define RETURN_SCM_WTA(pos, scm) \ do { return scm_wta (scm, (char *) pos, FUNC_NAME); } while (0) +#define SCM_VALIDATE_NUMBER_COPY(pos, z, cvar) \ + do { \ + if (SCM_INUMP (z)) \ + cvar = (double) SCM_INUM (z); \ + else if (SCM_REALP (z)) \ + cvar = SCM_REAL_VALUE (z); \ + else if (SCM_BIGP (z)) \ + cvar = scm_big2dbl (z); \ + else \ + { \ + cvar = 0.0; \ + SCM_WRONG_TYPE_ARG (pos, z); \ + } \ + } while (0) + +#define SCM_VALIDATE_NUMBER_DEF_COPY(pos, number, def, cvar) \ + do { \ + if (SCM_UNBNDP (number)) \ + cvar = def; \ + else \ + SCM_VALIDATE_NUMBER_COPY(pos, number, cvar); \ + } while (0) + #define SCM_VALIDATE_STRINGORSUBSTR SCM_VALIDATE_STRING #define SCM_VALIDATE_ROSTRING(pos, str) SCM_MAKE_VALIDATE (pos, str, ROSTRINGP) |