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

from wrong-type-arg errors.

libguile/ChangeLog

@@ -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.

libguile/coop-threads.c

@@ -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),
+    if (!SCM_CONSP (args))
-		scm_makfrom0str (s_call_with_new_thread),
+      SCM_WRONG_NUM_ARGS ();
-		SCM_WNA, NULL);
     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),
+    if (!SCM_CONSP (args))
-		scm_makfrom0str (s_call_with_new_thread),
+      SCM_WRONG_NUM_ARGS ();
-		SCM_WNA, NULL);
     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)),
+    if (!SCM_NULLP (SCM_CDR (args))
-		scm_makfrom0str (s_call_with_new_thread),
+      SCM_WRONG_NUM_ARGS ();
-		SCM_WNA, NULL);
   }
 
   /* 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 */
 

libguile/load.c

@@ -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)),
+  if (!SCM_FALSEP (hook) && !SCM_EQ_P (scm_procedure_p (hook), SCM_BOOL_T))
-	      hook, "value of %load-hook is neither a procedure nor #f",
+    SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f",
-	      FUNC_NAME);
+		    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,
+	SCM_ASSERT_TYPE (SCM_STRINGP (elt), path, 1, FUNC_NAME,
-		    "path is not a list of strings",
+			 "list of strings");
-		    FUNC_NAME);
 	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,
+	SCM_ASSERT_TYPE (SCM_STRINGP (elt), elt, 3, FUNC_NAME,
-		    "extension list is not a list of strings",
+			 "list of strings");
-		    FUNC_NAME);
 	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",
+  if (scm_ilength (path) < 0)
-	      FUNC_NAME);
+    SCM_MISC_ERROR ("%load-path is not a proper list", SCM_EOL);
-  SCM_ASSERT (scm_ilength (exts) >= 0, exts,
+  if (scm_ilength (exts) < 0)
-	      "load extension list is not a proper list",
+    SCM_MISC_ERROR ("%load-extension list is not a proper list", SCM_EOL);
-	      FUNC_NAME);
   return scm_search_path (path, filename, exts);
 }
 #undef FUNC_NAME

libguile/random.c

@@ -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),
+  if (!SCM_RSTATEP (state))
-	      state, "*random-state* contains bogus random state", 0);
+    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)

libguile/smob.c

@@ -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,
+      if (scm_smobs[n].mark != 0)
-		  0,
+	{
-		  "forbidden operation for smobs with GC data, use SCM_NEWSMOB",
+	  fprintf
-		  SCM_SMOBNAME (n));
+	    (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)));
     }

libguile/struct.c

@@ -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]),
+	    if (field_desc[x] == 's')
-			"self fields not writable", FUNC_NAME);
+	      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]),
+	    if (field_desc[x] == 's')
-			"self fields not allowed in tail array",
+	      SCM_MISC_ERROR ("self fields not allowed in tail array", 
-                        FUNC_NAME);
+			      SCM_EOL);
-	    SCM_ASSERT (x == len - 2, SCM_MAKE_CHAR (field_desc[x + 1]),
+	    if (x != len - 2)
-			"tail array field must be last field in layout",
+	      SCM_MISC_ERROR ("tail array field must be last field in layout",
-                        FUNC_NAME);
+			      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_MISC_ERROR ("ref denied for field ~A", SCM_LIST1 (pos));
-      SCM_ASSERT (0, pos, "ref denied", FUNC_NAME);
-      abort ();
-    }
   
   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);
+      SCM_MISC_ERROR ("unrecognized field type: ~S",
-      break;
+		      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_MISC_ERROR ("set! denied for field ~A", SCM_LIST1 (pos));
-      SCM_ASSERT (0, pos, "set_x denied", FUNC_NAME);
-      abort ();
-    }
   
   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);
+      SCM_MISC_ERROR ("self fields immutable", SCM_EOL);
-      break;
 
     default:
-      SCM_ASSERT (0, SCM_MAKE_CHAR (field_type), "unrecognized field type", FUNC_NAME);
+      SCM_MISC_ERROR ("unrecognized field type: ~S",
-      break;
+		      SCM_LIST1 (SCM_MAKE_CHAR (field_type)));
     }
 
   return val;