From 503b3858f503bcc7c0305e7c70ddcad68c36f556 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 23 Jun 2012 05:56:05 +0800 Subject: [PATCH] error-message update --- src/racket/include/mzwin.def | 1 + src/racket/include/mzwin3m.def | 1 + src/racket/include/racket.exp | 1 + src/racket/include/racket3m.exp | 1 + src/racket/src/error.c | 11 +++++++++++ src/racket/src/schemef.h | 3 +++ src/racket/src/schemex.h | 3 +++ src/racket/src/schemex.inc | 1 + src/racket/src/schemexm.h | 1 + src/racket/src/struct.c | 32 ++++++++++++++++---------------- 10 files changed, 39 insertions(+), 16 deletions(-) diff --git a/src/racket/include/mzwin.def b/src/racket/include/mzwin.def index 1f6ce86b7c..6dadd5e1db 100644 --- a/src/racket/include/mzwin.def +++ b/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 diff --git a/src/racket/include/mzwin3m.def b/src/racket/include/mzwin3m.def index ea4dae284f..75cff8565e 100644 --- a/src/racket/include/mzwin3m.def +++ b/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 diff --git a/src/racket/include/racket.exp b/src/racket/include/racket.exp index e0c51b3795..c0ab4f95f8 100644 --- a/src/racket/include/racket.exp +++ b/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 diff --git a/src/racket/include/racket3m.exp b/src/racket/include/racket3m.exp index e2d135e358..4f497457df 100644 --- a/src/racket/include/racket3m.exp +++ b/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 diff --git a/src/racket/src/error.c b/src/racket/src/error.c index bc53d076c9..04ba3fd1cc 100644 --- a/src/racket/src/error.c +++ b/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; diff --git a/src/racket/src/schemef.h b/src/racket/src/schemef.h index 9a312b14c9..ab9c9a615b 100644 --- a/src/racket/src/schemef.h +++ b/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, diff --git a/src/racket/src/schemex.h b/src/racket/src/schemex.h index e8c3e372fb..d5ff4e8743 100644 --- a/src/racket/src/schemex.h +++ b/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, diff --git a/src/racket/src/schemex.inc b/src/racket/src/schemex.inc index 3e6105d68c..55f14830a2 100644 --- a/src/racket/src/schemex.inc +++ b/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; diff --git a/src/racket/src/schemexm.h b/src/racket/src/schemexm.h index 28ca12f9ec..2f47fed2d3 100644 --- a/src/racket/src/schemexm.h +++ b/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) diff --git a/src/racket/src/struct.c b/src/racket/src/struct.c index 73c317650a..f59d69425a 100644 --- a/src/racket/src/struct.c +++ b/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])) {