From: Jarkko Hietaniemi Date: Tue, 7 Sep 1999 09:41:23 +0000 (+0000) Subject: Fix a printf thinko: now quads must have the ll L q prefix. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=22f3ae8cbf6c65afe1b66665ab51a244fa3a6869;p=p5sagit%2Fp5-mst-13.2.git Fix a printf thinko: now quads must have the ll L q prefix. (in other words, a bare %d is an int/unsigned) p4raw-id: //depot/cfgperl@4097 --- diff --git a/pp_sys.c b/pp_sys.c index fd0ba8c..baf59ed 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -3946,11 +3946,11 @@ PP(pp_gmtime) tsv = Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %d", dayname[tmbuf->tm_wday], monname[tmbuf->tm_mon], - (IV)tmbuf->tm_mday, - (IV)tmbuf->tm_hour, - (IV)tmbuf->tm_min, - (IV)tmbuf->tm_sec, - (IV)tmbuf->tm_year + 1900); + tmbuf->tm_mday, + tmbuf->tm_hour, + tmbuf->tm_min, + tmbuf->tm_sec, + tmbuf->tm_year + 1900); PUSHs(sv_2mortal(tsv)); } else if (tmbuf) { diff --git a/sv.c b/sv.c index 355ab9a..1f0d1a7 100644 --- a/sv.c +++ b/sv.c @@ -4906,7 +4906,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV case 'D': #ifdef IV_IS_QUAD - /* nothing */ + intsize = 'q'; #else intsize = 'l'; #endif @@ -4916,11 +4916,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV if (args) { switch (intsize) { case 'h': iv = (short)va_arg(*args, int); break; -#ifdef IV_IS_QUAD - default: iv = va_arg(*args, IV); break; -#else default: iv = va_arg(*args, int); break; -#endif case 'l': iv = va_arg(*args, long); break; case 'V': iv = va_arg(*args, IV); break; #ifdef HAS_QUAD @@ -4932,11 +4928,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV iv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0; switch (intsize) { case 'h': iv = (short)iv; break; -#ifdef IV_IS_QUAD - default: break; -#else default: iv = (int)iv; break; -#endif case 'l': iv = (long)iv; break; case 'V': break; #ifdef HAS_QUAD @@ -4958,7 +4950,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV case 'U': #ifdef IV_IS_QUAD - /* nothing */ + intsize = 'q'; #else intsize = 'l'; #endif @@ -4973,7 +4965,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV case 'O': #ifdef IV_IS_QUAD - /* nothing */ + intsize = 'q'; #else intsize = 'l'; #endif @@ -4990,11 +4982,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV if (args) { switch (intsize) { case 'h': uv = (unsigned short)va_arg(*args, unsigned); break; -#ifdef UV_IS_QUAD - default: uv = va_arg(*args, UV); break; -#else default: uv = va_arg(*args, unsigned); break; -#endif case 'l': uv = va_arg(*args, unsigned long); break; case 'V': uv = va_arg(*args, UV); break; #ifdef HAS_QUAD @@ -5006,11 +4994,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV uv = (svix < svmax) ? SvUVx(svargs[svix++]) : 0; switch (intsize) { case 'h': uv = (unsigned short)uv; break; -#ifdef UV_IS_QUAD - default: break; -#else default: uv = (unsigned)uv; break; -#endif case 'l': uv = (unsigned long)uv; break; case 'V': break; #ifdef HAS_QUAD @@ -5160,11 +5144,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV if (args) { switch (intsize) { case 'h': *(va_arg(*args, short*)) = i; break; -#ifdef IV_IS_QUAD - default: *(va_arg(*args, IV*)) = i; break; -#else default: *(va_arg(*args, int*)) = i; break; -#endif case 'l': *(va_arg(*args, long*)) = i; break; case 'V': *(va_arg(*args, IV*)) = i; break; #ifdef HAS_QUAD diff --git a/t/op/64bit.t b/t/op/64bit.t index 5625b4f..09419f8 100644 --- a/t/op/64bit.t +++ b/t/op/64bit.t @@ -17,7 +17,7 @@ BEGIN { # 32+ bit vector sizes doesn't cause noise no warnings qw(overflow portable); -print "1..39\n"; +print "1..34\n"; my $q = 12345678901; my $r = 23456789012; @@ -30,174 +30,153 @@ print "not " unless $x == $q && $x > $f; print "ok 1\n"; -$x = sprintf("%d", 12345678901); +$x = sprintf("%lld", 12345678901); print "not " unless $x eq $q && $x > $f; print "ok 2\n"; -$x = sprintf("%d", $q); -print "not " unless $x == $q && $x eq $q && $x > $f; -print "ok 3\n"; - $x = sprintf("%lld", $q); print "not " unless $x == $q && $x eq $q && $x > $f; -print "ok 4\n"; +print "ok 3\n"; $x = sprintf("%Ld", $q); print "not " unless $x == $q && $x eq $q && $x > $f; -print "ok 5\n"; +print "ok 4\n"; $x = sprintf("%qd", $q); print "not " unless $x == $q && $x eq $q && $x > $f; -print "ok 6\n"; - +print "ok 5\n"; -$x = sprintf("%x", $q); -print "not " unless hex($x) == 0x2dfdc1c35 && hex($x) > $f; -print "ok 7\n"; $x = sprintf("%llx", $q); print "not " unless hex($x) == 0x2dfdc1c35 && hex($x) > $f; -print "ok 8\n"; +print "ok 6\n"; $x = sprintf("%Lx", $q); print "not " unless hex($x) == 0x2dfdc1c35 && hex($x) > $f; -print "ok 9\n"; +print "ok 7\n"; $x = sprintf("%qx", $q); print "not " unless hex($x) == 0x2dfdc1c35 && hex($x) > $f; -print "ok 10\n"; - +print "ok 8\n"; -$x = sprintf("%o", $q); -print "not " unless oct("0$x") == 0133767016065 && oct($x) > $f; -print "ok 11\n"; $x = sprintf("%llo", $q); print "not " unless oct("0$x") == 0133767016065 && oct($x) > $f; -print "ok 12\n"; +print "ok 9\n"; $x = sprintf("%Lo", $q); print "not " unless oct("0$x") == 0133767016065 && oct($x) > $f; -print "ok 13\n"; +print "ok 10\n"; $x = sprintf("%qo", $q); print "not " unless oct("0$x") == 0133767016065 && oct($x) > $f; -print "ok 14\n"; - +print "ok 11\n"; -$x = sprintf("%b", $q); -print "not " unless oct("0b$x") == 0b1011011111110111000001110000110101 && - oct("0b$x") > $f; -print "ok 15\n"; $x = sprintf("%llb", $q); print "not " unless oct("0b$x") == 0b1011011111110111000001110000110101 && oct("0b$x") > $f; -print "ok 16\n"; +print "ok 12\n"; $x = sprintf("%Lb", $q); print "not " unless oct("0b$x") == 0b1011011111110111000001110000110101 && oct("0b$x") > $f; -print "ok 17\n"; +print "ok 13\n"; $x = sprintf("%qb", $q); print "not " unless oct("0b$x") == 0b1011011111110111000001110000110101 && oct("0b$x") > $f; -print "ok 18\n"; +print "ok 14\n"; -$x = sprintf("%u", 12345678901); +$x = sprintf("%llu", $q); print "not " unless $x eq $q && $x > $f; -print "ok 19\n"; - -$x = sprintf("%u", $q); -print "not " unless $x == $q && $x eq $q && $x > $f; -print "ok 20\n"; +print "ok 15\n"; -$x = sprintf("%llu", $q); +$x = sprintf("%Lu", $q); print "not " unless $x == $q && $x eq $q && $x > $f; -print "ok 21\n"; +print "ok 16\n"; -$x = sprintf("%Lu", $q); +$x = sprintf("%qu", $q); print "not " unless $x == $q && $x eq $q && $x > $f; -print "ok 22\n"; +print "ok 17\n"; $x = sprintf("%D", $q); print "not " unless $x == $q && $x eq $q && $x > $f; -print "ok 23\n"; +print "ok 18\n"; $x = sprintf("%U", $q); print "not " unless $x == $q && $x eq $q && $x > $f; -print "ok 24\n"; +print "ok 19\n"; $x = sprintf("%O", $q); print "not " unless oct($x) == $q && oct($x) > $f; -print "ok 25\n"; +print "ok 20\n"; $x = $q + $r; print "not " unless $x == 35802467913 && $x > $f; -print "ok 26\n"; +print "ok 21\n"; $x = $q - $r; print "not " unless $x == -11111110111 && -$x > $f; -print "ok 27\n"; +print "ok 22\n"; $x = $q * 1234567; print "not " unless $x == 15241567763770867 && $x > $f; -print "ok 28\n"; +print "ok 23\n"; $x /= 1234567; print "not " unless $x == $q && $x > $f; -print "ok 29\n"; +print "ok 24\n"; $x = 98765432109 % 12345678901; print "not " unless $x == 901; -print "ok 30\n"; +print "ok 25\n"; # The following six adapted from op/inc. $a = 9223372036854775807; $c = $a++; print "not " unless $a == 9223372036854775808; -print "ok 31\n"; +print "ok 26\n"; $a = 9223372036854775807; $c = ++$a; print "not " unless $a == 9223372036854775808; -print "ok 32\n"; +print "ok 27\n"; $a = 9223372036854775807; $c = $a + 1; print "not " unless $a == 9223372036854775808; -print "ok 33\n"; +print "ok 28\n"; $a = -9223372036854775808; $c = $a--; print "not " unless $a == -9223372036854775809; -print "ok 34\n"; +print "ok 29\n"; $a = -9223372036854775808; $c = --$a; print "not " unless $a == -9223372036854775809; -print "ok 35\n"; +print "ok 30\n"; $a = -9223372036854775808; $c = $a - 1; print "not " unless $a == -9223372036854775809; -print "ok 36\n"; +print "ok 31\n"; $x = ''; print "not " unless (vec($x, 1, 64) = $q) == $q; -print "ok 37\n"; +print "ok 32\n"; print "not " unless vec($x, 1, 64) == $q && vec($x, 1, 64) > $f; -print "ok 38\n"; +print "ok 33\n"; print "not " unless vec($x, 0, 64) == 0 && vec($x, 2, 64) == 0; -print "ok 39\n"; +print "ok 34\n"; # eof