mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

* Remove uses of SCM_ASSERT that may result in error messages different

Browse source 
from wrong-type-arg errors.
This commit is contained in:
Dirk Herrmann 2001-03-06 01:22:37 +00:00
parent d42df0557f
commit 2ade72d773
6 changed files with 84 additions and 64 deletions
Download patch file Download diff file Expand all files Collapse all files

15
libguile/ChangeLog
View file

@ -1,3 +1,18 @@
2001-03-06 Dirk Herrmann <D.Herrmann@tu-bs.de>
* coop-threads.c (scm_call_with_new_thread), load.c
(scm_primitive_load, scm_sys_search_load_path), random.c
(scm_c_default_rstate), struct.c (scm_make_struct_layout,
scm_struct_ref, scm_struct_set_x): Don't use SCM_ASSERT to
(potentially) issue a scm-misc-error or wrong-num-args error
message.
* load.c (scm_search_path): Use SCM_ASSERT_TYPE to give details
about the expected type with the wrong-type-arg error message.
* smob.c (scm_make_smob): Abort on misuse of smob - it indicates
a C level bug that can't be fixed from scheme anyway.
2001-03-05 Mikael Djurfeldt <mdj@linnaeus.mit.edu>
* eval.c (scm_m_letstar): Removed check for duplicate bindings.

21
libguile/coop-threads.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 2000 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
@ -220,8 +220,10 @@ scheme_launch_thread (void *p)
SCM_DEFER_INTS;
}
SCM
scm_call_with_new_thread (SCM argl)
#define FUNC_NAME s_call_with_new_thread
{
SCM thread;
@ -229,26 +231,23 @@ scm_call_with_new_thread (SCM argl)
{
register SCM args = argl;
SCM thunk, handler;
SCM_ASSERT (SCM_NIMP (args),
scm_makfrom0str (s_call_with_new_thread),
SCM_WNA, NULL);
if (!SCM_CONSP (args))
SCM_WRONG_NUM_ARGS ();
thunk = SCM_CAR (args);
SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)),
thunk,
SCM_ARG1,
s_call_with_new_thread);
args = SCM_CDR (args);
SCM_ASSERT (SCM_NIMP (args),
scm_makfrom0str (s_call_with_new_thread),
SCM_WNA, NULL);
if (!SCM_CONSP (args))
SCM_WRONG_NUM_ARGS ();
handler = SCM_CAR (args);
SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)),
handler,
SCM_ARG2,
s_call_with_new_thread);
SCM_ASSERT (SCM_NULLP (SCM_CDR (args)),
scm_makfrom0str (s_call_with_new_thread),
SCM_WNA, NULL);
if (!SCM_NULLP (SCM_CDR (args))
SCM_WRONG_NUM_ARGS ();
}
/* Make new thread. */
@ -285,6 +284,8 @@ scm_call_with_new_thread (SCM argl)
return thread;
}
#undef FUNC_NAME
/* This is the second thread spawning mechanism: threads from C */

27
libguile/load.c
View file

@ -1,4 +1,4 @@
/* 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
@ -114,9 +114,9 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
{
SCM hook = *scm_loc_load_hook;
SCM_VALIDATE_STRING (1, filename);
SCM_ASSERT (SCM_FALSEP (hook) || (SCM_EQ_P (scm_procedure_p (hook), SCM_BOOL_T)),
hook, "value of %load-hook is neither a procedure nor #f",
FUNC_NAME);
if (!SCM_FALSEP (hook) && !SCM_EQ_P (scm_procedure_p (hook), SCM_BOOL_T))
SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f",
SCM_EOL);
if (! SCM_FALSEP (hook))
scm_apply (hook, scm_listify (filename, SCM_UNDEFINED), SCM_EOL);
@ -301,9 +301,8 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
for (walk = path; !SCM_NULLP (walk); walk = SCM_CDR (walk))
{
SCM elt = SCM_CAR (walk);
SCM_ASSERT (SCM_STRINGP (elt), elt,
"path is not a list of strings",
FUNC_NAME);
SCM_ASSERT_TYPE (SCM_STRINGP (elt), path, 1, FUNC_NAME,
"list of strings");
if (SCM_STRING_LENGTH (elt) > max_path_len)
max_path_len = SCM_STRING_LENGTH (elt);
}
@ -340,9 +339,8 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
for (walk = extensions; !SCM_NULLP (walk); walk = SCM_CDR (walk))
{
SCM elt = SCM_CAR (walk);
SCM_ASSERT (SCM_STRINGP (elt), elt,
"extension list is not a list of strings",
FUNC_NAME);
SCM_ASSERT_TYPE (SCM_STRINGP (elt), elt, 3, FUNC_NAME,
"list of strings");
if (SCM_STRING_LENGTH (elt) > max_ext_len)
max_ext_len = SCM_STRING_LENGTH (elt);
}
@ -426,11 +424,10 @@ SCM_DEFINE (scm_sys_search_load_path, "%search-load-path", 1, 0, 0,
SCM exts = *scm_loc_load_extensions;
SCM_VALIDATE_STRING (1, filename);
SCM_ASSERT (scm_ilength (path) >= 0, path, "load path is not a proper list",
FUNC_NAME);
SCM_ASSERT (scm_ilength (exts) >= 0, exts,
"load extension list is not a proper list",
FUNC_NAME);
if (scm_ilength (path) < 0)
SCM_MISC_ERROR ("%load-path is not a proper list", SCM_EOL);
if (scm_ilength (exts) < 0)
SCM_MISC_ERROR ("%load-extension list is not a proper list", SCM_EOL);
return scm_search_path (path, filename, exts);
}
#undef FUNC_NAME

10
libguile/random.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1999, 2000 Free Software Foundation, Inc.
/* Copyright (C) 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
* the Free Software Foundation; either version 2, or (at your option)
@ -192,14 +192,18 @@ scm_c_make_rstate (char *seed, int n)
return state;
}
scm_rstate *
scm_c_default_rstate ()
#define FUNC_NAME "scm_c_default_rstate"
{
SCM state = SCM_CDR (scm_var_random_state);
SCM_ASSERT (SCM_RSTATEP (state),
state, "*random-state* contains bogus random state", 0);
if (!SCM_RSTATEP (state))
SCM_MISC_ERROR ("*random-state* contains bogus random state", SCM_EOL);
return SCM_RSTATE (state);
}
#undef FUNC_NAME
inline double
scm_c_uniform01 (scm_rstate *state)

13
libguile/smob.c
View file

@ -1,4 +1,4 @@
/* 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
@ -459,10 +459,13 @@ scm_make_smob (scm_bits_t tc)
if (size != 0)
{
#if 0
SCM_ASSERT (scm_smobs[n].mark == 0,
0,
"forbidden operation for smobs with GC data, use SCM_NEWSMOB",
SCM_SMOBNAME (n));
if (scm_smobs[n].mark != 0)
{
fprintf
(stderr,
"forbidden operation for smobs with GC data, use SCM_NEWSMOB\n");
abort ();
}
#endif
SCM_SET_SMOB_DATA (z, scm_must_malloc (size, SCM_SMOBNAME (n)));
}

62
libguile/struct.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1996, 97, 98, 99, 2000 Free Software Foundation, Inc.
/* Copyright (C) 1996,1997,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
@ -82,14 +82,18 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
{
SCM new_sym;
SCM_VALIDATE_STRING (1, fields);
{ /* scope */
char * field_desc;
int len;
scm_sizet len;
int x;
len = SCM_STRING_LENGTH (fields);
if (len % 2 == 1)
SCM_MISC_ERROR ("odd length field specification: ~S",
SCM_LIST1 (fields));
field_desc = SCM_STRING_CHARS (fields);
SCM_ASSERT (!(len & 1), fields, "odd length field specification", FUNC_NAME);
for (x = 0; x < len; x += 2)
{
@ -104,35 +108,38 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
case 's':
break;
default:
SCM_ASSERT (0, SCM_MAKE_CHAR (field_desc[x]) , "unrecognized field type", FUNC_NAME);
SCM_MISC_ERROR ("unrecognized field type: ~S",
SCM_LIST1 (SCM_MAKE_CHAR (field_desc[x])));
}
switch (field_desc[x + 1])
{
case 'w':
SCM_ASSERT (field_desc[x] != 's', SCM_MAKE_CHAR (field_desc[x + 1]),
"self fields not writable", FUNC_NAME);
if (field_desc[x] == 's')
SCM_MISC_ERROR ("self fields not writable", SCM_EOL);
case 'r':
case 'o':
break;
case 'R':
case 'W':
case 'O':
SCM_ASSERT (field_desc[x] != 's', SCM_MAKE_CHAR (field_desc[x + 1]),
"self fields not allowed in tail array",
FUNC_NAME);
SCM_ASSERT (x == len - 2, SCM_MAKE_CHAR (field_desc[x + 1]),
"tail array field must be last field in layout",
FUNC_NAME);
if (field_desc[x] == 's')
SCM_MISC_ERROR ("self fields not allowed in tail array",
SCM_EOL);
if (x != len - 2)
SCM_MISC_ERROR ("tail array field must be last field in layout",
SCM_EOL);
break;
default:
SCM_ASSERT (0, SCM_MAKE_CHAR (field_desc[x]) , "unrecognized ref specification", FUNC_NAME);
SCM_MISC_ERROR ("unrecognized ref specification: ~S",
SCM_LIST1 (SCM_MAKE_CHAR (field_desc[x + 1])));
}
#if 0
if (field_desc[x] == 'd')
{
SCM_ASSERT (field_desc[x + 2] == '-', SCM_MAKINUM (x / 2), "missing dash field", FUNC_NAME);
if (field_desc[x + 2] != '-')
SCM_MISC_ERROR ("missing dash field at position ~A",
SCM_LIST1 (SCM_MAKINUM (x / 2)));
x += 2;
goto recheck_ref;
}
@ -592,16 +599,13 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
if ((ref == 'R') || (ref == 'W'))
field_type = 'u';
else
SCM_ASSERT (0, pos, "ref denied", FUNC_NAME);
SCM_MISC_ERROR ("ref denied for field ~A", SCM_LIST1 (pos));
}
}
else if (fields_desc[SCM_SYMBOL_LENGTH (layout) - 1] != 'O')
field_type = fields_desc[SCM_SYMBOL_LENGTH (layout) - 2];
else
{
SCM_ASSERT (0, pos, "ref denied", FUNC_NAME);
abort ();
}
SCM_MISC_ERROR ("ref denied for field ~A", SCM_LIST1 (pos));
switch (field_type)
{
@ -626,8 +630,8 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
default:
SCM_ASSERT (0, SCM_MAKE_CHAR (field_type), "unrecognized field type", FUNC_NAME);
break;
SCM_MISC_ERROR ("unrecognized field type: ~S",
SCM_LIST1 (SCM_MAKE_CHAR (field_type)));
}
return answer;
@ -667,15 +671,12 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
field_type = fields_desc[p * 2];
set_x = fields_desc [p * 2 + 1];
if (set_x != 'w')
SCM_ASSERT (0, pos, "set_x denied", FUNC_NAME);
SCM_MISC_ERROR ("set! denied for field ~A", SCM_LIST1 (pos));
}
else if (fields_desc[SCM_SYMBOL_LENGTH (layout) - 1] == 'W')
field_type = fields_desc[SCM_SYMBOL_LENGTH (layout) - 2];
else
{
SCM_ASSERT (0, pos, "set_x denied", FUNC_NAME);
abort ();
}
SCM_MISC_ERROR ("set! denied for field ~A", SCM_LIST1 (pos));
switch (field_type)
{
@ -698,12 +699,11 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
break;
case 's':
SCM_ASSERT (0, SCM_MAKE_CHAR (field_type), "self fields immutable", FUNC_NAME);
break;
SCM_MISC_ERROR ("self fields immutable", SCM_EOL);
default:
SCM_ASSERT (0, SCM_MAKE_CHAR (field_type), "unrecognized field type", FUNC_NAME);
break;
SCM_MISC_ERROR ("unrecognized field type: ~S",
SCM_LIST1 (SCM_MAKE_CHAR (field_type)));
}
return val;