Mercurial > hg > xemacs-beta
changeset 5307:c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
src/ChangeLog addition:
2010-11-20 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.c (Fexpand_abbrev):
* alloc.c:
* alloc.c (Fmake_list):
* alloc.c (Fmake_vector):
* alloc.c (Fmake_bit_vector):
* alloc.c (Fmake_byte_code):
* alloc.c (Fmake_string):
* alloc.c (vars_of_alloc):
* bytecode.c (UNUSED):
* bytecode.c (Fbyte_code):
* chartab.c (decode_char_table_range):
* cmds.c (Fself_insert_command):
* data.c (check_integer_range):
* data.c (Fnatnump):
* data.c (Fnonnegativep):
* data.c (Fstring_to_number):
* elhash.c (hash_table_size_validate):
* elhash.c (decode_hash_table_size):
* eval.c (Fbacktrace_frame):
* event-stream.c (lisp_number_to_milliseconds):
* event-stream.c (Faccept_process_output):
* event-stream.c (Frecent_keys):
* event-stream.c (Fdispatch_event):
* events.c (Fmake_event):
* events.c (Fevent_timestamp):
* events.c (Fevent_timestamp_lessp):
* events.h:
* events.h (struct command_builder):
* file-coding.c (gzip_putprop):
* fns.c:
* fns.c (check_sequence_range):
* fns.c (Frandom):
* fns.c (Fnthcdr):
* fns.c (Flast):
* fns.c (Fnbutlast):
* fns.c (Fbutlast):
* fns.c (Fmember):
* fns.c (Ffill):
* fns.c (Freduce):
* fns.c (replace_string_range_1):
* fns.c (Freplace):
* font-mgr.c (Ffc_pattern_get):
* frame-msw.c (msprinter_set_frame_properties):
* glyphs.c (check_valid_xbm_inline):
* indent.c (Fmove_to_column):
* intl-win32.c (mswindows_multibyte_to_unicode_putprop):
* lisp.h:
* lisp.h (ARRAY_DIMENSION_LIMIT):
* lread.c (decode_mode_1):
* mule-ccl.c (ccl_get_compiled_code):
* number.h:
* process-unix.c (unix_open_multicast_group):
* process.c (Fset_process_window_size):
* profile.c (Fstart_profiling):
* unicode.c (Funicode_to_char):
Change NATNUMP to return 1 for positive bignums; changes uses of
it and of CHECK_NATNUM appropriately, usually by checking for an
integer in an appropriate range.
Add array-dimension-limit and use it in #'make-vector,
#'make-string. Add array-total-size-limit, array-rank-limit while
we're at it, for the sake of any Common Lisp-oriented code that
uses these limits.
Rename check_int_range to check_integer_range, have it take
Lisp_Objects (and thus bignums) instead.
Remove bignum_butlast(), just set int_n to an appropriately large
integer if N is a bignum.
Accept bignums in check_sequence_range(), change the functions
that use check_sequence_range() appropriately.
Move the definition of NATNUMP() to number.h; document why it's a
reasonable name, contradicting an old comment.
tests/ChangeLog addition:
2010-11-20 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
* automated/lisp-tests.el (featurep):
* automated/lisp-tests.el (wrong-type-argument):
* automated/mule-tests.el (featurep):
Check for args-out-of-range errors instead of wrong-type-argument
errors in various places when code is handed a large bignum
instead of a fixnum.
Also check for the wrong-type-argument errors when giving the same
code a non-integer value.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sat, 20 Nov 2010 16:49:11 +0000 |
parents | cde1608596d0 |
children | 17c381a2f377 |
files | src/ChangeLog src/abbrev.c src/alloc.c src/bytecode.c src/chartab.c src/cmds.c src/data.c src/elhash.c src/eval.c src/event-stream.c src/events.c src/events.h src/file-coding.c src/fileio.c src/fns.c src/font-mgr.c src/frame-msw.c src/glyphs.c src/indent.c src/intl-win32.c src/lisp.h src/lread.c src/mule-ccl.c src/number.h src/process-unix.c src/process.c src/profile.c src/unicode.c tests/ChangeLog tests/automated/lisp-tests.el tests/automated/mule-tests.el |
diffstat | 31 files changed, 591 insertions(+), 213 deletions(-) [+] |
line wrap: on
line diff
--- a/src/ChangeLog Wed Nov 17 14:37:26 2010 +0000 +++ b/src/ChangeLog Sat Nov 20 16:49:11 2010 +0000 @@ -1,3 +1,76 @@ +2010-11-20 Aidan Kehoe <kehoea@parhasard.net> + + * abbrev.c (Fexpand_abbrev): + * alloc.c: + * alloc.c (Fmake_list): + * alloc.c (Fmake_vector): + * alloc.c (Fmake_bit_vector): + * alloc.c (Fmake_byte_code): + * alloc.c (Fmake_string): + * alloc.c (vars_of_alloc): + * bytecode.c (UNUSED): + * bytecode.c (Fbyte_code): + * chartab.c (decode_char_table_range): + * cmds.c (Fself_insert_command): + * data.c (check_integer_range): + * data.c (Fnatnump): + * data.c (Fnonnegativep): + * data.c (Fstring_to_number): + * elhash.c (hash_table_size_validate): + * elhash.c (decode_hash_table_size): + * eval.c (Fbacktrace_frame): + * event-stream.c (lisp_number_to_milliseconds): + * event-stream.c (Faccept_process_output): + * event-stream.c (Frecent_keys): + * event-stream.c (Fdispatch_event): + * events.c (Fmake_event): + * events.c (Fevent_timestamp): + * events.c (Fevent_timestamp_lessp): + * events.h: + * events.h (struct command_builder): + * file-coding.c (gzip_putprop): + * fns.c: + * fns.c (check_sequence_range): + * fns.c (Frandom): + * fns.c (Fnthcdr): + * fns.c (Flast): + * fns.c (Fnbutlast): + * fns.c (Fbutlast): + * fns.c (Fmember): + * fns.c (Ffill): + * fns.c (Freduce): + * fns.c (replace_string_range_1): + * fns.c (Freplace): + * font-mgr.c (Ffc_pattern_get): + * frame-msw.c (msprinter_set_frame_properties): + * glyphs.c (check_valid_xbm_inline): + * indent.c (Fmove_to_column): + * intl-win32.c (mswindows_multibyte_to_unicode_putprop): + * lisp.h: + * lisp.h (ARRAY_DIMENSION_LIMIT): + * lread.c (decode_mode_1): + * mule-ccl.c (ccl_get_compiled_code): + * number.h: + * process-unix.c (unix_open_multicast_group): + * process.c (Fset_process_window_size): + * profile.c (Fstart_profiling): + * unicode.c (Funicode_to_char): + Change NATNUMP to return 1 for positive bignums; changes uses of + it and of CHECK_NATNUM appropriately, usually by checking for an + integer in an appropriate range. + Add array-dimension-limit and use it in #'make-vector, + #'make-string. Add array-total-size-limit, array-rank-limit while + we're at it, for the sake of any Common Lisp-oriented code that + uses these limits. + Rename check_int_range to check_integer_range, have it take + Lisp_Objects (and thus bignums) instead. + Remove bignum_butlast(), just set int_n to an appropriately large + integer if N is a bignum. + Accept bignums in check_sequence_range(), change the functions + that use check_sequence_range() appropriately. + Move the definition of NATNUMP() to number.h; document why it's a + reasonable name, contradicting an old comment. + 2010-11-17 Aidan Kehoe <kehoea@parhasard.net> * fns.c (bignum_butlast): New.
--- a/src/abbrev.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/abbrev.c Sat Nov 20 16:49:11 2010 +0000 @@ -343,7 +343,7 @@ count = Qzero; else CHECK_NATNUM (count); - symbol_plist (abbrev_symbol) = make_int (1 + XINT (count)); + symbol_plist (abbrev_symbol) = Fadd1 (count); /* Count the case in the original text. */ abbrev_count_case (buf, abbrev_start, abbrev_length, &lccount, &uccount);
--- a/src/alloc.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/alloc.c Sat Nov 20 16:49:11 2010 +0000 @@ -96,6 +96,8 @@ static Fixnum debug_allocation_backtrace_length; #endif +Fixnum Varray_dimension_limit, Varray_total_size_limit, Varray_rank_limit; + int need_to_check_c_alloca; int need_to_signal_post_gc; int funcall_allocation_flag; @@ -1500,16 +1502,17 @@ */ (length, object)) { - CHECK_NATNUM (length); - - { - Lisp_Object val = Qnil; - EMACS_INT size = XINT (length); - - while (size--) - val = Fcons (object, val); - return val; - } + Lisp_Object val = Qnil; + Elemcount size; + + check_integer_range (length, Qzero, make_integer (EMACS_INT_MAX)); + + size = XINT (length); + + while (size--) + val = Fcons (object, val); + + return val; } @@ -1743,7 +1746,7 @@ */ (length, object)) { - CONCHECK_NATNUM (length); + check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT)); return make_vector (XINT (length), object); } @@ -1925,8 +1928,7 @@ */ (length, bit)) { - CONCHECK_NATNUM (length); - + check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT)); return make_bit_vector (XINT (length), bit); } @@ -2052,7 +2054,7 @@ CHECK_VECTOR (constants); f->constants = constants; - CHECK_NATNUM (stack_depth); + check_integer_range (stack_depth, Qzero, make_int (USHRT_MAX)); f->stack_depth = (unsigned short) XINT (stack_depth); #ifdef COMPILED_FUNCTION_ANNOTATION_HACK @@ -2884,7 +2886,7 @@ */ (length, character)) { - CHECK_NATNUM (length); + check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT)); CHECK_CHAR_COERCE_INT (character); { Ibyte init_str[MAX_ICHAR_LEN]; @@ -5739,6 +5741,34 @@ void vars_of_alloc (void) { + DEFVAR_CONST_INT ("array-rank-limit", &Varray_rank_limit /* +The exclusive upper bound on the number of dimensions an array may have. + +XEmacs does not support multidimensional arrays, meaning this constant is, +for the moment, 2. +*/); + Varray_rank_limit = 2; + + DEFVAR_CONST_INT ("array-dimension-limit", &Varray_dimension_limit /* +The exclusive upper bound of an array's dimension. +Note that XEmacs may not have enough memory available to create an array +with this dimension. +*/); + Varray_dimension_limit = ARRAY_DIMENSION_LIMIT; + + DEFVAR_CONST_INT ("array-total-size-limit", &Varray_total_size_limit /* +The exclusive upper bound on the number of elements an array may contain. + +In Common Lisp, this is distinct from `array-dimension-limit', because +arrays can have more than one dimension. In XEmacs this is not the case, +and multi-dimensional arrays need to be implemented by the user with arrays +of arrays. + +Note that XEmacs may not have enough memory available to create an array +with this dimension. +*/); + Varray_total_size_limit = ARRAY_DIMENSION_LIMIT; + #ifdef DEBUG_XEMACS DEFVAR_INT ("debug-allocation", &debug_allocation /* If non-zero, print out information to stderr about all objects allocated.
--- a/src/bytecode.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/bytecode.c Sat Nov 20 16:49:11 2010 +0000 @@ -1731,8 +1731,9 @@ { Lisp_Object upper = POP, first = TOP, speccount; - CHECK_NATNUM (upper); - CHECK_NATNUM (first); + check_integer_range (upper, Qzero, + make_integer (Vmultiple_values_limit)); + check_integer_range (first, Qzero, upper); speccount = make_int (bind_multiple_value_limits (XINT (first), XINT (upper))); @@ -2757,7 +2758,7 @@ CHECK_STRING (instructions); CHECK_VECTOR (constants); - CHECK_NATNUM (stack_depth); + check_integer_range (stack_depth, Qzero, make_int (USHRT_MAX)); /* Optimize the `instructions' string, just like when executing a regular compiled function, but don't save it for later since this is
--- a/src/chartab.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/chartab.c Sat Nov 20 16:49:11 2010 +0000 @@ -257,10 +257,12 @@ sferror ("Charset in row vector must be multi-byte", outrange->charset); case CHARSET_TYPE_94X94: - check_int_range (outrange->row, 33, 126); + check_integer_range (make_int (outrange->row), make_int (33), + make_int (126)); break; case CHARSET_TYPE_96X96: - check_int_range (outrange->row, 32, 127); + check_integer_range (make_int (outrange->row), make_int (32), + make_int (127)); break; default: ABORT ();
--- a/src/cmds.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/cmds.c Sat Nov 20 16:49:11 2010 +0000 @@ -334,7 +334,9 @@ Lisp_Object c; EMACS_INT n; - CHECK_NATNUM (count); + /* Can't insert more than most-positive-fixnum characters, the buffer + won't hold that many. */ + check_integer_range (count, Qzero, make_int (EMACS_INT_MAX)); n = XINT (count); if (CHAR_OR_CHAR_INTP (Vlast_command_char))
--- a/src/data.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/data.c Sat Nov 20 16:49:11 2010 +0000 @@ -158,10 +158,18 @@ } void -check_int_range (EMACS_INT val, EMACS_INT min, EMACS_INT max) +check_integer_range (Lisp_Object val, Lisp_Object min, Lisp_Object max) { - if (val < min || val > max) - args_out_of_range_3 (make_int (val), make_int (min), make_int (max)); + Lisp_Object args[] = { min, val, max }; + int ii; + + for (ii = 0; ii < countof (args); ii++) + { + CHECK_INTEGER (args[ii]); + } + + if (NILP (Fleq (countof (args), args))) + args_out_of_range_3 (val, min, max); } @@ -504,11 +512,7 @@ */ (object)) { - return NATNUMP (object) -#ifdef HAVE_BIGNUM - || (BIGNUMP (object) && bignum_sign (XBIGNUM_DATA (object)) >= 0) -#endif - ? Qt : Qnil; + return NATNUMP (object) ? Qt : Qnil; } DEFUN ("nonnegativep", Fnonnegativep, 1, 1, 0, /* @@ -517,9 +521,6 @@ (object)) { return NATNUMP (object) -#ifdef HAVE_BIGNUM - || (BIGNUMP (object) && bignum_sign (XBIGNUM_DATA (object)) >= 0) -#endif #ifdef HAVE_RATIO || (RATIOP (object) && ratio_sign (XRATIO_DATA (object)) >= 0) #endif @@ -1295,9 +1296,8 @@ b = 10; else { - CHECK_INT (base); + check_integer_range (base, make_int (2), make_int (16)); b = XINT (base); - check_int_range (b, 2, 16); } p = XSTRING_DATA (string);
--- a/src/elhash.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/elhash.c Sat Nov 20 16:49:11 2010 +0000 @@ -733,10 +733,27 @@ Error_Behavior errb) { if (NATNUMP (value)) - return 1; + { + if (BIGNUMP (value)) + { + /* hash_table_size() can't handle excessively large sizes. */ + maybe_signal_error_1 (Qargs_out_of_range, + list3 (value, Qzero, + make_integer (EMACS_INT_MAX)), + Qhash_table, errb); + return 0; + } + else + { + return 1; + } + } + else + { + maybe_signal_error_1 (Qwrong_type_argument, list2 (Qnatnump, value), + Qhash_table, errb); + } - maybe_signal_error_1 (Qwrong_type_argument, list2 (Qnatnump, value), - Qhash_table, errb); return 0; }
--- a/src/eval.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/eval.c Sat Nov 20 16:49:11 2010 +0000 @@ -4923,17 +4923,19 @@ } argv[0] = IGNORE_MULTIPLE_VALUES (Feval (XCAR (args))); - CHECK_NATNUM (argv[0]); - first = XINT (argv[0]); GCPRO1 (argv[0]); gcpro1.nvars = 1; args = XCDR (args); - argv[1] = IGNORE_MULTIPLE_VALUES (Feval (XCAR (args))); - CHECK_NATNUM (argv[1]); + + check_integer_range (argv[1], Qzero, make_int (EMACS_INT_MAX)); + check_integer_range (argv[0], Qzero, argv[1]); + upper = XINT (argv[1]); + first = XINT (argv[0]); + gcpro1.nvars = 2; /* The unintuitive order of things here is for the sake of the bytecode; @@ -7205,7 +7207,7 @@ REGISTER int i; Lisp_Object tem; - CHECK_NATNUM (nframes); + check_integer_range (nframes, Qzero, make_integer (EMACS_INT_MAX)); /* Find the frame requested. */ for (i = XINT (nframes); backlist && (i-- > 0);)
--- a/src/event-stream.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/event-stream.c Sat Nov 20 16:49:11 2010 +0000 @@ -1238,18 +1238,30 @@ static unsigned long lisp_number_to_milliseconds (Lisp_Object secs, int allow_0) { - double fsecs; - CHECK_INT_OR_FLOAT (secs); - fsecs = XFLOATINT (secs); - if (fsecs < 0) - invalid_argument ("timeout is negative", secs); - if (!allow_0 && fsecs == 0) - invalid_argument ("timeout is non-positive", secs); - if (fsecs >= (((unsigned int) 0xFFFFFFFF) / 1000)) - invalid_argument - ("timeout would exceed 32 bits when represented in milliseconds", secs); - - return (unsigned long) (1000 * fsecs); + Lisp_Object args[] = { allow_0 ? Qzero : make_int (1), + secs, + /* (((unsigned int) 0xFFFFFFFF) / 1000) - 1 */ + make_int (4294967 - 1) }; + + if (!allow_0 && FLOATP (secs) && XFLOAT_DATA (secs) > 0) + { + args[0] = secs; + } + + if (NILP (Fleq (countof (args), args))) + { + args_out_of_range_3 (secs, args[0], args[2]); + } + + args[0] = make_int (1000); + args[0] = Ftimes (2, args); + + if (INTP (args[0])) + { + return XINT (args[0]); + } + + return (unsigned long) extract_float (args[0]); } DEFUN ("add-timeout", Fadd_timeout, 3, 4, 0, /* @@ -2615,7 +2627,8 @@ msecs = lisp_number_to_milliseconds (timeout_secs, 1); if (!NILP (timeout_msecs)) { - CHECK_NATNUM (timeout_msecs); + check_integer_range (timeout_msecs, Qzero, + make_integer (EMACS_INT_MAX)); msecs += XINT (timeout_msecs); } if (msecs) @@ -3704,7 +3717,8 @@ nwanted = recent_keys_ring_size; else { - CHECK_NATNUM (number); + check_integer_range (number, Qzero, + make_integer (ARRAY_DIMENSION_LIMIT)); nwanted = XINT (number); } @@ -4519,7 +4533,7 @@ else /* key sequence is bound to a command */ { int magic_undo = 0; - int magic_undo_count = 20; + Elemcount magic_undo_count = 20; Vthis_command = leaf; @@ -4539,7 +4553,21 @@ { Lisp_Object prop = Fget (leaf, Qself_insert_defer_undo, Qnil); if (NATNUMP (prop)) - magic_undo = 1, magic_undo_count = XINT (prop); + { + magic_undo = 1; + if (INTP (prop)) + { + magic_undo_count = XINT (prop); + } +#ifdef HAVE_BIGNUM + else if (BIGNUMP (prop) + && bignum_fits_emacs_int_p (XBIGNUM_DATA (prop))) + { + magic_undo_count + = bignum_to_emacs_int (XBIGNUM_DATA (prop)); + } +#endif + } else if (!NILP (prop)) magic_undo = 1; else if (EQ (leaf, Qself_insert_command))
--- a/src/events.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/events.c Sat Nov 20 16:49:11 2010 +0000 @@ -641,8 +641,7 @@ } else if (EQ (keyword, Qbutton)) { - CHECK_NATNUM (value); - check_int_range (XINT (value), 0, 7); + check_integer_range (value, Qzero, make_int (26)); switch (EVENT_TYPE (e)) { @@ -737,8 +736,23 @@ } else if (EQ (keyword, Qtimestamp)) { - CHECK_NATNUM (value); - SET_EVENT_TIMESTAMP (e, XINT (value)); +#ifdef HAVE_BIGNUM + check_integer_range (value, Qzero, make_integer (UINT_MAX)); + if (BIGNUMP (value)) + { + SET_EVENT_TIMESTAMP (e, bignum_to_uint (XBIGNUM_DATA (value))); + } +#else + check_integer_range (value, Qzero, make_integer (EMACS_INT_MAX)); +#endif + if (INTP (value)) + { + SET_EVENT_TIMESTAMP (e, XINT (value)); + } + else + { + ABORT (); + } } else if (EQ (keyword, Qfunction)) { @@ -1747,7 +1761,9 @@ { CHECK_LIVE_EVENT (event); /* This junk is so that timestamps don't get to be negative, but contain - as many bits as this particular emacs will allow. + as many bits as this particular emacs will allow. We could return + bignums on builds that support them, but that involves consing and + doesn't work on builds that don't support bignums. */ return make_int (EMACS_INT_MAX & XEVENT_TIMESTAMP (event)); } @@ -1763,8 +1779,9 @@ { EMACS_INT t1, t2; - CHECK_NATNUM (time1); - CHECK_NATNUM (time2); + check_integer_range (time1, Qzero, make_integer (EMACS_INT_MAX)); + check_integer_range (time2, Qzero, make_integer (EMACS_INT_MAX)); + t1 = XINT (time1); t2 = XINT (time2);
--- a/src/events.h Wed Nov 17 14:37:26 2010 +0000 +++ b/src/events.h Sat Nov 20 16:49:11 2010 +0000 @@ -1159,7 +1159,7 @@ boundary: up to 20 consecutive self-inserts can happen before an undo- boundary is pushed. This variable is that counter. */ - int self_insert_countdown; + Elemcount self_insert_countdown; }; #endif /* INCLUDED_events_h_ */
--- a/src/file-coding.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/file-coding.c Sat Nov 20 16:49:11 2010 +0000 @@ -4310,8 +4310,7 @@ data->level = -1; else { - CHECK_INT (value); - check_int_range (XINT (value), 0, 9); + check_integer_range (value, Qzero, make_int (9)); data->level = XINT (value); } }
--- a/src/fileio.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/fileio.c Sat Nov 20 16:49:11 2010 +0000 @@ -3294,7 +3294,7 @@ Lisp_Object insval = call1 (p, make_int (inserted)); if (!NILP (insval)) { - CHECK_NATNUM (insval); + check_integer_range (insval, Qzero, make_int (EMACS_INT_MAX)); inserted = XINT (insval); } }
--- a/src/fns.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/fns.c Sat Nov 20 16:49:11 2010 +0000 @@ -78,13 +78,11 @@ check_sequence_range (Lisp_Object sequence, Lisp_Object start, Lisp_Object end, Lisp_Object length) { - Elemcount starting = XINT (start), ending, len = XINT (length); - - ending = NILP (end) ? XINT (length) : XINT (end); - - if (!(0 <= starting && starting <= ending && ending <= len)) - { - args_out_of_range_3 (sequence, start, make_int (ending)); + Lisp_Object args[] = { Qzero, start, NILP (end) ? length : end, length }; + + if (NILP (Fleq (countof (args), args))) + { + args_out_of_range_3 (sequence, start, end); } } @@ -228,6 +226,13 @@ seed_random (qxe_getpid () + time (NULL)); if (NATNUMP (limit) && !ZEROP (limit)) { +#ifdef HAVE_BIGNUM + if (BIGNUMP (limit)) + { + bignum_random (scratch_bignum, XBIGNUM_DATA (limit)); + return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); + } +#endif /* Try to take our random number from the higher bits of VAL, not the lower, since (says Gentzel) the low bits of `random' are less random than the higher ones. We do this by using the @@ -240,13 +245,6 @@ val = get_random () / denominator; while (val >= XINT (limit)); } -#ifdef HAVE_BIGNUM - else if (BIGNUMP (limit)) - { - bignum_random (scratch_bignum, XBIGNUM_DATA (limit)); - return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); - } -#endif else val = get_random (); @@ -1436,7 +1434,7 @@ REGISTER EMACS_INT i; REGISTER Lisp_Object tail = list; CHECK_NATNUM (n); - for (i = XINT (n); i; i--) + for (i = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n); i; i--) { if (CONSP (tail)) tail = XCDR (tail); @@ -1556,7 +1554,7 @@ else { CHECK_NATNUM (n); - int_n = XINT (n); + int_n = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n); } for (retval = tortoise = hare = list, count = 0; @@ -1576,9 +1574,6 @@ return retval; } -static Lisp_Object bignum_butlast (Lisp_Object list, Lisp_Object number, - Boolint copy); - DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /* Modify LIST to remove the last N (default 1) elements. @@ -1593,13 +1588,8 @@ if (!NILP (n)) { - if (BIGNUMP (n)) - { - return bignum_butlast (list, n, 0); - } - CHECK_NATNUM (n); - int_n = XINT (n); + int_n = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n); } if (CONSP (list)) @@ -1646,13 +1636,8 @@ if (!NILP (n)) { - if (BIGNUMP (n)) - { - return bignum_butlast (list, n, 1); - } - CHECK_NATNUM (n); - int_n = XINT (n); + int_n = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n); } if (CONSP (list)) @@ -1686,42 +1671,6 @@ return retval; } -/* This is sufficient to implement #'butlast and #'nbutlast with bignum N - under XEmacs, because #'list-length and #'safe-length can never return a - bignum. This means that #'nbutlast never has to modify and #'butlast - never has to copy. */ -static Lisp_Object -bignum_butlast (Lisp_Object list, Lisp_Object number, Boolint copy) -{ - Boolint malformed = EQ (Fsafe_length (list), Qzero); - Boolint circular = !malformed && EQ (Flist_length (list), Qnil); - - assert (BIGNUMP (number)); - -#ifdef HAVE_BIGNUM - - if (bignum_sign (XBIGNUM_DATA (number)) < 0) - { - dead_wrong_type_argument (Qnatnump, number); - } - - number = Fcanonicalize_number (number); - - if (INTP (number)) - { - return copy ? Fbutlast (list, number) : Fnbutlast (list, number); - } - -#endif - - if (circular) - { - signal_circular_list_error (list); - } - - return Qnil; -} - DEFUN ("member", Fmember, 2, 2, 0, /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'. The value is actually the tail of LIST whose car is ELT. @@ -4224,17 +4173,15 @@ { Lisp_Object sequence = args[0]; Lisp_Object item = args[1]; - Elemcount starting = 0, ending = EMACS_INT_MAX, ii, len; + Elemcount starting = 0, ending = EMACS_INT_MAX + 1, ii, len; PARSE_KEYWORDS (Ffill, nargs, args, 2, (start, end), (start = Qzero)); CHECK_NATNUM (start); - starting = XINT (start); - if (!NILP (end)) { CHECK_NATNUM (end); - ending = XINT (end); + ending = BIGNUMP (end) ? EMACS_INT_MAX + 1 : XINT (end); } retry: @@ -4254,6 +4201,7 @@ check_sequence_range (sequence, start, end, make_int (len)); ending = min (ending, len); + starting = XINT (start); for (ii = starting; ii < ending; ++ii) { @@ -4272,6 +4220,7 @@ check_sequence_range (sequence, start, end, make_int (len)); ending = min (ending, len); + starting = XINT (start); for (ii = starting; ii < ending; ++ii) { @@ -4281,6 +4230,7 @@ else if (LISTP (sequence)) { Elemcount counting = 0; + starting = BIGNUMP (start) ? EMACS_INT_MAX + 1 : XINT (start); EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) { @@ -5235,7 +5185,7 @@ (int nargs, Lisp_Object *args)) { Lisp_Object function = args[0], sequence = args[1], accum = Qunbound; - Elemcount starting, ending = EMACS_INT_MAX, ii = 0; + Elemcount starting, ending = EMACS_INT_MAX + 1, ii = 0; PARSE_KEYWORDS (Freduce, nargs, args, 5, (start, end, from_end, initial_value, key), @@ -5243,7 +5193,7 @@ CHECK_SEQUENCE (sequence); CHECK_NATNUM (start); - + starting = BIGNUMP (start) ? EMACS_INT_MAX + 1 : XINT (start); CHECK_KEY_ARGUMENT (key); #define KEY(key, item) (EQ (Qidentity, key) ? item : \ @@ -5251,16 +5201,10 @@ #define CALL2(function, accum, item) \ IGNORE_MULTIPLE_VALUES (call2 (function, accum, item)) - starting = XINT (start); if (!NILP (end)) { CHECK_NATNUM (end); - ending = XINT (end); - } - - if (!(starting <= ending)) - { - check_sequence_range (sequence, start, end, Flength (sequence)); + ending = BIGNUMP (end) ? EMACS_INT_MAX + 1 : XINT (end); } if (VECTORP (sequence)) @@ -5432,6 +5376,8 @@ check_sequence_range (sequence, start, end, make_int (len)); ending = min (ending, len); + starting = XINT (start); + cursor = string_char_addr (sequence, ending - 1); cursor_offset = cursor - XSTRING_DATA (sequence); @@ -5679,7 +5625,8 @@ Ibyte *destp = XSTRING_DATA (dest), *p = destp, *pend = p + XSTRING_LENGTH (dest), *pcursor, item_buf[MAX_ICHAR_LEN]; Bytecount prefix_bytecount, source_len = source_limit - source; - Charcount ii = 0, starting = XINT (start), ending, len; + Charcount ii = 0, ending, len; + Charcount starting = BIGNUMP (start) ? EMACS_INT_MAX + 1 : XINT (start); Elemcount delta; while (ii < starting && p < pend) @@ -5702,7 +5649,7 @@ } else { - ending = XINT (end); + ending = BIGNUMP (end) ? EMACS_INT_MAX + 1 : XINT (end); while (ii < ending && pcursor < pend) { INC_IBYTEPTR (pcursor); @@ -5782,8 +5729,8 @@ { Lisp_Object sequence1 = args[0], sequence2 = args[1], result = sequence1; - Elemcount starting1, ending1 = EMACS_INT_MAX, starting2; - Elemcount ending2 = EMACS_INT_MAX, counting = 0, startcounting; + Elemcount starting1, ending1 = EMACS_INT_MAX + 1, starting2; + Elemcount ending2 = EMACS_INT_MAX + 1, counting = 0, startcounting; Boolint sequence1_listp, sequence2_listp, overwriting = EQ (sequence1, sequence2); @@ -5796,30 +5743,20 @@ CHECK_SEQUENCE (sequence2); CHECK_NATNUM (start1); - starting1 = XINT (start1); + starting1 = BIGNUMP (start1) ? EMACS_INT_MAX + 1 : XINT (start1); CHECK_NATNUM (start2); - starting2 = XINT (start2); + starting2 = BIGNUMP (start2) ? EMACS_INT_MAX + 1 : XINT (start2); if (!NILP (end1)) { CHECK_NATNUM (end1); - ending1 = XINT (end1); - - if (!(starting1 <= ending1)) - { - args_out_of_range_3 (sequence1, start1, end1); - } + ending1 = BIGNUMP (end1) ? EMACS_INT_MAX + 1 : XINT (end1); } if (!NILP (end2)) { CHECK_NATNUM (end2); - ending2 = XINT (end2); - - if (!(starting2 <= ending2)) - { - args_out_of_range_3 (sequence1, start2, end2); - } + ending2 = BIGNUMP (end2) ? EMACS_INT_MAX + 1 : XINT (end2); } sequence1_listp = LISTP (sequence1);
--- a/src/font-mgr.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/font-mgr.c Sat Nov 20 16:49:11 2010 +0000 @@ -411,6 +411,7 @@ Extbyte *fc_property; FcResult fc_result; FcValue fc_value; + int int_id = 0; /* process arguments @@ -435,14 +436,21 @@ dead_wrong_type_argument (Qstringp, property); } - if (!NILP (id)) CHECK_NATNUM (id); + if (!NILP (id)) + { +#ifdef HAVE_BIGNUM + check_integer_range (id, Qzero, make_integer (INT_MAX)); + int_id = BIGNUMP (id) ? bignum_to_int (id) : XINT (id); +#else + check_integer_range (id, Qzero, make_integer (EMACS_INT_MAX)); + int_id = XINT (id); +#endif + } if (!NILP (type)) CHECK_SYMBOL (type); /* get property */ fc_result = FcPatternGet (XFC_PATTERN_PTR (pattern), - fc_property, - NILP (id) ? 0 : XINT (id), - &fc_value); + fc_property, int_id, &fc_value); switch (fc_result) {
--- a/src/frame-msw.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/frame-msw.c Sat Nov 20 16:49:11 2010 +0000 @@ -1093,8 +1093,15 @@ maybe_error_if_job_active (f); if (!NILP (val)) { - CHECK_NATNUM (val); - FRAME_MSPRINTER_CHARWIDTH (f) = XINT (val); +#ifdef HAVE_BIGNUM + check_integer_range (val, Qzero, make_integer (INT_MAX)); + FRAME_MSPRINTER_CHARWIDTH (f) = + BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : + XINT (val); +#else + CHECK_NATNUM (val); + FRAME_MSPRINTER_CHARWIDTH (f) = XINT (val); +#endif } } if (EQ (prop, Qheight)) @@ -1102,33 +1109,68 @@ maybe_error_if_job_active (f); if (!NILP (val)) { +#ifdef HAVE_BIGNUM + check_integer_range (val, Qzero, make_integer (INT_MAX)); + FRAME_MSPRINTER_CHARHEIGHT (f) = + BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : + XINT (val); +#else CHECK_NATNUM (val); FRAME_MSPRINTER_CHARHEIGHT (f) = XINT (val); +#endif } } else if (EQ (prop, Qleft_margin)) { maybe_error_if_job_active (f); +#ifdef HAVE_BIGNUM + check_integer_range (val, Qzero, make_integer (INT_MAX)); + FRAME_MSPRINTER_LEFT_MARGIN (f) = + BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : + XINT (val); +#else CHECK_NATNUM (val); FRAME_MSPRINTER_LEFT_MARGIN (f) = XINT (val); +#endif } else if (EQ (prop, Qtop_margin)) { maybe_error_if_job_active (f); +#ifdef HAVE_BIGNUM + check_integer_range (val, Qzero, make_integer (INT_MAX)); + FRAME_MSPRINTER_TOP_MARGIN (f) = + BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : + XINT (val); +#else CHECK_NATNUM (val); FRAME_MSPRINTER_TOP_MARGIN (f) = XINT (val); +#endif } else if (EQ (prop, Qright_margin)) { maybe_error_if_job_active (f); +#ifdef HAVE_BIGNUM + check_integer_range (val, Qzero, make_integer (INT_MAX)); + FRAME_MSPRINTER_RIGHT_MARGIN (f) = + BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : + XINT (val); +#else CHECK_NATNUM (val); FRAME_MSPRINTER_RIGHT_MARGIN (f) = XINT (val); +#endif } else if (EQ (prop, Qbottom_margin)) { maybe_error_if_job_active (f); +#ifdef HAVE_BIGNUM + check_integer_range (val, Qzero, make_integer (INT_MAX)); + FRAME_MSPRINTER_BOTTOM_MARGIN (f) = + BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : + XINT (val); +#else CHECK_NATNUM (val); FRAME_MSPRINTER_BOTTOM_MARGIN (f) = XINT (val); +#endif } } }
--- a/src/glyphs.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/glyphs.c Sat Nov 20 16:49:11 2010 +0000 @@ -2630,7 +2630,7 @@ static void check_valid_xbm_inline (Lisp_Object data) { - Lisp_Object width, height, bits; + Lisp_Object width, height, bits, args[2]; if (!CONSP (data) || !CONSP (XCDR (data)) || @@ -2650,7 +2650,16 @@ if (!NATNUMP (height)) invalid_argument ("Height must be a natural number", height); - if (((XINT (width) * XINT (height)) / 8) > string_char_length (bits)) + args[0] = width; + args[1] = height; + + args[0] = Ftimes (countof (args), args); + args[1] = make_integer (8); + + args[0] = Fquo (countof (args), args); + args[1] = make_integer (string_char_length (bits)); + + if (!NILP (Fgtr (countof (args), args))) invalid_argument ("data is too short for width and height", vector3 (width, height, bits)); }
--- a/src/indent.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/indent.c Sat Nov 20 16:49:11 2010 +0000 @@ -412,7 +412,8 @@ buffer = wrap_buffer (buf); if (tab_width <= 0 || tab_width > 1000) tab_width = 8; - CHECK_NATNUM (column); + + check_integer_range (column, Qzero, make_integer (EMACS_INT_MAX)); goal = XINT (column); retry:
--- a/src/intl-win32.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/intl-win32.c Sat Nov 20 16:49:11 2010 +0000 @@ -1792,9 +1792,14 @@ data->cp_type = MULTIBYTE_MAC; else { - CHECK_NATNUM (value); data->locale_type = MULTIBYTE_SPECIFIED_CODE_PAGE; - data->cp = XINT (value); +#ifdef HAVE_BIGNUM + check_integer_range (value, Qzero, make_integer (INT_MAX)); + data->cp = BIGNUMP (value) ? bignum_to_int (XBIGNUM_DATA (value)) : XINT (value); +#else + CHECK_NATNUM (value); + data->cp = XINT (value); +#endif } } else if (EQ (key, Qlocale))
--- a/src/lisp.h Wed Nov 17 14:37:26 2010 +0000 +++ b/src/lisp.h Sat Nov 20 16:49:11 2010 +0000 @@ -1679,6 +1679,10 @@ #define INT_VALBITS (BITS_PER_EMACS_INT - INT_GCBITS) #define VALBITS (BITS_PER_EMACS_INT - GCBITS) +/* This is badly named; it's not the maximum value that an EMACS_INT can + have, it's the maximum value that a Lisp-visible fixnum can have (half + the maximum value an EMACS_INT can have) and as such would be better + called MOST_POSITIVE_FIXNUM. Similarly for MOST_NEGATIVE_FIXNUM. */ #define EMACS_INT_MAX ((EMACS_INT) ((1UL << (INT_VALBITS - 1)) -1UL)) #define EMACS_INT_MIN (-(EMACS_INT_MAX) - 1) /* WARNING: evaluates its arg twice. */ @@ -2923,22 +2927,6 @@ x = wrong_type_argument (Qfixnump, x); \ } while (0) -/* NOTE NOTE NOTE! This definition of "natural number" is mathematically - wrong. Mathematically, a natural number is a positive integer; 0 - isn't included. This would be better called NONNEGINT(). */ - -#define NATNUMP(x) (INTP (x) && XINT (x) >= 0) - -#define CHECK_NATNUM(x) do { \ - if (!NATNUMP (x)) \ - dead_wrong_type_argument (Qnatnump, x); \ -} while (0) - -#define CONCHECK_NATNUM(x) do { \ - if (!NATNUMP (x)) \ - x = wrong_type_argument (Qnatnump, x); \ -} while (0) - END_C_DECLS /* -------------- properties of internally-formatted text ------------- */ @@ -4318,6 +4306,8 @@ void disksave_object_finalization (void); void finish_object_memory_usage_stats (void); extern int purify_flag; +#define ARRAY_DIMENSION_LIMIT EMACS_INT_MAX +extern Fixnum Varray_dimension_limit; #ifndef NEW_GC extern EMACS_INT gc_generation_number[1]; #endif /* not NEW_GC */ @@ -4505,7 +4495,7 @@ MODULE_API Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); MODULE_API DECLARE_DOESNT_RETURN (dead_wrong_type_argument (Lisp_Object, Lisp_Object)); -void check_int_range (EMACS_INT, EMACS_INT, EMACS_INT); +void check_integer_range (Lisp_Object, Lisp_Object, Lisp_Object); EXFUN (Fint_to_char, 1); EXFUN (Fchar_to_int, 1); @@ -4531,11 +4521,11 @@ Qnonnegativep, Qnumber_char_or_marker_p, Qnumberp, Qquote, Qtrue_list_p; extern MODULE_API Lisp_Object Qintegerp; -extern Lisp_Object Qarith_error, Qbeginning_of_buffer, Qbuffer_read_only, - Qcircular_list, Qcircular_property_list, Qconversion_error, - Qcyclic_variable_indirection, Qdomain_error, Qediting_error, - Qend_of_buffer, Qend_of_file, Qerror, Qfile_error, Qinternal_error, - Qinvalid_change, Qinvalid_constant, Qinvalid_function, +extern Lisp_Object Qargs_out_of_range, Qarith_error, Qbeginning_of_buffer, + Qbuffer_read_only, Qcircular_list, Qcircular_property_list, + Qconversion_error, Qcyclic_variable_indirection, Qdomain_error, + Qediting_error, Qend_of_buffer, Qend_of_file, Qerror, Qfile_error, + Qinternal_error, Qinvalid_change, Qinvalid_constant, Qinvalid_function, Qinvalid_keyword_argument, Qinvalid_operation, Qinvalid_read_syntax, Qinvalid_state, Qio_error, Qlist_formation_error, Qmalformed_list, Qmalformed_property_list, Qno_catch, Qout_of_memory, @@ -4544,6 +4534,7 @@ Qstructure_formation_error, Qtext_conversion_error, Qunderflow_error, Qvoid_function, Qvoid_variable, Qwrong_number_of_arguments, Qwrong_type_argument; + extern Lisp_Object Qcdr; extern Lisp_Object Qerror_lacks_explanatory_string; extern Lisp_Object Qfile_error; @@ -5010,6 +5001,7 @@ MODULE_API void warn_when_safe (Lisp_Object, Lisp_Object, const Ascbyte *, ...) PRINTF_ARGS (3, 4); extern int backtrace_with_internal_sections; +extern Fixnum Vmultiple_values_limit; extern Lisp_Object Qand_optional; extern Lisp_Object Qand_rest;
--- a/src/lread.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/lread.c Sat Nov 20 16:49:11 2010 +0000 @@ -844,9 +844,9 @@ return W_OK; else if (EQ (mode, Qreadable)) return R_OK; - else if (INTP (mode)) + else if (INTEGERP (mode)) { - check_int_range (XINT (mode), 0, 7); + check_integer_range (mode, Qzero, make_int (7)); return XINT (mode); } else
--- a/src/mule-ccl.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/mule-ccl.c Sat Nov 20 16:49:11 2010 +0000 @@ -2123,7 +2123,7 @@ val = Fget (ccl_prog, Qccl_program_idx, Qnil); if (! NATNUMP (val) - || XINT (val) >= XVECTOR_LENGTH (Vccl_program_table)) + || -1 != bytecode_arithcompare (val, Flength (Vccl_program_table))) return Qnil; slot = XVECTOR_DATA (Vccl_program_table)[XINT (val)]; if (! VECTORP (slot)
--- a/src/number.h Wed Nov 17 14:37:26 2010 +0000 +++ b/src/number.h Sat Nov 20 16:49:11 2010 +0000 @@ -153,6 +153,40 @@ EXFUN (Fevenp, 1); EXFUN (Foddp, 1); +/* There are varying mathematical definitions of what a natural number is, + differing about whether 0 is inside or outside the set. The Oxford + English Dictionary, second edition, does say that they are whole numbers, + not fractional, but it doesn't give a bound, and gives a quotation + talking about the natural numbers from 1 to 100. Since 100 is certainly + *not* the upper bound on natural numbers, we can't take 1 as the lower + bound from that example. The Real Academia Española's dictionary, not of + English but certainly sharing the western academic tradition, says of + "número natural": + + 1. m. Mat. Cada uno de los elementos de la sucesión 0, 1, 2, 3... + + that is, "each of the elements of the succession 0, 1, 2, 3 ...". The + various Wikipedia articles in languages I can read agree. It's + reasonable to call this macro and the associated Lisp function + NATNUMP. */ + +#ifdef HAVE_BIGNUM +#define NATNUMP(x) ((INTP (x) && XINT (x) >= 0) || \ + (BIGNUMP (x) && bignum_sign (XBIGNUM_DATA (x)) >= 0)) +#else +#define NATNUMP(x) (INTP (x) && XINT (x) >= 0) +#endif + +#define CHECK_NATNUM(x) do { \ + if (!NATNUMP (x)) \ + dead_wrong_type_argument (Qnatnump, x); \ +} while (0) + +#define CONCHECK_NATNUM(x) do { \ + if (!NATNUMP (x)) \ + x = wrong_type_argument (Qnatnump, x); \ +} while (0) + /********************************** Ratios **********************************/ #ifdef HAVE_RATIO
--- a/src/process-unix.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/process-unix.c Sat Nov 20 16:49:11 2010 +0000 @@ -2120,10 +2120,10 @@ CHECK_STRING (dest); - CHECK_NATNUM (port); + check_integer_range (port, Qzero, make_integer (USHRT_MAX)); theport = htons ((unsigned short) XINT (port)); - CHECK_NATNUM (ttl); + check_integer_range (ttl, Qzero, make_integer (UCHAR_MAX)); thettl = (unsigned char) XINT (ttl); if ((udp = getprotobyname ("udp")) == NULL)
--- a/src/process.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/process.c Sat Nov 20 16:49:11 2010 +0000 @@ -977,8 +977,8 @@ (process, height, width)) { CHECK_PROCESS (process); - CHECK_NATNUM (height); - CHECK_NATNUM (width); + check_integer_range (height, Qzero, make_integer (EMACS_INT_MAX)); + check_integer_range (width, Qzero, make_integer (EMACS_INT_MAX)); return MAYBE_INT_PROCMETH (set_window_size, (XPROCESS (process), XINT (height), XINT (width))) <= 0
--- a/src/profile.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/profile.c Sat Nov 20 16:49:11 2010 +0000 @@ -365,8 +365,16 @@ msecs = default_profiling_interval; else { - CHECK_NATNUM (microsecs); +#ifdef HAVE_BIGNUM + check_integer_range (microsecs, make_int (1000), make_integer (INT_MAX)); + msecs = + BIGNUMP (microsecs) ? bignum_to_int (XBIGNUM_DATA (microsecs)) : + XINT (microsecs); +#else + check_integer_range (microsecs, make_int (1000), + make_integer (EMACS_INT_MAX)); msecs = XINT (microsecs); +#endif } if (msecs <= 0) msecs = 1000;
--- a/src/unicode.c Wed Nov 17 14:37:26 2010 +0000 +++ b/src/unicode.c Sat Nov 20 16:49:11 2010 +0000 @@ -1371,7 +1371,8 @@ int ichar, unicode; CHECK_CHAR (character); - CHECK_NATNUM (code); + + check_integer_range (code, Qzero, make_integer (EMACS_INT_MAX)); unicode = XINT (code); ichar = XCHAR (character); @@ -1447,7 +1448,7 @@ int lbs[NUM_LEADING_BYTES]; int c; - CHECK_NATNUM (code); + check_integer_range (code, Qzero, make_integer (EMACS_INT_MAX)); c = XINT (code); { EXTERNAL_LIST_LOOP_2 (elt, charsets) @@ -1473,7 +1474,7 @@ return make_char (ret); } #else - CHECK_NATNUM (code); + check_integer_range (code, Qzero, make_integer (EMACS_INT_MAX)); return Fint_to_char (code); #endif /* MULE */ }
--- a/tests/ChangeLog Wed Nov 17 14:37:26 2010 +0000 +++ b/tests/ChangeLog Sat Nov 20 16:49:11 2010 +0000 @@ -1,3 +1,15 @@ +2010-11-20 Aidan Kehoe <kehoea@parhasard.net> + + * automated/lisp-tests.el: + * automated/lisp-tests.el (featurep): + * automated/lisp-tests.el (wrong-type-argument): + * automated/mule-tests.el (featurep): + Check for args-out-of-range errors instead of wrong-type-argument + errors in various places when code is handed a large bignum + instead of a fixnum. + Also check for the wrong-type-argument errors when giving the same + code a non-integer value. + 2010-11-06 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el (list-nreverse):
--- a/tests/automated/lisp-tests.el Wed Nov 17 14:37:26 2010 +0000 +++ b/tests/automated/lisp-tests.el Sat Nov 20 16:49:11 2010 +0000 @@ -213,6 +213,16 @@ (Assert (eq (butlast '()) nil)) (Assert (eq (nbutlast '()) nil)) +(when (featurep 'bignum) + (let* ((x (list* 0 1 2 3 4 5 6.0 ?7 ?8 (vector 'a 'b 'c))) + (y (butlast x (* 2 most-positive-fixnum))) + (z (nbutlast x (* 3 most-positive-fixnum)))) + (Assert (eq nil y) "checking butlast with a large bignum gives nil") + (Assert (eq nil z) "checking nbutlast with a large bignum gives nil") + (Check-Error wrong-type-argument + (nbutlast x (1- most-negative-fixnum)) + "checking nbutlast with a negative bignum errors"))) + ;;----------------------------------------------------- ;; Test `copy-list' ;;----------------------------------------------------- @@ -2511,4 +2521,152 @@ (mapcar fourth-bit (loop for i from 0 to 6000 collect i))))))) +(Check-Error wrong-type-argument (self-insert-command 'self-insert-command)) +(Check-Error wrong-type-argument (make-list 'make-list 'make-list)) +(Check-Error wrong-type-argument (make-vector 'make-vector 'make-vector)) +(Check-Error wrong-type-argument (make-bit-vector 'make-bit-vector + 'make-bit-vector)) +(Check-Error wrong-type-argument (make-byte-code '(&rest ignore) "\xc0\x87" [4] + 'ignore)) +(Check-Error wrong-type-argument (make-string ?a ?a)) +(Check-Error wrong-type-argument (nth-value 'nth-value (truncate pi e))) +(Check-Error wrong-type-argument (make-hash-table :test #'eql :size :size)) +(Check-Error wrong-type-argument + (accept-process-output nil 'accept-process-output)) +(Check-Error wrong-type-argument + (accept-process-output nil 2000 'accept-process-output)) +(Check-Error wrong-type-argument + (self-insert-command 'self-insert-command)) +(Check-Error wrong-type-argument (string-to-number "16" 'string-to-number)) +(Check-Error wrong-type-argument (move-to-column 'move-to-column)) +(stop-profiling) +(Check-Error wrong-type-argument (start-profiling (float most-positive-fixnum))) +(stop-profiling) +(Check-Error wrong-type-argument + (fill '(1 2 3 4 5) 1 :start (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (fill [1 2 3 4 5] 1 :start (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (fill "1 2 3 4 5" ?1 :start (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (fill #*10101010 1 :start (float most-positive-fixnum)) +(Check-Error wrong-type-argument + (fill '(1 2 3 4 5) 1 :end (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (fill [1 2 3 4 5] 1 :end (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (fill "1 2 3 4 5" ?1 :end (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (fill #*10101010 1 :end (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (reduce #'cons '(1 2 3 4 5) :start (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (reduce #'cons [1 2 3 4 5] :start (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (reduce #'cons "1 2 3 4 5" :start (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (reduce #'cons #*10101010 :start (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (reduce #'cons '(1 2 3 4 5) :end (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (reduce #'cons [1 2 3 4 5] :end (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (reduce #'cons "1 2 3 4 5" :end (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (reduce #'cons #*10101010 :end (float most-positive-fixnum))) + +(when (featurep 'bignum) + (Check-Error args-out-of-range + (self-insert-command (* 2 most-positive-fixnum))) + (Check-Error args-out-of-range + (make-list (* 3 most-positive-fixnum) 'make-list)) + (Check-Error args-out-of-range + (make-vector (* 4 most-positive-fixnum) 'make-vector)) + (Check-Error args-out-of-range + (make-bit-vector (+ 2 most-positive-fixnum) 'make-bit-vector)) + (Check-Error args-out-of-range + (make-byte-code '(&rest ignore) "\xc0\x87" [4] + (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (make-byte-code '(&rest ignore) "\xc0\x87" [4] + #x10000)) + (Check-Error args-out-of-range + (make-string (* 4 most-positive-fixnum) ?a)) + (Check-Error args-out-of-range + (nth-value most-positive-fixnum (truncate pi e))) + (Check-Error args-out-of-range + (make-hash-table :test #'equalp :size (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (accept-process-output nil 4294967)) + (Check-Error args-out-of-range + (accept-process-output nil 10 (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (self-insert-command (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (string-to-number "16" (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (recent-keys (1+ most-positive-fixnum))) + (when (featurep 'xbm) + (Check-Error-Message + invalid-argument + "^data is too short for width and height" + (set-face-background-pixmap + 'left-margin + `[xbm :data (20 ,(* 2 most-positive-fixnum) "random-text")]))) + (Check-Error args-out-of-range + (move-to-column (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (move-to-column (1- most-negative-fixnum))) + (stop-profiling) + (when (< most-positive-fixnum (lsh 1 32)) + ;; We only support machines with integers of 32 bits or more. If + ;; most-positive-fixnum is less than 2^32, we're on a 32-bit machine, + ;; and it's appropriate to test start-profiling with a bignum. + (Assert (eq nil (start-profiling (* most-positive-fixnum 2))))) + (stop-profiling) + (Check-Error args-out-of-range + (fill '(1 2 3 4 5) 1 :start (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (fill [1 2 3 4 5] 1 :start (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (fill "1 2 3 4 5" ?1 :start (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (fill #*10101010 1 :start (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (fill '(1 2 3 4 5) 1 :end (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (fill [1 2 3 4 5] 1 :end (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (fill "1 2 3 4 5" ?1 :end (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (fill #*10101010 1 :end (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (reduce #'cons '(1 2 3 4 5) :start (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (reduce #'cons [1 2 3 4 5] :start (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (reduce #'cons "1 2 3 4 5" :start (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (reduce #'cons #*10101010 :start (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (reduce #'cons '(1 2 3 4 5) :end (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (reduce #'cons [1 2 3 4 5] :end (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (reduce #'cons "1 2 3 4 5" :end (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (reduce #'cons #*10101010 :end (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (replace '(1 2 3 4 5) [5 4 3 2 1] + :start1 (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (replace '(1 2 3 4 5) [5 4 3 2 1] + :start2 (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (replace '(1 2 3 4 5) [5 4 3 2 1] + :end1 (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (replace '(1 2 3 4 5) [5 4 3 2 1] + :end2 (1+ most-positive-fixnum)))) + ;;; end of lisp-tests.el
--- a/tests/automated/mule-tests.el Wed Nov 17 14:37:26 2010 +0000 +++ b/tests/automated/mule-tests.el Sat Nov 20 16:49:11 2010 +0000 @@ -461,7 +461,7 @@ (Assert (eq code (char-to-unicode scaron))) (Assert (eq scaron (unicode-to-char code '(latin-iso8859-2))))) finally (set-unicode-conversion scaron initial-unicode)) - (Check-Error wrong-type-argument (set-unicode-conversion scaron -10000))) + (Check-Error args-out-of-range (set-unicode-conversion scaron -10000))) (dolist (utf-8-char '("\xc6\x92" ;; U+0192 LATIN SMALL LETTER F WITH HOOK