[PATCH] Have NATNUMP give t for positive bignums; check limits appropriately.

This is annoyingly invasive, and doesn’t lead to any real benefit for users, just for programmers. It still should go in, though. The issue is that NATNUMP() currently gives zero for positive bignums, while #'natnump gives one. So there are many places where you get errors that look like (wrong-type-argument natnump <some big positive number>); this changes many of them to give range errors instead. In other places it is appropriate to accept a bignum of the appropriate size, e.g. in #'accept-process-output for the timer arguments, where a fixnum does not have enough precision. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1290271751 0 # Node ID c096d8051f893c2a283f1c7f306a8340e470ed45 # Parent cde1608596d0b70c29939d8f4701299c3cf4aa1e Have NATNUMP give t for positive bignums; check limits appropriately. src/ChangeLog addition: 2010-11-20 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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(a)parhasard.net&gt; * 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. diff -r cde1608596d0 -r c096d8051f89 src/ChangeLog --- 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(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; * fns.c (bignum_butlast): New. diff -r cde1608596d0 -r c096d8051f89 src/abbrev.c --- 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); diff -r cde1608596d0 -r c096d8051f89 src/alloc.c --- 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. diff -r cde1608596d0 -r c096d8051f89 src/bytecode.c --- 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 diff -r cde1608596d0 -r c096d8051f89 src/chartab.c --- 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 (); diff -r cde1608596d0 -r c096d8051f89 src/cmds.c --- 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)) diff -r cde1608596d0 -r c096d8051f89 src/data.c --- 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); diff -r cde1608596d0 -r c096d8051f89 src/elhash.c --- 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; } diff -r cde1608596d0 -r c096d8051f89 src/eval.c --- 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);) diff -r cde1608596d0 -r c096d8051f89 src/event-stream.c --- 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)) diff -r cde1608596d0 -r c096d8051f89 src/events.c --- 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); diff -r cde1608596d0 -r c096d8051f89 src/events.h --- 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_ */ diff -r cde1608596d0 -r c096d8051f89 src/file-coding.c --- 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); } } diff -r cde1608596d0 -r c096d8051f89 src/fileio.c --- 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); } } diff -r cde1608596d0 -r c096d8051f89 src/fns.c --- 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); diff -r cde1608596d0 -r c096d8051f89 src/font-mgr.c --- 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) { diff -r cde1608596d0 -r c096d8051f89 src/frame-msw.c --- 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 } } } diff -r cde1608596d0 -r c096d8051f89 src/glyphs.c --- 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)); } diff -r cde1608596d0 -r c096d8051f89 src/indent.c --- 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: diff -r cde1608596d0 -r c096d8051f89 src/intl-win32.c --- 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)) diff -r cde1608596d0 -r c096d8051f89 src/lisp.h --- 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; diff -r cde1608596d0 -r c096d8051f89 src/lread.c --- 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 diff -r cde1608596d0 -r c096d8051f89 src/mule-ccl.c --- 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) diff -r cde1608596d0 -r c096d8051f89 src/number.h --- 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 diff -r cde1608596d0 -r c096d8051f89 src/process-unix.c --- 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) diff -r cde1608596d0 -r c096d8051f89 src/process.c --- 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 diff -r cde1608596d0 -r c096d8051f89 src/profile.c --- 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; diff -r cde1608596d0 -r c096d8051f89 src/unicode.c --- 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 */ } diff -r cde1608596d0 -r c096d8051f89 tests/ChangeLog --- 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(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; * automated/lisp-tests.el (list-nreverse): diff -r cde1608596d0 -r c096d8051f89 tests/automated/lisp-tests.el --- 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 diff -r cde1608596d0 -r c096d8051f89 tests/automated/mule-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 -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches