From 86fd17197c1168a26960f908df7c904b2ca3a67a Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 28 Feb 2010 12:00:53 +0100 Subject: [PATCH] Function get_string_start_end() rewritten to provide more useful error messages --- src/c/file.d | 66 ++++++++------------- src/c/pathname.d | 9 +-- src/c/read.d | 7 ++- src/c/string.d | 150 +++++++++++++++++++++++++---------------------- src/h/external.h | 1 - src/h/internal.h | 5 ++ 6 files changed, 120 insertions(+), 118 deletions(-) diff --git a/src/c/file.d b/src/c/file.d index 31aa5427b..bf413b95c 100755 --- a/src/c/file.d +++ b/src/c/file.d @@ -85,27 +85,27 @@ static ecl_off_t ecl_integer_to_off_t(cl_object offset); static cl_object alloc_stream(); -static cl_object not_a_file_stream(cl_object fn); -static void not_an_input_stream(cl_object fn); -static void not_an_output_stream(cl_object fn); -static void not_a_character_stream(cl_object s); -static void not_a_binary_stream(cl_object s); -static int restartable_io_error(cl_object strm); +static cl_object not_a_file_stream(cl_object fn) ecl_attr_noreturn; +static void not_an_input_stream(cl_object fn) ecl_attr_noreturn; +static void not_an_output_stream(cl_object fn) ecl_attr_noreturn; +static void not_a_character_stream(cl_object s) ecl_attr_noreturn; +static void not_a_binary_stream(cl_object s) ecl_attr_noreturn; +static int restartable_io_error(cl_object strm) ecl_attr_noreturn; static void unread_error(cl_object strm); static void unread_twice(cl_object strm); -static void io_error(cl_object strm); -static void character_size_overflow(cl_object strm, ecl_character c); +static void io_error(cl_object strm) ecl_attr_noreturn; +static void character_size_overflow(cl_object strm, ecl_character c) ecl_attr_noreturn; #ifdef ECL_UNICODE -static void unsupported_character(cl_object strm); -static void malformed_character(cl_object strm); +static void unsupported_character(cl_object strm) ecl_attr_noreturn; +static void malformed_character(cl_object strm) ecl_attr_noreturn; static void too_long_utf8_sequence(cl_object strm); -static void invalid_codepoint(cl_object strm, cl_fixnum c); +static void invalid_codepoint(cl_object strm, cl_fixnum c) ecl_attr_noreturn; #endif -static void wrong_file_handler(cl_object strm); - +static void wrong_file_handler(cl_object strm) ecl_attr_noreturn; #if defined(ECL_WSOCK) -static void wsock_error( const char *err_msg, cl_object strm ); +static void wsock_error( const char *err_msg, cl_object strm ) ecl_attr_noreturn; #endif + /********************************************************************** * NOT IMPLEMENTED or NOT APPLICABLE OPERATIONS */ @@ -1191,7 +1191,7 @@ clos_stream_read_char(cl_object strm) return EOF; else value = -1; - if (value < 0 || value > CHAR_CODE_LIMIT) + unlikely_if (value < 0 || value > CHAR_CODE_LIMIT) FEerror("Unknown character ~A", 1, output); return value; } @@ -1433,7 +1433,7 @@ cl_object si_make_string_output_stream_from_string(cl_object s) { cl_object strm = alloc_stream(); - if (!ecl_stringp(s) || !ECL_ARRAY_HAS_FILL_POINTER_P(s)) + unlikely_if (!ECL_STRINGP(s) || !ECL_ARRAY_HAS_FILL_POINTER_P(s)) FEerror("~S is not a -string with a fill-pointer.", 1, s); strm->stream.ops = duplicate_dispatch_table(&str_out_ops); strm->stream.mode = (short)smm_string_output; @@ -1496,8 +1496,9 @@ cl_object cl_get_output_stream_string(cl_object strm) { cl_object strng; - if (ecl_unlikely(!ECL_ANSI_STREAM_TYPE_P(strm, smm_string_output))) - FEerror("~S is not a string-output stream.", 1, strm); + unlikely_if (!ECL_ANSI_STREAM_TYPE_P(strm, smm_string_output)) + FEwrong_type_only_arg(@[get-output-stream-string], + strm, @[string-stream]); strng = cl_copy_seq(STRING_OUTPUT_STRING(strm)); STRING_OUTPUT_STRING(strm)->base_string.fillp = 0; @(return strng) @@ -1645,29 +1646,12 @@ ecl_make_string_input_stream(cl_object strng, cl_index istart, cl_index iend) } @(defun make_string_input_stream (strng &o istart iend) - cl_index s, e; + cl_index_pair p; @ strng = cl_string(strng); - if (Null(istart)) - s = 0; - else if (!FIXNUMP(istart) || FIXNUM_MINUSP(istart)) - goto E; - else - s = (cl_index)fix(istart); - if (Null(iend)) - e = strng->base_string.fillp; - else if (!FIXNUMP(iend) || FIXNUM_MINUSP(iend)) - goto E; - else - e = (cl_index)fix(iend); - if (e > strng->base_string.fillp || s > e) - goto E; - @(return (ecl_make_string_input_stream(strng, s, e))) - -E: - FEerror("~S and ~S are illegal as :START and :END~%\ -for the string ~S.", - 3, istart, iend, strng); + if (Null(istart)) istart = MAKE_FIXNUM(0); + p = ecl_vector_start_end(@[make-string-input-stream], strng, istart, iend); + @(return (ecl_make_string_input_stream(strng, p.start, p.end))) @) /********************************************************************** @@ -3593,7 +3577,7 @@ winsock_stream_read_byte8(cl_object strm, unsigned char *c, cl_index n) ecl_disable_interrupts(); len = recv(s, c, n, 0); if (len == SOCKET_ERROR ) - wsock_error( "Cannot read bytes from Windows socket ~S.~%~A", strm); + wsock_error("Cannot read bytes from Windows socket ~S.~%~A", strm); ecl_enable_interrupts(); } } @@ -3651,7 +3635,7 @@ winsock_stream_listen(cl_object strm) ecl_disable_interrupts(); result = select( 0, &fds, NULL, NULL, &tv ); if ( result == SOCKET_ERROR ) - wsock_error( "Cannot listen on Windows socket ~S.~%~A", strm ); + wsock_error("Cannot listen on Windows socket ~S.~%~A", strm ); ecl_enable_interrupts(); return ( result > 0 ? ECL_LISTEN_AVAILABLE diff --git a/src/c/pathname.d b/src/c/pathname.d index c0a752772..34c4f6f7c 100644 --- a/src/c/pathname.d +++ b/src/c/pathname.d @@ -1036,7 +1036,6 @@ cl_namestring(cl_object x) &o host (defaults si_default_pathname_defaults()) &k (start MAKE_FIXNUM(0)) end junk_allowed &a output) - cl_index s, e, ee; @ if (host != Cnil) { host = cl_string(host); @@ -1045,6 +1044,8 @@ cl_namestring(cl_object x) output = cl_pathname(thing); } else { cl_object default_host = host; + cl_index_pair p; + cl_index ee; if (default_host == Cnil && defaults != Cnil) { defaults = cl_pathname(defaults); default_host = defaults->pathname.host; @@ -1052,10 +1053,10 @@ cl_namestring(cl_object x) #ifdef ECL_UNICODE thing = si_coerce_to_base_string(thing); #endif - get_string_start_end(thing, start, end, &s, &e); - output = ecl_parse_namestring(thing, s, e, &ee, default_host); + p = ecl_vector_start_end(@[parse-namestring], thing, start, end); + output = ecl_parse_namestring(thing, p.start, p.end, &ee, default_host); start = MAKE_FIXNUM(ee); - if (output == Cnil || ee != e) { + if (output == Cnil || ee != p.end) { if (Null(junk_allowed)) { FEparse_error("Cannot parse the namestring ~S~%" "from ~S to ~S.", Cnil, diff --git a/src/c/read.d b/src/c/read.d index f0c5971f8..354b13ee7 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -1832,13 +1832,18 @@ EOFCHK: if (c == EOF && TOKEN_STRING_FILLP(token) == 0) { unlikely_if (!ECL_STRINGP(strng)) { FEwrong_type_nth_arg(@[parse-integer], 1, strng, @[string]); } - get_string_start_end(strng, start, end, &s, &e); unlikely_if (!FIXNUMP(radix) || ecl_fixnum_lower(radix, MAKE_FIXNUM(2)) || ecl_fixnum_greater(radix, MAKE_FIXNUM(36))) { FEerror("~S is an illegal radix.", 1, radix); } + { + cl_index_pair p = + ecl_vector_start_end(@[parse-integer], strng, start, end); + s = p.start; + e = p.end; + } while (s < e && ecl_readtable_get(rtbl, ecl_char(strng, s), NULL) == cat_whitespace) { s++; diff --git a/src/c/string.d b/src/c/string.d index d982eafc9..e92c875e6 100644 --- a/src/c/string.d +++ b/src/c/string.d @@ -18,6 +18,7 @@ #include #include +#include #include typedef ecl_character (*ecl_casefun)(ecl_character, bool *); @@ -354,32 +355,36 @@ ecl_char_set(cl_object object, cl_index index, ecl_character value) } } -void -get_string_start_end(cl_object string, cl_object start, cl_object end, - cl_index *ps, cl_index *pe) +cl_index_pair +ecl_vector_start_end(cl_object fun, + cl_object string, cl_object start, cl_object end) { /* INV: works on both t_base_string and t_string */ /* INV: Works with either string or symbol */ - if (!FIXNUMP(start) || FIXNUM_MINUSP(start)) - goto E; - else - *ps = fix(start); + cl_index_pair p; + unlikely_if (!ECL_FIXNUMP(start) || ecl_fixnum_minusp(start)) { + FEwrong_type_key_arg(fun, @[:start], start, @[byte]); + } + p.start = fix(start); if (Null(end)) { - *pe = string->vector.fillp; - if (*pe < *ps) - goto E; - } else if (!FIXNUMP(end) || FIXNUM_MINUSP(end)) - goto E; - else { - *pe = fix(end); - if (*pe < *ps || *pe > string->vector.fillp) - goto E; + p.end = string->vector.fillp; + } else { + unlikely_if (!FIXNUMP(end) || ecl_fixnum_minusp(end)) { + FEwrong_type_key_arg(fun, @[:end], end, + ecl_read_from_cstring("(OR NULL BYTE)")); + } + p.end = fix(end); + unlikely_if (p.end > string->vector.fillp) { + cl_object fillp = MAKE_FIXNUM(string->vector.fillp); + FEwrong_type_key_arg(fun, @[:end], end, + ecl_make_integer_type(start, fillp)); + } } - return; - -E: - FEerror("~S and ~S are illegal as :START and :END~%\ -for the string designator ~S.", 3, start, end, string); + unlikely_if (p.end < p.start) { + FEwrong_type_key_arg(fun, @[:start], start, + ecl_make_integer_type(MAKE_FIXNUM(0), end)); + } + return p; } #ifdef ECL_UNICODE @@ -451,13 +456,16 @@ compare_base(unsigned char *s1, cl_index l1, unsigned char *s2, cl_index l2, @(defun string= (string1 string2 &key (start1 MAKE_FIXNUM(0)) end1 (start2 MAKE_FIXNUM(0)) end2) + cl_index_pair p; cl_index s1, e1, s2, e2; @ AGAIN: string1 = cl_string(string1); string2 = cl_string(string2); - get_string_start_end(string1, start1, end1, &s1, &e1); - get_string_start_end(string2, start2, end2, &s2, &e2); + p = ecl_vector_start_end(@[string=], string1, start1, end1); + s1 = p.start; e1 = p.end; + p = ecl_vector_start_end(@[string=], string2, start2, end2); + s2 = p.start; e2 = p.end; if (e1 - s1 != e2 - s2) @(return Cnil) #ifdef ECL_UNICODE @@ -548,13 +556,16 @@ ecl_string_eq(cl_object x, cl_object y) @(defun string_equal (string1 string2 &key (start1 MAKE_FIXNUM(0)) end1 (start2 MAKE_FIXNUM(0)) end2) cl_index s1, e1, s2, e2; + cl_index_pair p; int output; @ AGAIN: string1 = cl_string(string1); string2 = cl_string(string2); - get_string_start_end(string1, start1, end1, &s1, &e1); - get_string_start_end(string2, start2, end2, &s2, &e2); + p = ecl_vector_start_end(@[string=], string1, start1, end1); + s1 = p.start; e1 = p.end; + p = ecl_vector_start_end(@[string=], string2, start2, end2); + s2 = p.start; e2 = p.end; if (e1 - s1 != e2 - s2) @(return Cnil); #ifdef ECL_UNICODE @@ -574,6 +585,7 @@ string_compare(cl_narg narg, int sign1, int sign2, int case_sensitive, cl_va_lis cl_object string1 = cl_va_arg(ARGS); cl_object string2 = cl_va_arg(ARGS); cl_index s1, e1, s2, e2; + cl_index_pair p; int output; cl_object result; cl_object KEYS[4]; @@ -596,8 +608,10 @@ string_compare(cl_narg narg, int sign1, int sign2, int case_sensitive, cl_va_lis string2 = cl_string(string2); if (start1p == Cnil) start1 = MAKE_FIXNUM(0); if (start2p == Cnil) start2 = MAKE_FIXNUM(0); - get_string_start_end(string1, start1, end1, &s1, &e1); - get_string_start_end(string2, start2, end2, &s2, &e2); + p = ecl_vector_start_end(@[string=], string1, start1, end1); + s1 = p.start; e1 = p.end; + p = ecl_vector_start_end(@[string=], string2, start2, end2); + s2 = p.start; e2 = p.end; #ifdef ECL_UNICODE if (ECL_EXTENDED_STRING_P(string1) || ECL_EXTENDED_STRING_P(string2)) { output = compare_strings(string1, s1, e1, string2, s2, e2, @@ -759,16 +773,16 @@ cl_string_right_trim(cl_object char_bag, cl_object strng) } static cl_object -string_case(cl_narg narg, ecl_casefun casefun, cl_va_list ARGS) +string_case(cl_narg narg, cl_object fun, ecl_casefun casefun, cl_va_list ARGS) { cl_object strng = cl_va_arg(ARGS); - cl_index s, e, i; + cl_index_pair p; + cl_index i; bool b; cl_object KEYS[2]; -#define start KEY_VARS[0] -#define end KEY_VARS[1] -#define startp KEY_VARS[2] - cl_object conv; +#define kstart KEY_VARS[0] +#define kend KEY_VARS[1] +#define kstartp KEY_VARS[2] cl_object KEY_VARS[4]; if (narg < 1) FEwrong_num_arguments_anonym(); @@ -776,31 +790,24 @@ string_case(cl_narg narg, ecl_casefun casefun, cl_va_list ARGS) KEYS[1]=@':end'; cl_parse_key(ARGS, 2, KEYS, KEY_VARS, NULL, FALSE); - strng = cl_string(strng); - conv = cl_copy_seq(strng); - if (startp == Cnil) - start = MAKE_FIXNUM(0); - get_string_start_end(conv, start, end, &s, &e); + strng = cl_string(strng); + strng = cl_copy_seq(strng); + if (kstartp == Cnil) + kstart = MAKE_FIXNUM(0); + p = ecl_vector_start_end(fun, strng, kstart, kend); b = TRUE; #ifdef ECL_UNICODE - switch(type_of(conv)) { - case t_string: - for (i = s; i < e; i++) - conv->string.self[i] = (*casefun)(conv->string.self[i], &b); - break; - case t_base_string: - for (i = s; i < e; i++) - conv->base_string.self[i] = (*casefun)(conv->base_string.self[i], &b); - break; - } -#else - for (i = s; i < e; i++) - conv->base_string.self[i] = (*casefun)(conv->base_string.self[i], &b); + if (ECL_EXTENDED_STRING_(strng)) { + for (i = p.start; i < p.end; i++) + strng->string.self[i] = (*casefun)(strng->string.self[i], &b); + } else #endif - @(return conv) -#undef startp -#undef start -#undef end + for (i = p.start; i < p.end; i++) + strng->base_string.self[i] = (*casefun)(strng->base_string.self[i], &b); + @(return strng) +#undef kstartp +#undef kstart +#undef kend } static ecl_character @@ -811,7 +818,7 @@ char_upcase(ecl_character c, bool *bp) @(defun string-upcase (&rest args) @ - return string_case(narg, char_upcase, args); + return string_case(narg, @[string-upcase], char_upcase, args); @) static ecl_character @@ -822,7 +829,7 @@ char_downcase(ecl_character c, bool *bp) @(defun string-downcase (&rest args) @ - return string_case(narg, char_downcase, args); + return string_case(narg, @[string-downcase], char_downcase, args); @) static ecl_character @@ -844,7 +851,7 @@ char_capitalize(ecl_character c, bool *bp) @(defun string-capitalize (&rest args) @ - return string_case(narg, char_capitalize, args); + return string_case(narg, @[string-capitalize], char_capitalize, args); @) @@ -852,12 +859,13 @@ static cl_object nstring_case(cl_narg narg, cl_object fun, ecl_casefun casefun, cl_va_list ARGS) { cl_object strng = cl_va_arg(ARGS); - cl_index s, e, i; + cl_index_pair p; + cl_index i; bool b; cl_object KEYS[2]; -#define start KEY_VARS[0] -#define end KEY_VARS[1] -#define startp KEY_VARS[2] +#define kstart KEY_VARS[0] +#define kend KEY_VARS[1] +#define kstartp KEY_VARS[2] cl_object KEY_VARS[4]; if (narg < 1) FEwrong_num_arguments_anonym(); @@ -867,22 +875,22 @@ nstring_case(cl_narg narg, cl_object fun, ecl_casefun casefun, cl_va_list ARGS) if (ecl_unlikely(!ECL_STRINGP(strng))) FEwrong_type_nth_arg(fun, 1, strng, @[string]); - if (startp == Cnil) start = MAKE_FIXNUM(0); - get_string_start_end(strng, start, end, &s, &e); + if (kstartp == Cnil) + kstart = MAKE_FIXNUM(0); + p = ecl_vector_start_end(fun, strng, kstart, kend); b = TRUE; #ifdef ECL_UNICODE if (ECL_EXTENDED_STRING_P(strng)) { - for (i = s; i < e; i++) + for (i = p.start; i < p.end; i++) strng->string.self[i] = (*casefun)(strng->string.self[i], &b); } else -#else - for (i = s; i < e; i++) - strng->base_string.self[i] = (*casefun)(strng->base_string.self[i], &b); #endif + for (i = p.start; i < p.end; i++) + strng->base_string.self[i] = (*casefun)(strng->base_string.self[i], &b); @(return strng) -#undef startp -#undef start -#undef end +#undef kstartp +#undef kstart +#undef kend } @(defun nstring-upcase (&rest args) diff --git a/src/h/external.h b/src/h/external.h index 3f16e7cef..28d0389c0 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -1550,7 +1550,6 @@ extern ECL_API cl_object ecl_cstring_to_base_string_or_nil(const char *s); extern ECL_API bool ecl_string_eq(cl_object x, cl_object y); extern ECL_API bool ecl_member_char(ecl_character c, cl_object char_bag); extern ECL_API ecl_character ecl_string_push_extend(cl_object s, ecl_character c); -extern ECL_API void get_string_start_end(cl_object s, cl_object start, cl_object end, cl_index *ps, cl_index *pe); extern ECL_API bool ecl_fits_in_base_string(cl_object s); extern ECL_API ecl_character ecl_char(cl_object s, cl_index i); extern ECL_API ecl_character ecl_char_set(cl_object s, cl_index i, ecl_character c); diff --git a/src/h/internal.h b/src/h/internal.h index b20c28a78..6dfe032a8 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -298,6 +298,11 @@ extern void cl_write_object(cl_object x, cl_object stream); #define RTABSIZE CHAR_CODE_LIMIT /* read table size */ #endif +/* string.d */ +typedef struct { cl_index start, end; } cl_index_pair; +extern ECL_API cl_index_pair ecl_vector_start_end(cl_object fun, cl_object s, cl_object start, cl_object end); + + /* threads.d */ #ifdef ECL_THREADS