comparison src/data.c @ 5910:eb1e15c9440b

Be less misleading in errors, data.c src/ChangeLog addition: 2015-05-09 Aidan Kehoe <kehoea@parhasard.net> * data.c (Flogand): * data.c (Flogior): * data.c (Frem): * data.c (Flsh): Give less misleading errors in all these functions, e.g. supplying #'integer-char-or-marker as the predicate on wrong-type-argument, when float would not be accepted.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 09 May 2015 10:50:32 +0100
parents 6174848f3e6c
children
comparison
equal deleted inserted replaced
5909:d138e600aa3a 5910:eb1e15c9440b
2693 2693
2694 if (nargs == 0) 2694 if (nargs == 0)
2695 return make_fixnum (~0); 2695 return make_fixnum (~0);
2696 2696
2697 while (!(CHARP (args[0]) || MARKERP (args[0]) || INTEGERP (args[0]))) 2697 while (!(CHARP (args[0]) || MARKERP (args[0]) || INTEGERP (args[0])))
2698 args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]); 2698 args[0] = wrong_type_argument (Qinteger_char_or_marker_p, args[0]);
2699 2699
2700 result = args[0]; 2700 result = args[0];
2701 if (CHARP (result)) 2701 if (CHARP (result))
2702 result = make_fixnum (XCHAR (result)); 2702 result = make_fixnum (XCHAR (result));
2703 else if (MARKERP (result)) 2703 else if (MARKERP (result))
2704 result = make_fixnum (marker_position (result)); 2704 result = make_fixnum (marker_position (result));
2705 for (i = 1; i < nargs; i++) 2705 for (i = 1; i < nargs; i++)
2706 { 2706 {
2707 while (!(CHARP (args[i]) || MARKERP (args[i]) || INTEGERP (args[i]))) 2707 while (!(CHARP (args[i]) || MARKERP (args[i]) || INTEGERP (args[i])))
2708 args[i] = wrong_type_argument (Qnumber_char_or_marker_p, args[i]); 2708 args[i] = wrong_type_argument (Qinteger_char_or_marker_p, args[i]);
2709 other = args[i]; 2709 other = args[i];
2710 switch (promote_args (&result, &other)) 2710 switch (promote_args (&result, &other))
2711 { 2711 {
2712 case FIXNUM_T: 2712 case FIXNUM_T:
2713 result = make_fixnum (XREALFIXNUM (result) & XREALFIXNUM (other)); 2713 result = make_fixnum (XREALFIXNUM (result) & XREALFIXNUM (other));
2745 2745
2746 if (nargs == 0) 2746 if (nargs == 0)
2747 return make_fixnum (0); 2747 return make_fixnum (0);
2748 2748
2749 while (!(CHARP (args[0]) || MARKERP (args[0]) || INTEGERP (args[0]))) 2749 while (!(CHARP (args[0]) || MARKERP (args[0]) || INTEGERP (args[0])))
2750 args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]); 2750 args[0] = wrong_type_argument (Qinteger_char_or_marker_p, args[0]);
2751 2751
2752 result = args[0]; 2752 result = args[0];
2753 if (CHARP (result)) 2753 if (CHARP (result))
2754 result = make_fixnum (XCHAR (result)); 2754 result = make_fixnum (XCHAR (result));
2755 else if (MARKERP (result)) 2755 else if (MARKERP (result))
2756 result = make_fixnum (marker_position (result)); 2756 result = make_fixnum (marker_position (result));
2757 for (i = 1; i < nargs; i++) 2757 for (i = 1; i < nargs; i++)
2758 { 2758 {
2759 while (!(CHARP (args[i]) || MARKERP (args[i]) || INTEGERP (args[i]))) 2759 while (!(CHARP (args[i]) || MARKERP (args[i]) || INTEGERP (args[i])))
2760 args[i] = wrong_type_argument (Qnumber_char_or_marker_p, args[i]); 2760 args[i] = wrong_type_argument (Qinteger_char_or_marker_p, args[i]);
2761 other = args[i]; 2761 other = args[i];
2762 switch (promote_args (&result, &other)) 2762 switch (promote_args (&result, &other))
2763 { 2763 {
2764 case FIXNUM_T: 2764 case FIXNUM_T:
2765 result = make_fixnum (XREALFIXNUM (result) | XREALFIXNUM (other)); 2765 result = make_fixnum (XREALFIXNUM (result) | XREALFIXNUM (other));
2860 */ 2860 */
2861 (number1, number2)) 2861 (number1, number2))
2862 { 2862 {
2863 #ifdef HAVE_BIGNUM 2863 #ifdef HAVE_BIGNUM
2864 while (!(CHARP (number1) || MARKERP (number1) || INTEGERP (number1))) 2864 while (!(CHARP (number1) || MARKERP (number1) || INTEGERP (number1)))
2865 number1 = wrong_type_argument (Qnumber_char_or_marker_p, number1); 2865 number1 = wrong_type_argument (Qinteger_char_or_marker_p, number1);
2866 while (!(CHARP (number2) || MARKERP (number2) || INTEGERP (number2))) 2866 while (!(CHARP (number2) || MARKERP (number2) || INTEGERP (number2)))
2867 number2 = wrong_type_argument (Qnumber_char_or_marker_p, number2); 2867 number2 = wrong_type_argument (Qinteger_char_or_marker_p, number2);
2868 2868
2869 if (promote_args (&number1, &number2) == FIXNUM_T) 2869 if (promote_args (&number1, &number2) == FIXNUM_T)
2870 { 2870 {
2871 if (XREALFIXNUM (number2) == 0) 2871 if (XREALFIXNUM (number2) == 0)
2872 Fsignal (Qarith_error, Qnil); 2872 Fsignal (Qarith_error, Qnil);
3031 */ 3031 */
3032 (value, count)) 3032 (value, count))
3033 { 3033 {
3034 #ifdef HAVE_BIGNUM 3034 #ifdef HAVE_BIGNUM
3035 while (!(CHARP (value) || MARKERP (value) || INTEGERP (value))) 3035 while (!(CHARP (value) || MARKERP (value) || INTEGERP (value)))
3036 wrong_type_argument (Qnumber_char_or_marker_p, value); 3036 wrong_type_argument (Qinteger_char_or_marker_p, value);
3037 CONCHECK_INTEGER (count); 3037 CONCHECK_INTEGER (count);
3038 3038
3039 if (promote_args (&value, &count) == FIXNUM_T) 3039 if (promote_args (&value, &count) == FIXNUM_T)
3040 { 3040 {
3041 if (XREALFIXNUM (count) <= 0) 3041 if (XREALFIXNUM (count) <= 0)
3048 else 3048 else
3049 { 3049 {
3050 if (bignum_sign (XBIGNUM_DATA (count)) <= 0) 3050 if (bignum_sign (XBIGNUM_DATA (count)) <= 0)
3051 { 3051 {
3052 bignum_neg (scratch_bignum, XBIGNUM_DATA (count)); 3052 bignum_neg (scratch_bignum, XBIGNUM_DATA (count));
3053 /* Sigh, this won't catch all overflows in the MPZ type under GMP,
3054 and there's no way to hook into the library so that an overflow
3055 errors rather than aborting. See
3056 http://mid.gmane.org/5529.2096.e5823.ccba@parhasard.net . */
3053 if (!bignum_fits_ulong_p (scratch_bignum)) 3057 if (!bignum_fits_ulong_p (scratch_bignum))
3054 args_out_of_range (Qnumber_char_or_marker_p, count); 3058 {
3059 args_out_of_range_3 (count,
3060 make_bignum_ll (- (long long)(ULONG_MAX)),
3061 make_bignum_ll (ULONG_MAX));
3062 }
3055 bignum_rshift (scratch_bignum2, XBIGNUM_DATA (value), 3063 bignum_rshift (scratch_bignum2, XBIGNUM_DATA (value),
3056 bignum_to_ulong (scratch_bignum)); 3064 bignum_to_ulong (scratch_bignum));
3057 } 3065 }
3058 else 3066 else
3059 { 3067 {
3068 /* See above re overflow. */
3060 if (!bignum_fits_ulong_p (XBIGNUM_DATA (count))) 3069 if (!bignum_fits_ulong_p (XBIGNUM_DATA (count)))
3061 args_out_of_range (Qnumber_char_or_marker_p, count); 3070 {
3071 args_out_of_range_3 (count,
3072 make_bignum_ll (- (long long) (ULONG_MAX)),
3073 make_bignum_ll (ULONG_MAX));
3074 }
3062 bignum_lshift (scratch_bignum2, XBIGNUM_DATA (value), 3075 bignum_lshift (scratch_bignum2, XBIGNUM_DATA (value),
3063 bignum_to_ulong (XBIGNUM_DATA (count))); 3076 bignum_to_ulong (XBIGNUM_DATA (count)));
3064 } 3077 }
3065 return Fcanonicalize_number (make_bignum_bg (scratch_bignum2)); 3078 return Fcanonicalize_number (make_bignum_bg (scratch_bignum2));
3066 } 3079 }