* error.h, error.c: Added `scm_wrong_type_arg_msg' to support

displaying the expected type. Use SCM_LISTn in a couple places instead of scm_cons-ing by hand. * __scm.h: Added SCM_ASSERT_TYPE macro. * validate.h, scm_validate.h: Added the former, as a renamed version of the latter with SCM_ASSERT_TYPE used in SCM_MAKE_VALIDATE (instead of just SCM_ASSERT) * Makefile.am: Rename scm_validate.h to validate.h. * *.c, *.h: Include validate.h, not scm_validate.h (old name's prefix was superfluous).
2025-05-20 03:30:27 +02:00 · 2000-03-03 00:09:54 +00:00 · 2000-03-03 00:09:54 +00:00 · b6791b2e94
commit b6791b2e94
parent 417bdef8a5
61 changed files with 89 additions and 64 deletions
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@ -390,11 +390,15 @@ do { \

 #ifdef SCM_RECKLESS
 #define SCM_ASSERT(_cond, _arg, _pos, _subr)
+#define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr)
 #define SCM_ASRTGO(_cond, _label)
 #else
 #define SCM_ASSERT(_cond, _arg, _pos, _subr) \
 	if (!(_cond)) \
          scm_wta(_arg, (char *)(_pos), _subr)
+#define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr, _msg) \
+	if (!(_cond)) \
+          scm_wrong_type_arg_msg(_subr, _pos, _arg, _msg)
 #define SCM_ASRTGO(_cond, _label) \
        if (!(_cond)) \
          goto _label
--- a/libguile/alist.c
+++ b/libguile/alist.c
@ -48,7 +48,7 @@
 #include "eq.h"
 #include "list.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "alist.h"


--- a/libguile/arbiters.c
+++ b/libguile/arbiters.c
@ -49,7 +49,7 @@
 #include "smob.h"
 #include "genio.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "arbiters.h"


--- a/libguile/async.c
+++ b/libguile/async.c
@ -51,7 +51,7 @@
 #include "throw.h"
 #include "smob.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "async.h"

 #ifdef HAVE_STRING_H
--- a/libguile/backtrace.c
+++ b/libguile/backtrace.c
@ -64,7 +64,7 @@
 #include "throw.h"
 #include "fluids.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "backtrace.h"

 /* {Error reporting and backtraces}
--- a/libguile/boolean.c
+++ b/libguile/boolean.c
@ -47,7 +47,7 @@
 #include <stdio.h>
 #include "_scm.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "boolean.h"


--- a/libguile/chars.c
+++ b/libguile/chars.c
@ -47,7 +47,7 @@
 #include <stdio.h>
 #include <ctype.h>
 #include "_scm.h"
-#include "scm_validate.h"
+#include "validate.h"

 #include "chars.h"

--- a/libguile/coop-threads.c
+++ b/libguile/coop-threads.c
@ -44,7 +44,7 @@



-#include "scm_validate.h"
+#include "validate.h"
 #include "coop-threads.h"

 /* A counter of the current number of threads */
--- a/libguile/debug.c
+++ b/libguile/debug.c
@ -65,7 +65,7 @@
 #include "dynwind.h"
 #include "modules.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "debug.h"


--- a/libguile/dynl.c
+++ b/libguile/dynl.c
@ -71,7 +71,7 @@ maybe_drag_in_eprintf ()
 #include "smob.h"
 #include "keywords.h"

-#include "scm_validate.h"
+#include "validate.h"

 /* Converting a list of SCM strings into a argv-style array.  You must
   have ints disabled for the whole lifetime of the created argv (from
--- a/libguile/eq.c
+++ b/libguile/eq.c
@ -51,7 +51,7 @@
 #include "smob.h"
 #include "unif.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "eq.h"

 SCM_DEFINE1 (scm_eq_p, "eq?", scm_tc7_rpsubr,
--- a/libguile/error.c
+++ b/libguile/error.c
@ -51,7 +51,7 @@
 #include "genio.h"
 #include "throw.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "error.h"

 #ifdef HAVE_STRING_H
@ -188,7 +188,7 @@ scm_out_of_range (const char *subr, SCM bad_value)
  scm_error (scm_out_of_range_key,
 	     subr,
 	     "Argument out of range: ~S",
-	     scm_cons (bad_value, SCM_EOL),
+             SCM_LIST1(bad_value),
 	     SCM_BOOL_F);
 }

@ -198,7 +198,7 @@ scm_out_of_range_pos (const char *subr, SCM bad_value, SCM pos)
  scm_error (scm_out_of_range_key,
 	     subr,
 	     "Argument ~S out of range: ~S",
-	     scm_listify (pos, bad_value, SCM_UNDEFINED),
+             SCM_LIST2(pos,bad_value),
 	     SCM_BOOL_F);
 }

@ -210,7 +210,7 @@ scm_wrong_num_args (SCM proc)
  scm_error (scm_args_number_key,
 	     NULL,
 	     "Wrong number of arguments to ~A",
-	     scm_cons (proc, SCM_EOL),
+	     SCM_LIST1(proc),
 	     SCM_BOOL_F);
 }

@ -222,11 +222,30 @@ scm_wrong_type_arg (const char *subr, int pos, SCM bad_value)
 	     subr,
 	     (pos == 0) ? "Wrong type argument: ~S"
 	     : "Wrong type argument in position ~A: ~S",
-	     (pos == 0) ? scm_cons (bad_value, SCM_EOL)
-	     : scm_cons (SCM_MAKINUM (pos), scm_cons (bad_value, SCM_EOL)),
+	     (pos == 0) ? SCM_LIST1(bad_value)
+	     : SCM_LIST2(SCM_MAKINUM(pos), bad_value),
 	     SCM_BOOL_F);
 }

+void
+scm_wrong_type_arg_msg (const char *subr, int pos, SCM bad_value, const char *szMessage)
+{
+  SCM msg = scm_makfrom0str(szMessage);
+  if (pos == 0) {
+    scm_error (scm_arg_type_key,
+               subr, "Wrong type argument (expecting ~A): ~S",
+               SCM_LIST2(msg,bad_value),
+               SCM_BOOL_F);
+  } else {
+    scm_error (scm_arg_type_key,
+               subr,
+               "Wrong type argument in position ~A (expecting ~A): ~S",
+               SCM_LIST3(SCM_MAKINUM(pos),msg,bad_value),
+               SCM_BOOL_F);
+  }
+}
+
+
 SCM_SYMBOL (scm_memory_alloc_key, "memory-allocation-error");
 void
 scm_memory_error (const char *subr)
--- a/libguile/error.h
+++ b/libguile/error.h
@ -78,6 +78,8 @@ extern void scm_out_of_range_pos (const char *subr, SCM bad_value, SCM pos)
 extern void scm_wrong_num_args (SCM proc) SCM_NORETURN;
 extern void scm_wrong_type_arg (const char *subr, int pos,
                                SCM bad_value) SCM_NORETURN;
+extern void scm_wrong_type_arg_msg (const char *subr, int pos,
+                                    SCM bad_value, const char *sz) SCM_NORETURN;
 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;
--- a/libguile/eval.c
+++ b/libguile/eval.c
@ -96,7 +96,7 @@ char *alloca ();
 #include "feature.h"
 #include "modules.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "eval.h"

 SCM (*scm_memoize_method) (SCM, SCM);
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@ -49,7 +49,7 @@
 #include "macros.h"
 #include "modules.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "evalext.h"

 SCM_SYMBOL (scm_sym_setter, "setter");
--- a/libguile/feature.c
+++ b/libguile/feature.c
@ -51,7 +51,7 @@
 #include "procprop.h"
 #include "smob.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "feature.h"

 #ifdef HAVE_STRING_H
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@ -51,7 +51,7 @@
 #include "fports.h"
 #include "iselect.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "filesys.h"


--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@ -53,7 +53,7 @@
 #include "eval.h"

 #define INITIAL_FLUIDS 10
-#include "scm_validate.h"
+#include "validate.h"

 static volatile int n_fluids;
 long scm_tc16_fluid;
--- a/libguile/fports.c
+++ b/libguile/fports.c
@ -48,7 +48,7 @@
 #include <fcntl.h>
 #include "_scm.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "fports.h"

 #ifdef HAVE_STRING_H
--- a/libguile/gc.c
+++ b/libguile/gc.c
@ -55,7 +55,7 @@
 #include "unif.h"
 #include "async.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "gc.h"

 #ifdef HAVE_MALLOC_H
--- a/libguile/guardians.c
+++ b/libguile/guardians.c
@ -62,7 +62,7 @@
 #include "smob.h"
 #include "genio.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "guardians.h"

 static long scm_tc16_guardian;
--- a/libguile/hash.c
+++ b/libguile/hash.c
@ -48,7 +48,7 @@
 #include "_scm.h"
 #include "chars.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "hash.h"


--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@ -50,7 +50,7 @@
 #include "hash.h"
 #include "eval.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "hashtab.h"


--- a/libguile/ioext.c
+++ b/libguile/ioext.c
@ -54,7 +54,7 @@
 #include "chars.h"
 #include "feature.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "ioext.h"

 #include <fcntl.h>
--- a/libguile/keywords.c
+++ b/libguile/keywords.c
@ -49,7 +49,7 @@
 #include "genio.h"
 #include "smob.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "keywords.h"


--- a/libguile/lang.c
+++ b/libguile/lang.c
@ -49,7 +49,7 @@
 #include "eval.h"
 #include "macros.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "lang.h"


--- a/libguile/list.c
+++ b/libguile/list.c
@ -47,7 +47,7 @@
 #include "_scm.h"
 #include "eq.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "list.h"

 #ifdef __STDC__
--- a/libguile/load.c
+++ b/libguile/load.c
@ -54,7 +54,7 @@
 #include "alist.h"
 #include "dynwind.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "load.h"

 #include <sys/types.h>
--- a/libguile/macros.c
+++ b/libguile/macros.c
@ -47,7 +47,7 @@
 #include "_scm.h"
 #include "smob.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "macros.h"

 long scm_tc16_macro;
--- a/libguile/net_db.c
+++ b/libguile/net_db.c
@ -55,7 +55,7 @@
 #include "_scm.h"
 #include "feature.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "net_db.h"

 #ifdef HAVE_STRING_H
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@ -52,7 +52,7 @@
 #include "feature.h"
 #include "smob.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "numbers.h"

 #define DIGITS '0':case '1':case '2':case '3':case '4':\
--- a/libguile/objects.c
+++ b/libguile/objects.c
@ -59,7 +59,7 @@
 #include "eval.h"
 #include "alist.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "objects.h"


--- a/libguile/pairs.c
+++ b/libguile/pairs.c
@ -47,7 +47,7 @@
 #include "_scm.h"


-#include "scm_validate.h"
+#include "validate.h"



--- a/libguile/ports.c
+++ b/libguile/ports.c
@ -53,7 +53,7 @@

 #include "keywords.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "ports.h"

 #ifdef HAVE_STRING_H
--- a/libguile/posix.c
+++ b/libguile/posix.c
@ -50,7 +50,7 @@
 #include "scmsigs.h"
 #include "feature.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "posix.h"


--- a/libguile/print.c
+++ b/libguile/print.c
@ -60,7 +60,7 @@
 #include "objects.h"
 #include "strports.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "print.h"


--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@ -53,7 +53,7 @@
 #include "gsubr.h"
 #include "objects.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "procprop.h"


--- a/libguile/procs.c
+++ b/libguile/procs.c
@ -49,7 +49,7 @@

 #include "objects.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "procs.h"


--- a/libguile/ramap.c
+++ b/libguile/ramap.c
@ -56,7 +56,7 @@
 #include "eval.h"
 #include "feature.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "ramap.h"


--- a/libguile/random.c
+++ b/libguile/random.c
@ -53,7 +53,7 @@
 #include "numbers.h"
 #include "feature.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "random.h"


--- a/libguile/read.c
+++ b/libguile/read.c
@ -56,7 +56,7 @@
 #include "hashtab.h"
 #include "hash.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "read.h"


--- a/libguile/regex-posix.c
+++ b/libguile/regex-posix.c
@ -83,7 +83,7 @@
 #include "ports.h"
 #include "feature.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "regex-posix.h"

 /* This is defined by some regex libraries and omitted by others. */
--- a/libguile/scm_validate.h
+++ b/libguile/scm_validate.h
@ -1,4 +1,4 @@
-/* $Id: scm_validate.h,v 1.20 2000-03-02 20:54:43 gjb Exp $ */
+/* $Id: scm_validate.h,v 1.21 2000-03-03 00:09:53 gjb Exp $ */
 /*	Copyright (C) 1999 Free Software Foundation, Inc.
 * 
 * This program is free software; you can redistribute it and/or modify
--- a/libguile/scmsigs.c
+++ b/libguile/scmsigs.c
@ -51,7 +51,7 @@
 #include "async.h"
 #include "eval.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "scmsigs.h"

 #ifdef HAVE_UNISTD_H
--- a/libguile/simpos.c
+++ b/libguile/simpos.c
@ -49,7 +49,7 @@

 #include "scmsigs.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "simpos.h"

 #ifdef HAVE_STRING_H
--- a/libguile/socket.c
+++ b/libguile/socket.c
@ -51,7 +51,7 @@
 #include "feature.h"
 #include "fports.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "socket.h"

 #ifdef HAVE_STRING_H
--- a/libguile/sort.c
+++ b/libguile/sort.c
@ -86,7 +86,7 @@ char *alloca ();
 #include "alist.h"
 #include "feature.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "sort.h"

 /* The routine quicksort was extracted from the GNU C Library qsort.c
--- a/libguile/srcprop.c
+++ b/libguile/srcprop.c
@ -57,7 +57,7 @@
 #include "hash.h"
 #include "weaks.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "srcprop.h"

 /* {Source Properties}
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@ -58,7 +58,7 @@
 #include "procprop.h"
 #include "modules.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "stacks.h"


--- a/libguile/stime.c
+++ b/libguile/stime.c
@ -48,7 +48,7 @@
 #include "_scm.h"
 #include "feature.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "stime.h"

 #ifdef HAVE_UNISTD_H
--- a/libguile/strings.c
+++ b/libguile/strings.c
@ -49,7 +49,7 @@
 #include "chars.h"

 #include "strings.h"
-#include "scm_validate.h"
+#include "validate.h"


 /* {Strings}
--- a/libguile/strop.c
+++ b/libguile/strop.c
@ -27,7 +27,7 @@ Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
 #include "_scm.h"
 #include "chars.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "strop.h"
 #include "read.h" /*For SCM_CASE_INSENSITIVE_P*/

--- a/libguile/strorder.c
+++ b/libguile/strorder.c
@ -47,7 +47,7 @@
 #include "_scm.h"
 #include "chars.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "strorder.h"


--- a/libguile/struct.c
+++ b/libguile/struct.c
@ -53,7 +53,7 @@
 #include "weaks.h"
 #include "hashtab.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "struct.h"

 #ifdef HAVE_STRING_H
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@ -52,7 +52,7 @@
 #include "alist.h"
 #include "weaks.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "symbols.h"

 #ifdef HAVE_STRING_H
--- a/libguile/throw.c
+++ b/libguile/throw.c
@ -61,7 +61,7 @@
 #include "stacks.h"
 #include "fluids.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "throw.h"


--- a/libguile/unif.c
+++ b/libguile/unif.c
@ -53,7 +53,7 @@
 #include "strop.h"
 #include "feature.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "unif.h"
 #include "ramap.h"

--- a/libguile/variable.c
+++ b/libguile/variable.c
@ -50,7 +50,7 @@
 #include "genio.h"
 #include "smob.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "variable.h"


--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@ -48,7 +48,7 @@
 #include "_scm.h"
 #include "eq.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "vectors.h"
 #include "unif.h"

--- a/libguile/vports.c
+++ b/libguile/vports.c
@ -50,7 +50,7 @@
 #include "chars.h"
 #include "fports.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "vports.h"

 #ifdef HAVE_STRING_H
--- a/libguile/weaks.c
+++ b/libguile/weaks.c
@ -46,7 +46,7 @@
 #include <stdio.h>
 #include "_scm.h"

-#include "scm_validate.h"
+#include "validate.h"
 #include "weaks.h"