From: Jarkko Hietaniemi Date: Mon, 2 Aug 1999 10:32:01 +0000 (+0000) Subject: More 64-bit fixing. One known bug of that kind X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0f4b663008b5032408c35f3557d9d5c2790d3fcb;p=p5sagit%2Fp5-mst-13.2.git More 64-bit fixing. One known bug of that kind remains, 32-bit platforms using long long in the test t/pragma/utf8 subtests 1-3 fail. (Update: change #3884 fixed that one.) p4raw-link: @3884 (not found) p4raw-id: //depot/cfgperl@3880 --- diff --git a/Configure b/Configure index 6d937e1..b71c18d 100755 --- a/Configure +++ b/Configure @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Mon Aug 2 10:49:27 EET DST 1999 [metaconfig 3.0 PL70] +# Generated on Mon Aug 2 13:06:47 EET DST 1999 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.com) cat >/tmp/c1$$ <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * This symbol, if defined, contains the string used by stdio to * format 64-bit unsigned decimal numbers (format 'u') for output. */ +/* PERL_PRIo64: + * This symbol, if defined, contains the string used by stdio to + * format 64-bit octal numbers (format 'o') for output. + */ /* PERL_PRIx64: * This symbol, if defined, contains the string used by stdio to * format 64-bit hexadecimal numbers (format 'x') for output. */ #$d_PRId64 PERL_PRId64 $sPRId64 /**/ #$d_PRIu64 PERL_PRIu64 $sPRIu64 /**/ +#$d_PRIo64 PERL_PRIo64 $sPRIo64 /**/ #$d_PRIx64 PERL_PRIx64 $sPRIx64 /**/ /* SELECT_MIN_BITS: diff --git a/regcomp.c b/regcomp.c index fac31e6..03e2c74 100644 --- a/regcomp.c +++ b/regcomp.c @@ -698,7 +698,11 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da FAIL("variable length lookbehind not implemented"); } else if (minnext > U8_MAX) { +#ifdef UV_IS_QUAD + FAIL2("lookbehind longer than %" PERL_PRIu64 " not implemented", (UV)U8_MAX); +#else FAIL2("lookbehind longer than %d not implemented", U8_MAX); +#endif } scan->flags = minnext; } diff --git a/sv.c b/sv.c index a7e3839..2257516 100644 --- a/sv.c +++ b/sv.c @@ -5193,10 +5193,21 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV SV *msg = sv_newmortal(); Perl_sv_setpvf(aTHX_ msg, "Invalid conversion in %s: ", (PL_op->op_type == OP_PRTF) ? "printf" : "sprintf"); - if (c) - Perl_sv_catpvf(aTHX_ msg, isPRINT(c) ? "\"%%%c\"" : "\"%%\\%03o\"", - c & 0xFF); - else + if (c) { +#ifdef UV_IS_QUAD + if (isPRINT(c)) + Perl_sv_catpvf(aTHX_ msg, + "\"%%%c\"", c & 0xFF); + else + Perl_sv_catpvf(aTHX_ msg, + "\"%%\\%03" PERL_PRIo64 "\"", + (UV)c & 0xFF); +#else + Perl_sv_catpvf(aTHX_ msg, isPRINT(c) ? + "\"%%%c\"" : "\"%%\\%03o\"", + c & 0xFF); +#endif + } else sv_catpv(msg, "end of string"); Perl_warner(aTHX_ WARN_PRINTF, "%_", msg); /* yes, this is reentrant */ } diff --git a/t/op/64bit.t b/t/op/64bit.t new file mode 100644 index 0000000..c8da1cb --- /dev/null +++ b/t/op/64bit.t @@ -0,0 +1,134 @@ +BEGIN { + eval { pack "q", 0 }; + if ($@) { + print "1..0\n# no 64-bit types\n"; + exit(0); + } +} + +# This could use a lot of more tests. +# +# Nota bene: bit operations are not 64-bit clean. See the beginning +# of pp.c and the explanation next to IBW/UBW. + +print "1..27\n"; + +my $q = 12345678901; +my $r = 23456789012; +my $x; + + +$x = unpack "q", pack "q", $q; +print "not " unless $x == $q; +print "ok 1\n"; + + +$x = sprintf("%d", 12345678901); +print "not " unless $x eq "$q"; +print "ok 2\n"; + + +$x = sprintf("%d", $q); +print "not " unless $x == $q && $x eq $q; +print "ok 3\n"; + +$x = sprintf("%lld", $q); +print "not " unless $x == $q && $x eq $q; +print "ok 4\n"; + +$x = sprintf("%Ld", $q); +print "not " unless $x == $q && $x eq $q; +print "ok 5\n"; + +$x = sprintf("%qd", $q); +print "not " unless $x == $q && $x eq $q; +print "ok 6\n"; + + +$x = sprintf("%x", $q); +print "not " unless hex($x) == 0x2dfdc1c35; +print "ok 7\n"; + +$x = sprintf("%llx", $q); +print "not " unless hex($x) == 0x2dfdc1c35; +print "ok 8\n"; + +$x = sprintf("%Lx", $q); +print "not " unless hex($x) == 0x2dfdc1c35; +print "ok 9\n"; + +$x = sprintf("%qx", $q); +print "not " unless hex($x) == 0x2dfdc1c35; +print "ok 10\n"; + + +$x = sprintf("%o", $q); +print "not " unless oct("0$x") == 0133767016065; +print "ok 11\n"; + +$x = sprintf("%llo", $q); +print "not " unless oct("0$x") == 0133767016065; +print "ok 12\n"; + +$x = sprintf("%Lo", $q); +print "not " unless oct("0$x") == 0133767016065; +print "ok 13\n"; + +$x = sprintf("%qo", $q); +print "not " unless oct("0$x") == 0133767016065; +print "ok 14\n"; + + +$x = sprintf("%b", $q); +print "not " unless oct("0b$x") == 0b1011011111110111000001110000110101; +print "ok 15\n"; + +$x = sprintf("%llb", $q); +print "not " unless oct("0b$x") == 0b1011011111110111000001110000110101; +print "ok 16\n"; + +$x = sprintf("%Lb", $q); +print "not " unless oct("0b$x") == 0b1011011111110111000001110000110101; +print "ok 17\n"; + +$x = sprintf("%qb", $q); +print "not " unless oct("0b$x") == 0b1011011111110111000001110000110101; +print "ok 18\n"; + + +$x = sprintf("%u", 12345678901); +print "not " unless $x eq "$q"; +print "ok 19\n"; + +$x = sprintf("%u", $q); +print "not " unless $x == $q && $x eq $q; +print "ok 20\n"; + +$x = sprintf("%llu", $q); +print "not " unless $x == $q && $x eq $q; +print "ok 21\n"; + +$x = sprintf("%Lu", $q); +print "not " unless $x == $q && $x eq $q; +print "ok 22\n"; + + +$x = $q + $r; +print "not " unless $x == 35802467913; +print "ok 23\n"; + +$x = $q - $r; +print "not " unless $x == -11111110111; +print "ok 24\n"; + +$x = $q * $r; +print "not " unless $x == 289589985190657035812; +print "ok 25\n"; + +$x /= $r; +print "not " unless $x == $q; +print "ok 26\n"; + +$x = 98765432109 % 12345678901; +print "not " unless $x == 901; +print "ok 27\n"; diff --git a/t/pragma/utf8.t b/t/pragma/utf8.t index 5e467ae..01b0f05 100755 --- a/t/pragma/utf8.t +++ b/t/pragma/utf8.t @@ -6,7 +6,7 @@ BEGIN { $ENV{PERL5LIB} = '../lib'; } -print "1..9\n"; +print "1..12\n"; my $test = 1; @@ -65,6 +65,18 @@ sub ok { ok $1, 'NUMERIC'; $test++; -} + $_ = "alpha123numeric456"; + m/([\p{IsDigit}]+)/; + ok $1, '123'; + $test++; + $_ = "alpha123numeric456"; + m/([^\p{IsDigit}]+)/; + ok $1, 'alpha'; + $test++; + $_ = ",123alpha,456numeric"; + m/([\p{IsAlnum}]+)/; + ok $1, '123alpha'; + $test++; +}