commit: Have NATNUMP give t for positive bignums; check limits appropriately.

changeset: 5307:c096d8051f89 tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net&gt; date: Sat Nov 20 16:49:11 2010 +0000 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 description: 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 ＠＠ -95,6 +95,8 ＠＠ static Fixnum debug_allocation; 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; ＠＠ -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)) ＠＠ -1684,42 +1669,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, /* ＠＠ -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. */ ＠＠ -2921,22 +2925,6 ＠＠ #define CONCHECK_INT(x) do { \ if (!INTP (x)) \ 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 ＠＠ -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 ＠＠ -152,6 +152,40 ＠＠ EXFUN (Fintegerp, 1); 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 **********************************/ 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 ＠＠ -212,6 +212,16 ＠＠ (Assert (eq (nbutlast '(x)) nil)) (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 _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches