error-message update

src/racket/include/mzwin.def

@@ -112,6 +112,7 @@ EXPORTS
  scheme_wrong_type
  scheme_wrong_contract
  scheme_wrong_field_type
+ scheme_wrong_field_contract
  scheme_arg_mismatch
  scheme_contract_error
  scheme_wrong_return_arity

src/racket/include/mzwin3m.def

@@ -112,6 +112,7 @@ EXPORTS
  scheme_wrong_type
  scheme_wrong_contract
  scheme_wrong_field_type
+ scheme_wrong_field_contract
  scheme_arg_mismatch
  scheme_contract_error
  scheme_wrong_return_arity

src/racket/include/racket.exp

@@ -110,6 +110,7 @@ scheme_case_lambda_wrong_count
 scheme_wrong_type
 scheme_wrong_contract
 scheme_wrong_field_type
+scheme_wrong_field_contract
 scheme_arg_mismatch
 scheme_contract_error
 scheme_wrong_return_arity

src/racket/include/racket3m.exp

@@ -110,6 +110,7 @@ scheme_case_lambda_wrong_count
 scheme_wrong_type
 scheme_wrong_contract
 scheme_wrong_field_type
+scheme_wrong_field_contract
 scheme_arg_mismatch
 scheme_contract_error
 scheme_wrong_return_arity

src/racket/src/error.c

@@ -1655,6 +1655,17 @@ void scheme_wrong_field_type(Scheme_Object *c_name,
   scheme_wrong_type(s, expected, -1, 0, a);
 }
 
+void scheme_wrong_field_contract(Scheme_Object *c_name,
+                                 const char *expected,
+                                 Scheme_Object *o)
+{
+  const char *s;
+  Scheme_Object *a[1];
+  a[0] = o;
+  s = scheme_symbol_name(c_name);
+  scheme_wrong_contract(s, expected, -1, 0, a);
+}
+
 void scheme_arg_mismatch(const char *name, const char *msg, Scheme_Object *o)
 {
   char *s;

src/racket/src/schemef.h

@@ -237,6 +237,9 @@ MZ_EXTERN void scheme_wrong_contract(const char *name, const char *expected,
 MZ_EXTERN void scheme_wrong_field_type(Scheme_Object *c_name,
 				       const char *expected,
 				       Scheme_Object *o);
+MZ_EXTERN void scheme_wrong_field_contract(Scheme_Object *c_name,
+                                           const char *expected,
+                                           Scheme_Object *o);
 MZ_EXTERN void scheme_arg_mismatch(const char *name, const char *msg, Scheme_Object *o);
 MZ_EXTERN void scheme_contract_error(const char *name, const char *msg, ...);
 MZ_EXTERN void scheme_wrong_return_arity(const char *where,

src/racket/src/schemex.h

@@ -176,6 +176,9 @@ void (*scheme_wrong_contract)(const char *name, const char *expected,
 void (*scheme_wrong_field_type)(Scheme_Object *c_name,
 				       const char *expected,
 				       Scheme_Object *o);
+void (*scheme_wrong_field_contract)(Scheme_Object *c_name,
+                                           const char *expected,
+                                           Scheme_Object *o);
 void (*scheme_arg_mismatch)(const char *name, const char *msg, Scheme_Object *o);
 void (*scheme_contract_error)(const char *name, const char *msg, ...);
 void (*scheme_wrong_return_arity)(const char *where,

src/racket/src/schemex.inc

@@ -118,6 +118,7 @@
   scheme_extension_table->scheme_wrong_type = scheme_wrong_type;
   scheme_extension_table->scheme_wrong_contract = scheme_wrong_contract;
   scheme_extension_table->scheme_wrong_field_type = scheme_wrong_field_type;
+  scheme_extension_table->scheme_wrong_field_contract = scheme_wrong_field_contract;
   scheme_extension_table->scheme_arg_mismatch = scheme_arg_mismatch;
   scheme_extension_table->scheme_contract_error = scheme_contract_error;
   scheme_extension_table->scheme_wrong_return_arity = scheme_wrong_return_arity;

src/racket/src/schemexm.h

@@ -118,6 +118,7 @@
 #define scheme_wrong_type (scheme_extension_table->scheme_wrong_type)
 #define scheme_wrong_contract (scheme_extension_table->scheme_wrong_contract)
 #define scheme_wrong_field_type (scheme_extension_table->scheme_wrong_field_type)
+#define scheme_wrong_field_contract (scheme_extension_table->scheme_wrong_field_contract)
 #define scheme_arg_mismatch (scheme_extension_table->scheme_arg_mismatch)
 #define scheme_contract_error (scheme_extension_table->scheme_contract_error)
 #define scheme_wrong_return_arity (scheme_extension_table->scheme_wrong_return_arity)

src/racket/src/struct.c

@@ -4995,13 +4995,13 @@ int scheme_is_location(Scheme_Object *o)
 static Scheme_Object *check_location_fields(int argc, Scheme_Object **argv)
 {
   if (SCHEME_TRUEP(argv[1]) && !exact_pos_integer(argv[1]))
-    scheme_wrong_field_type(argv[5], "exact positive integer or #f", argv[1]);
+    scheme_wrong_field_contract(argv[5], "(or/c exact-positive-integer? #f)", argv[1]);
   if (SCHEME_TRUEP(argv[2]) && !exact_nneg_integer(argv[2]))
-    scheme_wrong_field_type(argv[5], "exact non-negative integer or #f", argv[2]);
+    scheme_wrong_field_contract(argv[5], "(or/c exact-nonnegative-integer #f)", argv[2]);
   if (SCHEME_TRUEP(argv[3]) && !exact_pos_integer(argv[3]))
-    scheme_wrong_field_type(argv[5], "exact positive integer or #f", argv[3]);
+    scheme_wrong_field_contract(argv[5], "(or/c exact-positive-integer? #f)", argv[3]);
   if (SCHEME_TRUEP(argv[4]) && !exact_nneg_integer(argv[4]))
-    scheme_wrong_field_type(argv[5], "exact non-negative integer or #f", argv[4]);
+    scheme_wrong_field_contract(argv[5], "(or/c exact-nonnegative-integer? #f)", argv[4]);
   
   return scheme_values(5, argv);
 }
@@ -5023,7 +5023,7 @@ static Scheme_Object *check_arity_at_least_fields(int argc, Scheme_Object **argv
       return a;
   }
 
-  scheme_wrong_field_type(argv[1], "exact non-negative integer", a);
+  scheme_wrong_field_contract(argv[1], "exact-nonnegative-integer?", a);
   return NULL;
 }
 
@@ -5033,31 +5033,31 @@ static Scheme_Object *check_date_fields(int argc, Scheme_Object **argv)
 
   a = argv[0];
   if (!SCHEME_INTP(a) || (SCHEME_INT_VAL(a) < 0) || (SCHEME_INT_VAL(a) > 61))
-    scheme_wrong_field_type(argv[10], "exact integer in [0, 61]", a);
+    scheme_wrong_field_contract(argv[10], "(integer-in 0 61)", a);
   a = argv[1];
   if (!SCHEME_INTP(a) || (SCHEME_INT_VAL(a) < 0) || (SCHEME_INT_VAL(a) > 59))
-    scheme_wrong_field_type(argv[10], "exact integer in [0, 59]", a);
+    scheme_wrong_field_contract(argv[10], "(integer-in 0 59)", a);
   a = argv[2];
   if (!SCHEME_INTP(a) || (SCHEME_INT_VAL(a) < 0) || (SCHEME_INT_VAL(a) > 23))
-    scheme_wrong_field_type(argv[10], "exact integer in [0, 23]", a);
+    scheme_wrong_field_contract(argv[10], "(integer-in 0 23)", a);
   a = argv[3];
   if (!SCHEME_INTP(a) || (SCHEME_INT_VAL(a) < 1) || (SCHEME_INT_VAL(a) > 31))
-    scheme_wrong_field_type(argv[10], "exact integer in [1, 31]", a);
+    scheme_wrong_field_contract(argv[10], "(integer-in 1 31)", a);
   a = argv[4];
   if (!SCHEME_INTP(a) || (SCHEME_INT_VAL(a) < 1) || (SCHEME_INT_VAL(a) > 12))
-    scheme_wrong_field_type(argv[10], "exact integer in [1, 12]", a);
+    scheme_wrong_field_contract(argv[10], "(integer-in 1 12)", a);
   a = argv[5];
   if (!SCHEME_INTP(a) && !SCHEME_BIGNUMP(a))
-    scheme_wrong_field_type(argv[10], "exact integer", a);
+    scheme_wrong_field_contract(argv[10], "exact-integer?", a);
   a = argv[6];
   if (!SCHEME_INTP(a) || (SCHEME_INT_VAL(a) < 0) || (SCHEME_INT_VAL(a) > 6))
-    scheme_wrong_field_type(argv[10], "exact integer in [0, 6]", a);
+    scheme_wrong_field_contract(argv[10], "(integer-in 0 6)", a);
   a = argv[7];
   if (!SCHEME_INTP(a) || (SCHEME_INT_VAL(a) < 0) || (SCHEME_INT_VAL(a) > 365))
-    scheme_wrong_field_type(argv[10], "exact integer in [0, 365]", a);
+    scheme_wrong_field_contract(argv[10], "(integer-in 0 365)", a);
   a = argv[9];
   if (!SCHEME_INTP(a) && !SCHEME_BIGNUMP(a))
-    scheme_wrong_field_type(argv[10], "exact integer", a);
+    scheme_wrong_field_contract(argv[10], "exact-integer?", a);
 
   /* Normalize dst? boolean: */
   memcpy(args, argv, sizeof(Scheme_Object *) * 10);
@@ -5073,11 +5073,11 @@ static Scheme_Object *check_date_star_fields(int argc, Scheme_Object **argv)
   a = argv[10];
   if (!SCHEME_INTP(a) || (SCHEME_INT_VAL(a) < 0)
       || (SCHEME_INT_VAL(a) > 999999999))
-    scheme_wrong_field_type(argv[12], "exact integer in [0, 999999999]", a);
+    scheme_wrong_field_contract(argv[12], "(integer-in 0 999999999)", a);
   
   a = argv[11];
   if (!SCHEME_CHAR_STRINGP(a)) 
-    scheme_wrong_field_type(argv[12], "string", a);
+    scheme_wrong_field_contract(argv[12], "string?", a);
 
   memcpy(args, argv, sizeof(Scheme_Object *) * 12);
   if (!SCHEME_IMMUTABLEP(argv[11])) {