In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/ee95e30c64b700db346148e4c9bcd140e30ec272?hp=2c34ec1b60eadacbf29fae442ed08c82ee42863b>
- Log ----------------------------------------------------------------- commit ee95e30c64b700db346148e4c9bcd140e30ec272 Author: Father Chrysostomos <[email protected]> Date: Fri Jul 29 08:38:11 2016 -0700 Tired of looking up old bug numbers Some of this is ugly, but thatâs because I wrote a one-liner to do it. Itâs good enough for practical purposes. ----------------------------------------------------------------------- Summary of changes: t/comp/parser.t | 10 +++++----- t/lib/dbmt_common.pl | 2 +- t/lib/strict/subs | 2 +- t/lib/warnings/pp_hot | 2 +- t/lib/warnings/sv | 2 +- t/op/avhv.t | 2 +- t/op/caller.t | 2 +- t/op/chop.t | 2 +- t/op/dbm.t | 2 +- t/op/do.t | 2 +- t/op/eval.t | 4 ++-- t/op/flip.t | 2 +- t/op/goto.t | 2 +- t/op/gv.t | 2 +- t/op/method.t | 4 ++-- t/op/pos.t | 2 +- t/op/repeat.t | 4 ++-- t/op/sort.t | 2 +- t/op/splice.t | 4 ++-- t/op/split.t | 10 +++++----- t/op/stat.t | 4 ++-- t/op/study.t | 4 ++-- t/op/sub_lval.t | 2 +- t/op/taint.t | 18 +++++++++--------- t/op/tie.t | 2 +- t/op/tiehandle.t | 2 +- t/op/tr.t | 2 +- t/op/ver.t | 16 ++++++++-------- t/op/wantarray.t | 2 +- t/opbasic/concat.t | 24 ++++++++++++------------ t/re/pat_advanced.t | 2 +- t/re/pat_rt_report.t | 36 ++++++++++++++++++------------------ t/re/re_tests | 6 +++--- t/run/fresh_perl.t | 16 ++++++++-------- t/run/switches.t | 2 +- t/uni/caller.t | 2 +- t/uni/gv.t | 2 +- t/uni/sprintf.t | 2 +- 38 files changed, 104 insertions(+), 104 deletions(-) diff --git a/t/comp/parser.t b/t/comp/parser.t index 9652c42..ebfcb9d 100644 --- a/t/comp/parser.t +++ b/t/comp/parser.t @@ -58,11 +58,11 @@ sub is { eval '%@x=0;'; like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' ); -# Bug 20010422.005 +# Bug 20010422.005 (#6874) eval q{{s//${}/; //}}; like( $@, qr/syntax error/, 'syntax error, used to dump core' ); -# Bug 20010528.007 +# Bug 20010528.007 (#7052) eval q/"\x{"/; like( $@, qr/^Missing right brace on \\x/, 'syntax error in string, used to dump core' ); @@ -85,7 +85,7 @@ eval "a.b.c.d.e.f;sub"; like( $@, qr/^Illegal declaration of anonymous subroutine/, 'found by Markov chain stress testing' ); -# Bug 20010831.001 +# Bug 20010831.001 (#7605) eval '($a, b) = (1, 2);'; like( $@, qr/^Can't modify constant item in list assignment/, 'bareword in list assignment' ); @@ -96,11 +96,11 @@ like( $@, qr/^Can't modify constant item in tie /, eval 'undef foo'; like( $@, qr/^Can't modify constant item in undef operator /, - 'undefing constant causes a segfault in 5.6.1 [ID 20010906.019]' ); + 'undefing constant causes a segfault in 5.6.1 [ID 20010906.019 (#7642)]' ); eval 'read($bla, FILE, 1);'; like( $@, qr/^Can't modify constant item in read /, - 'read($var, FILE, 1) segfaults on 5.6.1 [ID 20011025.054]' ); + 'read($var, FILE, 1) segfaults on 5.6.1 [ID 20011025.054 (#7847)]' ); # This used to dump core (bug #17920) eval q{ sub { sub { f1(f2();); my($a,$b,$c) } } }; diff --git a/t/lib/dbmt_common.pl b/t/lib/dbmt_common.pl index 5d4098c..40590f3 100644 --- a/t/lib/dbmt_common.pl +++ b/t/lib/dbmt_common.pl @@ -413,7 +413,7 @@ unlink <Op_dbmx*>, $Dfile; } { - # Bug ID 20001013.009 + # Bug ID 20001013.009 (#4434) # # test that $hash{KEY} = undef doesn't produce the warning # Use of uninitialized value in null operation diff --git a/t/lib/strict/subs b/t/lib/strict/subs index dff9282..a83df01 100644 --- a/t/lib/strict/subs +++ b/t/lib/strict/subs @@ -337,7 +337,7 @@ Execution of - aborted due to compilation errors. ######## -# ID 20020703.002 +# ID 20020703.002 (#10021) use strict; use warnings; my $abc = XYZ ? 1 : 0; diff --git a/t/lib/warnings/pp_hot b/t/lib/warnings/pp_hot index 702df08..e660528 100644 --- a/t/lib/warnings/pp_hot +++ b/t/lib/warnings/pp_hot @@ -136,7 +136,7 @@ print() on closed filehandle STDIN at - line 6. (Are you trying to call print() on dirhandle STDIN?) ######## # pp_hot.c [pp_print] -# [ID 20020425.012] from Dave Steiner <[email protected]> +# [ID 20020425.012 (#9030)] from Dave Steiner <[email protected]> # This goes segv on 5.7.3 use warnings 'closed' ; my $fh = *STDOUT{IO}; diff --git a/t/lib/warnings/sv b/t/lib/warnings/sv index c8e0e62..ee0fdc2 100644 --- a/t/lib/warnings/sv +++ b/t/lib/warnings/sv @@ -200,7 +200,7 @@ $C .= $A ; EXPECT Use of uninitialized value $A in concatenation (.) or string at - line 10. ######## -# perlbug 20011116.125 +# perlbug 20011116.125 (#7917) use warnings 'uninitialized'; $a = undef; $foo = join '', $a, "\n"; diff --git a/t/op/avhv.t b/t/op/avhv.t index 39a54dc..72d041f 100644 --- a/t/op/avhv.t +++ b/t/op/avhv.t @@ -276,7 +276,7 @@ eval { }; not_hash($@); -# Check hash slices (BUG ID 20010423.002) +# Check hash slices (BUG ID 20010423.002 (#6879)) $avhv = [{foo=>1, bar=>2}]; eval { @$avhv{"foo", "bar"} = (42, 53); diff --git a/t/op/caller.t b/t/op/caller.t index 80d3a5a..46a3316 100644 --- a/t/op/caller.t +++ b/t/op/caller.t @@ -27,7 +27,7 @@ sub { @c = caller(0) } -> (); is( $c[3], "main::__ANON__", "anonymous subroutine name" ); ok( $c[4], "hasargs true with anon sub" ); -# Bug 20020517.003, used to dump core +# Bug 20020517.003 (#9367), used to dump core sub foo { @c = caller(0) } my $fooref = delete $::{foo}; $fooref -> (); diff --git a/t/op/chop.t b/t/op/chop.t index d24b9e0..04c26f6 100644 --- a/t/op/chop.t +++ b/t/op/chop.t @@ -123,7 +123,7 @@ is ($_, "\x{1234}"); my @stuff = qw(this that); is (chop(@stuff[0,1]), 't'); -# bug id 20010305.012 +# bug id 20010305.012 (#5972) @stuff = qw(ab cd ef); is (chop(@stuff = @stuff), 'f'); diff --git a/t/op/dbm.t b/t/op/dbm.t index 6c51dad..28ed700 100644 --- a/t/op/dbm.t +++ b/t/op/dbm.t @@ -11,7 +11,7 @@ BEGIN { plan tests => 5; -# This is [20020104.007] "coredump on dbmclose" +# This is [20020104.007 (#8179)] "coredump on dbmclose" my $filename = tempfile(); diff --git a/t/op/do.t b/t/op/do.t index 0bbab5e..26a0b17 100644 --- a/t/op/do.t +++ b/t/op/do.t @@ -41,7 +41,7 @@ if (open my $do, '>', $file18) { do $file18; die $@ if $@; -# bug ID 20010920.007 +# bug ID 20010920.007 (#7713) eval qq{ do qq(a file that does not exist); }; is($@, '', "do on a non-existing file, first try"); diff --git a/t/op/eval.t b/t/op/eval.t index 7b9fb17..722cd35 100644 --- a/t/op/eval.t +++ b/t/op/eval.t @@ -221,7 +221,7 @@ is(do { } # Check that eval catches bad goto calls -# (BUG ID 20010305.003) +# (BUG ID 20010305.003 (#5963)) { eval { eval { goto foo; }; @@ -248,7 +248,7 @@ is(do { { $@ = 5; eval q{}; - cmp_ok(length $@, '==', 0, '[ID 20020623.002] eval "" doesn\'t clear $@'); + cmp_ok(length $@, '==', 0, '[ID 20020623.002 (#9721)] eval "" doesn\'t clear $@'); } # DAPM Nov-2002. Perl should now capture the full lexical context during diff --git a/t/op/flip.t b/t/op/flip.t index 2706bf8..0758623 100644 --- a/t/op/flip.t +++ b/t/op/flip.t @@ -36,7 +36,7 @@ $x = 3.14; ok(($x...$x) eq "1"); { - # coredump reported in bug 20001018.008 + # coredump reported in bug 20001018.008 (#4474) readline(UNKNOWN); $. = 1; $x = 1..10; diff --git a/t/op/goto.t b/t/op/goto.t index aa2f24f..351f86a 100644 --- a/t/op/goto.t +++ b/t/op/goto.t @@ -97,7 +97,7 @@ for (1) { is($count, 2, 'end of loop'); # Does goto work correctly within a for(;;) loop? -# (BUG ID 20010309.004) +# (BUG ID 20010309.004 (#5998)) for(my $i=0;!$i++;) { my $x=1; diff --git a/t/op/gv.t b/t/op/gv.t index 03ae46e..9bdc711 100644 --- a/t/op/gv.t +++ b/t/op/gv.t @@ -240,7 +240,7 @@ is *x{PACKAGE}, 'main', 'and *foo{PACKAGE} the original package'; ok(defined *{$a}); } -# [ID 20010526.001] localized glob loses value when assigned to +# [ID 20010526.001 (#7038)] localized glob loses value when assigned to $j=1; %j=(a=>1); @j=(1); local *j=*j; *j = sub{}; diff --git a/t/op/method.t b/t/op/method.t index b915306..a9666bb 100644 --- a/t/op/method.t +++ b/t/op/method.t @@ -311,7 +311,7 @@ is( Foo->boogie(), "yes, sir!"); eval 'sub AUTOLOAD { "ok ", shift, "\n"; }'; ok(1); -# Bug ID 20010902.002 +# Bug ID 20010902.002 (#7609) is( eval q[ my $x = 'x'; # Lexical or package variable, 5.6.1 panics. @@ -336,7 +336,7 @@ is( is($w, ''); } -# [ID 20020305.025] PACKAGE::SUPER doesn't work anymore +# [ID 20020305.025 (#8788)] PACKAGE::SUPER doesn't work anymore package main; our @X; diff --git a/t/op/pos.t b/t/op/pos.t index 04b5272..1e3ce33 100644 --- a/t/op/pos.t +++ b/t/op/pos.t @@ -20,7 +20,7 @@ sub f { my $p=$_[0]; return $p } $x=~/.a/g; is(f(pos($x)), 4, "matching again, pos() next leaves off at offset 4"); -# Is pos() set inside //g? (bug id 19990615.008) +# Is pos() set inside //g? (bug id 19990615.008 (#874)) $x = "test string?"; $x =~ s/\w/pos($x)/eg; is($x, "0123 5678910?", "pos() set inside //g"); diff --git a/t/op/repeat.t b/t/op/repeat.t index bee7dac..3bd0885 100644 --- a/t/op/repeat.t +++ b/t/op/repeat.t @@ -152,10 +152,10 @@ is($Tiecount::Tiecount, 1, '(...)x... in void context in list (via scalar comma)'); -# perlbug 20011113.110 works in 5.6.1, broken in 5.7.2 +# perlbug 20011113.110 (#7902) works in 5.6.1, broken in 5.7.2 { my $x= [("foo") x 2]; - is( join('', @$x), 'foofoo', 'list repeat in anon array ref broken [ID 20011113.110]' ); + is( join('', @$x), 'foofoo', 'list repeat in anon array ref broken [ID 20011113.110 (#7902)]' ); } # [perl #35885] diff --git a/t/op/sort.t b/t/op/sort.t index 22d83a9..badd684 100644 --- a/t/op/sort.t +++ b/t/op/sort.t @@ -408,7 +408,7 @@ cmp_ok($x,'eq','123',q(optimized-away comparison block doesn't take any other ar { sub routine { "one", "two" }; @a = sort(routine(1)); - cmp_ok("@a",'eq',"one two",'bug id 19991001.003'); + cmp_ok("@a",'eq',"one two",'bug id 19991001.003 (#1549)'); } diff --git a/t/op/splice.t b/t/op/splice.t index c0af5d3..e61f732 100644 --- a/t/op/splice.t +++ b/t/op/splice.t @@ -39,12 +39,12 @@ is( j(@a), j(1,7,7,3), '... array 1,7,7,3'); is( j(splice(@a,-3,-2,2)), j(7), 'replace first 7 with a 2, negative offset, negative length, return value is 7'); is( j(@a), j(1,2,7,3), '... array has 1,2,7,3'); -# Bug 20000223.001 - no test for splice(@array). Destructive test! +# Bug 20000223.001 (#2196) - no test for splice(@array). Destructive test! is( j(splice(@a)), j(1,2,7,3), 'bare splice empties the array, return value is the array'); is( j(@a), '', 'array is empty'); # Tests 11 and 12: -# [ID 20010711.005] in Tie::Array, SPLICE ignores context, breaking SHIFT +# [ID 20010711.005 (#7265)] in Tie::Array, SPLICE ignores context, breaking SHIFT my $foo; diff --git a/t/op/split.t b/t/op/split.t index fb73271..9c19365 100644 --- a/t/op/split.t +++ b/t/op/split.t @@ -207,8 +207,8 @@ $cnt = split //, v1.20.300.4000.50000.4000.300.20.1; is("@ary", "1 20 300 4000 50000 4000 300 20 1"); is($cnt, scalar(@ary)); -@ary = split(/\x{FE}/, "\x{FF}\x{FE}\x{FD}"); # bug id 20010105.016 -$cnt = split(/\x{FE}/, "\x{FF}\x{FE}\x{FD}"); # bug id 20010105.016 +@ary = split(/\x{FE}/, "\x{FF}\x{FE}\x{FD}"); # bug id 20010105.016 (#5088) +$cnt = split(/\x{FE}/, "\x{FF}\x{FE}\x{FD}"); # bug id 20010105.016 (#5088) ok(@ary == 2 && $ary[0] eq "\xFF" && $ary[1] eq "\xFD" && $ary[0] eq "\x{FF}" && $ary[1] eq "\x{FD}"); @@ -244,7 +244,7 @@ is($cnt, scalar(@ary)); } { - # bug id 20000427.003 + # bug id 20000427.003 (#3173) use warnings; use strict; @@ -266,7 +266,7 @@ is($cnt, scalar(@ary)); my $s = "\x20\x40\x{80}\x{100}\x{80}\x40\x20"; { - # bug id 20000426.003 + # bug id 20000426.003 (#3166) my ($a, $b, $c) = split(/\x40/, $s); ok($a eq "\x20" && $b eq "\x{80}\x{100}\x{80}" && $c eq $a); @@ -288,7 +288,7 @@ is($cnt, scalar(@ary)); } { - # 20001205.014 + # 20001205.014 (#4844) my $a = "ABC\x{263A}"; diff --git a/t/op/stat.t b/t/op/stat.t index 151f940..a9cdd5e 100644 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -443,7 +443,7 @@ ok(-f(), ' -f() "'); unlink $tmpfile or print "# unlink failed: $!\n"; -# bug id 20011101.069 +# bug id 20011101.069 (#7861) my @r = \stat($Curdir); is(scalar @r, 13, 'stat returns full 13 elements'); @@ -489,7 +489,7 @@ like $@, qr/^The stat preceding lstat\(\) wasn't an lstat at /, SKIP: { skip "No lstat", 2 unless $Config{d_lstat}; - # bug id 20020124.004 + # bug id 20020124.004 (#8334) # If we have d_lstat, we should have symlink() my $linkname = 'stat-' . rand =~ y/.//dr; my $target = $Perl; diff --git a/t/op/study.t b/t/op/study.t index 906aba9..aad7752 100644 --- a/t/op/study.t +++ b/t/op/study.t @@ -82,8 +82,8 @@ TODO: { $_ = 'FGF'; study; - ok(!/G.F$/, 'bug 20010618.006'); - ok(!/[F]F$/, 'bug 20010618.006'); + ok(!/G.F$/, 'bug 20010618.006 (#7126)'); + ok(!/[F]F$/, 'bug 20010618.006 (#7126)'); } { diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t index eb33027..c94e9f5 100644 --- a/t/op/sub_lval.t +++ b/t/op/sub_lval.t @@ -561,7 +561,7 @@ eval { (akeeze) = 64 }; like $@, qr/^Can't modify keys on array in list assignment at /, 'list assignment to keys @_ through lv sub is forbidden'; -# Bug 20001223.002: split thought that the list had only one element +# Bug 20001223.002 (#5005): split thought that the list had only one element @ary = qw(4 5 6); sub lval1 : lvalue { $ary[0]; } sub lval2 : lvalue { $ary[1]; } diff --git a/t/op/taint.t b/t/op/taint.t index 101c6da..1915c38 100644 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -1462,7 +1462,7 @@ SKIP: { } { - # bug id 20001004.006 + # bug id 20001004.006 (#4380) open my $fh, '<', $TEST or warn "$0: cannot read $TEST: $!" ; local $/; @@ -1475,7 +1475,7 @@ SKIP: { } { - # bug id 20001004.007 + # bug id 20001004.007 (#4381) open my $fh, '<', $TEST or warn "$0: cannot read $TEST: $!" ; my $a = <$fh>; @@ -1502,7 +1502,7 @@ SKIP: { } { - # bug id 20010519.003 + # bug id 20010519.003 (#7015) BEGIN { use vars qw($has_fcntl); @@ -1547,7 +1547,7 @@ SKIP: { } { - # bug 20010526.004 + # bug 20010526.004 (#7041) use warnings; @@ -1568,7 +1568,7 @@ SKIP: { { - # Bug ID 20010730.010 + # Bug ID 20010730.010 (#7387) my $i = 0; @@ -1618,7 +1618,7 @@ like($@, qr/^Modification of a read-only value attempted/, 'Assigning to ${^TAINT} fails'); { - # bug 20011111.105 + # bug 20011111.105 (#7897) my $re1 = qr/x$TAINT/; is_tainted($re1); @@ -1633,7 +1633,7 @@ like($@, qr/^Modification of a read-only value attempted/, SKIP: { skip "system {} has different semantics on Win32", 1 if $Is_MSWin32; - # bug 20010221.005 + # bug 20010221.005 (#5882) local $ENV{PATH} .= $TAINT; eval { system { "echo" } "/arg0", "arg1" }; like($@, qr/^Insecure \$ENV/); @@ -1643,7 +1643,7 @@ TODO: { todo_skip 'tainted %ENV warning occludes tainted arguments warning', 22 if $Is_VMS; - # bug 20020208.005 plus some single arg exec/system extras + # bug 20020208.005 (#8465) plus some single arg exec/system extras violates_taint(sub { exec $TAINT, $TAINT }, 'exec'); violates_taint(sub { exec $TAINT $TAINT }, 'exec'); violates_taint(sub { exec $TAINT $TAINT, $TAINT }, 'exec'); @@ -1672,7 +1672,7 @@ TODO: { } { - # [ID 20020704.001] taint propagation failure + # [ID 20020704.001 (#10026)] taint propagation failure use re 'taint'; $TAINT =~ /(.*)/; is_tainted(my $foo = $1); diff --git a/t/op/tie.t b/t/op/tie.t index ae0db6f..7b8a418 100644 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -284,7 +284,7 @@ EXPECT 2 ######## -# [20020716.007] - nested FETCHES +# [20020716.007 (#10080)] - nested FETCHES sub F1::TIEARRAY { bless [], 'F1' } sub F1::FETCH { 1 } diff --git a/t/op/tiehandle.t b/t/op/tiehandle.t index 21f56fc..8b8ab6c 100644 --- a/t/op/tiehandle.t +++ b/t/op/tiehandle.t @@ -277,7 +277,7 @@ is($r, 1); } { - # [ID 20020713.001] chomp($data=<tied_fh>) + # [ID 20020713.001 (#10048)] chomp($data=<tied_fh>) local *TEST; tie *TEST, 'CHOMP'; my $data; diff --git a/t/op/tr.t b/t/op/tr.t index 046d44f..2284f7f 100644 --- a/t/op/tr.t +++ b/t/op/tr.t @@ -170,7 +170,7 @@ like $@, qr\^Using !~ with tr///r doesn't make sense\, is $wc, 1, '/r warns just once'; } -# perlbug [ID 20000511.005] +# perlbug [ID 20000511.005 (#3237)] $_ = 'fred'; /([a-z]{2})/; $1 =~ tr/A-Z//; diff --git a/t/op/ver.t b/t/op/ver.t index 503efd7..ceb2aa4 100644 --- a/t/op/ver.t +++ b/t/op/ver.t @@ -160,13 +160,13 @@ is(sprintf("%vd", join("", map { chr } } { - # bug id 20000323.056 + # bug id 20000323.056 (#2641) - is( "\x{41}", +v65, 'bug id 20000323.056'); - is( "\x41", +v65, 'bug id 20000323.056'); - is( "\x{c8}", +v200, 'bug id 20000323.056'); - is( "\xc8", +v200, 'bug id 20000323.056'); - is( "\x{221b}", +v8731, 'bug id 20000323.056'); + is( "\x{41}", +v65, 'bug id 20000323.056 (#2641)'); + is( "\x41", +v65, 'bug id 20000323.056 (#2641)'); + is( "\x{c8}", +v200, 'bug id 20000323.056 (#2641)'); + is( "\xc8", +v200, 'bug id 20000323.056 (#2641)'); + is( "\x{221b}", +v8731, 'bug id 20000323.056 (#2641)'); } # See if the things Camel-III says are true: 29..33 @@ -196,7 +196,7 @@ SKIP: { # Chapter 28, pp671 ok(v5.6.0 lt v5.7.0, "v5.6.0 lt v5.7.0"); -# part of 20000323.059 +# part of 20000323.059 (#2644) is(v200, chr(200), "v200 eq chr(200)" ); is(v200, +v200, "v200 eq +v200" ); is(v200, eval( "v200"), 'v200 eq "v200"' ); @@ -226,7 +226,7 @@ ok( abs($v - $]) < 10**-8 , "\$^V == \$] (numeric)" ); { no warnings 'deprecated'; # These are above IV_MAX on 32 bit machines - # [ID 20010902.001] check if v-strings handle full UV range or not + # [ID 20010902.001 (#7608)] check if v-strings handle full UV range or not if ( $Config{'uvsize'} >= 4 ) { is( sprintf("%vd", eval 'v2147483647.2147483648'), '2147483647.2147483648', 'v-string > IV_MAX[32-bit]' ); is( sprintf("%vd", eval 'v3141592653'), '3141592653', 'IV_MAX < v-string < UV_MAX[32-bit]'); diff --git a/t/op/wantarray.t b/t/op/wantarray.t index 433a839..44ccd38 100644 --- a/t/op/wantarray.t +++ b/t/op/wantarray.t @@ -26,7 +26,7 @@ $a = scalar context('S'); ($a) = scalar context('S'); { - # [ID 20020626.011] incorrect wantarray optimisation + # [ID 20020626.011 (#9998)] incorrect wantarray optimisation sub simple { wantarray ? 1 : 2 } sub inline { my $a = wantarray ? simple() : simple(); diff --git a/t/opbasic/concat.t b/t/opbasic/concat.t index 9c4cbe2..7802fc9 100644 --- a/t/opbasic/concat.t +++ b/t/opbasic/concat.t @@ -33,63 +33,63 @@ ok("$c$a$c" eq "foo", "concatenate undef, fore and aft"); # Okay, so that wasn't very challenging. Let's go Unicode. { - # bug id 20000819.004 + # bug id 20000819.004 (#3761) $_ = $dx = "\x{10f2}"; s/($dx)/$dx$1/; { - ok($_ eq "$dx$dx","bug id 20000819.004, back"); + ok($_ eq "$dx$dx","bug id 20000819.004 (#3761), back"); } $_ = $dx = "\x{10f2}"; s/($dx)/$1$dx/; { - ok($_ eq "$dx$dx","bug id 20000819.004, front"); + ok($_ eq "$dx$dx","bug id 20000819.004 (#3761), front"); } $dx = "\x{10f2}"; $_ = "\x{10f2}\x{10f2}"; s/($dx)($dx)/$1$2/; { - ok($_ eq "$dx$dx","bug id 20000819.004, front and back"); + ok($_ eq "$dx$dx","bug id 20000819.004 (#3761), front and back"); } } { - # bug id 20000901.092 + # bug id 20000901.092 (#4184) # test that undef left and right of utf8 results in a valid string my $a; $a .= "\x{1ff}"; - ok($a eq "\x{1ff}", "bug id 20000901.092, undef left"); + ok($a eq "\x{1ff}", "bug id 20000901.092 (#4184), undef left"); $a .= undef; - ok($a eq "\x{1ff}", "bug id 20000901.092, undef right"); + ok($a eq "\x{1ff}", "bug id 20000901.092 (#4184), undef right"); } { - # ID 20001020.006 + # ID 20001020.006 (#4484) "x" =~ /(.)/; # unset $2 # Without the fix this 5.7.0 would croak: # Modification of a read-only value attempted at ... eval {"$2\x{1234}"}; - ok(!$@, "bug id 20001020.006, left"); + ok(!$@, "bug id 20001020.006 (#4484), left"); # For symmetry with the above. eval {"\x{1234}$2"}; - ok(!$@, "bug id 20001020.006, right"); + ok(!$@, "bug id 20001020.006 (#4484), right"); *pi = \undef; # This bug existed earlier than the $2 bug, but is fixed with the same # patch. Without the fix this 5.7.0 would also croak: # Modification of a read-only value attempted at ... eval{"$pi\x{1234}"}; - ok(!$@, "bug id 20001020.006, constant left"); + ok(!$@, "bug id 20001020.006 (#4484), constant left"); # For symmetry with the above. eval{"\x{1234}$pi"}; - ok(!$@, "bug id 20001020.006, constant right"); + ok(!$@, "bug id 20001020.006 (#4484), constant right"); } sub beq { use bytes; $_[0] eq $_[1]; } diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t index 74aed91..ed888a6 100644 --- a/t/re/pat_advanced.t +++ b/t/re/pat_advanced.t @@ -62,7 +62,7 @@ sub run_tests { } { - my $message = 'bug id 20001008.001'; + my $message = 'bug id 20001008.001 (#4407)'; my $strasse = "stra" . uni_to_native("\337") . "e"; my @x = ("$strasse 138", "$strasse 138"); diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t index cb02ad2..5adae24 100644 --- a/t/re/pat_rt_report.t +++ b/t/re/pat_rt_report.t @@ -30,15 +30,15 @@ run_tests() unless caller; sub run_tests { like("A \x{263a} B z C", qr/A . B (??{ "z" }) C/, - "Match UTF-8 char in presence of (??{ }); Bug 20000731.001"); + "Match UTF-8 char in presence of (??{ }); Bug 20000731.001 (#3600)"); { no warnings 'uninitialized'; - ok(undef =~ /^([^\/]*)(.*)$/, "Used to cause a SEGV; Bug 20001021.005"); + ok(undef =~ /^([^\/]*)(.*)$/, "Used to cause a SEGV; Bug 20001021.005 (#4492)"); } { - my $message = 'bug id 20001008.001'; + my $message = 'bug id 20001008.001 (#4407)'; my @x = ("stra\337e 138", "stra\337e 138"); for (@x) { @@ -57,14 +57,14 @@ sub run_tests { { # Fist half of the bug. - my $message = 'HEBREW ACCENT QADMA matched by .*; Bug 20001028.003'; + my $message = 'HEBREW ACCENT QADMA matched by .*; Bug 20001028.003 (#4536)'; my $X = chr (1448); ok(my ($Y) = $X =~ /(.*)/, $message); is($Y, v1448, $message); is(length $Y, 1, $message); # Second half of the bug. - $message = 'HEBREW ACCENT QADMA in replacement; Bug 20001028.003'; + $message = 'HEBREW ACCENT QADMA in replacement; Bug 20001028.003 (#4536)'; $X = ''; $X =~ s/^/chr(1488)/e; is(length $X, 1, $message); @@ -72,7 +72,7 @@ sub run_tests { } { - my $message = 'Repeated s///; Bug 20001108.001'; + my $message = 'Repeated s///; Bug 20001108.001 (#4631)'; my $X = "Szab\x{f3},Bal\x{e1}zs"; my $Y = $X; $Y =~ s/(B)/$1/ for 0 .. 3; @@ -81,7 +81,7 @@ sub run_tests { } { - my $message = 's/// on UTF-8 string; Bug 20000517.001'; + my $message = 's/// on UTF-8 string; Bug 20000517.001 (#3253)'; my $x = "\x{100}A"; $x =~ s/A/B/; is($x, "\x{100}B", $message); @@ -91,13 +91,13 @@ sub run_tests { { # The original bug report had 'no utf8' here but that was irrelevant. - my $message = "Don't dump core; Bug 20010306.008"; + my $message = "Don't dump core; Bug 20010306.008 (#5982)"; my $a = "a\x{1234}"; like($a, qr/\w/, $message); # used to core dump. } { - my $message = '/g in scalar context; Bug 20010410.006'; + my $message = '/g in scalar context; Bug 20010410.006 (#6796)'; for my $rx ('/(.*?)\{(.*?)\}/csg', '/(.*?)\{(.*?)\}/cg', '/(.*?)\{(.*?)\}/sg', @@ -117,28 +117,28 @@ sub run_tests { { # Amazingly vertical tabulator is the same in ASCII and EBCDIC. for ("\n", "\t", "\014", "\r") { - unlike($_, qr/[[:print:]]/, sprintf "\\%03o not in [[:print:]]; Bug 20010619.003", ord $_); + unlike($_, qr/[[:print:]]/, sprintf "\\%03o not in [[:print:]]; Bug 20010619.003 (#7131)", ord $_); } for (" ") { - like($_, qr/[[:print:]]/, "'$_' in [[:print:]]; Bug 20010619.003"); + like($_, qr/[[:print:]]/, "'$_' in [[:print:]]; Bug 20010619.003 (#7131)"); } } { - # [ID 20010814.004] pos() doesn't work when using =~m// in list context + # [ID 20010814.004 (#7526)] pos() doesn't work when using =~m// in list context $_ = "ababacadaea"; my $a = join ":", /b./gc; my $b = join ":", /a./gc; my $c = pos; - is("$a $b $c", 'ba:ba ad:ae 10', "pos() works with () = m//; Bug 20010814.004"); + is("$a $b $c", 'ba:ba ad:ae 10', "pos() works with () = m//; Bug 20010814.004 (#7526)"); } { - # [ID 20010407.006] matching utf8 return values from + # [ID 20010407.006 (#6767)] matching utf8 return values from # functions does not work - my $message = 'UTF-8 return values from functions; Bug 20010407.006'; + my $message = 'UTF-8 return values from functions; Bug 20010407.006 (#6767)'; package ID_20010407_006; sub x {"a\x{1234}"} my $x = x; @@ -174,7 +174,7 @@ sub run_tests { } { - my $message = "s///eg [change 13f46d054db22cf4]; Bug 20020124.005"; + my $message = "s///eg [change 13f46d054db22cf4]; Bug 20020124.005 (#8335)"; for my $char ("a", "\x{df}", "\x{100}") { my $x = "$char b $char"; @@ -187,7 +187,7 @@ sub run_tests { } { - my $message = "Correct pmop flags checked when empty pattern; Bug 20020412.005"; + my $message = "Correct pmop flags checked when empty pattern; Bug 20020412.005 (#8935)"; # Requires reuse of last successful pattern. my $num = 123; @@ -205,7 +205,7 @@ sub run_tests { } { - my $message = 'UTF-8 regex matches above 32k; Bug 20020630.002'; + my $message = 'UTF-8 regex matches above 32k; Bug 20020630.002 (#10013)'; for (['byte', "\x{ff}"], ['utf8', "\x{1ff}"]) { my ($type, $char) = @$_; for my $len (32000, 32768, 33000) { diff --git a/t/re/re_tests b/t/re/re_tests index 7e8522d..b72b18a 100644 --- a/t/re/re_tests +++ b/t/re/re_tests @@ -957,12 +957,12 @@ tt+$ xxxtt y - - (abc)?(abc)+ abc y $1:$2 :abc - 'b\s^'m a\nb\n n - - \ba a y - - -^(a(??{"(?!)"})|(a)(?{1}))b ab y $2 a # [ID 20010811.006] -ab(?i)cd AbCd n - - # [ID 20010809.023] +^(a(??{"(?!)"})|(a)(?{1}))b ab y $2 a # [ID 20010811.006 (#7512)] +ab(?i)cd AbCd n - - # [ID 20010809.023 (#7503)] ab(?i)cd abCd y - - (A|B)*(?(1)(CD)|(CD)) CD y $2-$3 -CD (A|B)*(?(1)(CD)|(CD)) ABCD y $2-$3 CD- -(A|B)*?(?(1)(CD)|(CD)) CD y $2-$3 -CD # [ID 20010803.016] +(A|B)*?(?(1)(CD)|(CD)) CD y $2-$3 -CD # [ID 20010803.016 (#7438)] (A|B)*?(?(1)(CD)|(CD)) ABCD y $2-$3 CD- '^(o)(?!.*\1)'i Oo n - - (.*)\d+\1 abc12bc y $1 bc diff --git a/t/run/fresh_perl.t b/t/run/fresh_perl.t index 4b5f776..411ff04 100644 --- a/t/run/fresh_perl.t +++ b/t/run/fresh_perl.t @@ -563,13 +563,13 @@ EOT EXPECT ok ######## -# [ID 20001202.002] and change #8066 added 'at -e line 1'; +# [ID 20001202.002 (#4821)] and change #8066 added 'at -e line 1'; # reversed again as a result of [perl #17763] die qr(x) EXPECT (?^:x) ######## -# 20001210.003 [email protected] +# 20001210.003 (#4893) [email protected] format REMITOUT_TOP = FOO . @@ -615,11 +615,11 @@ new_pmop "abcdef"; reset; close STDERR; die; EXPECT ######## -# core dump in 20000716.007 +# core dump in 20000716.007 (#3516) -w "x" =~ /(\G?x)?/; ######## -# Bug 20010515.004 +# Bug 20010515.004 (#6998) my @h = 1 .. 10; bad(@h); sub bad { @@ -632,7 +632,7 @@ EXPECT O Use of freed value in iteration at - line 7. ######## -# Bug 20010506.041 +# Bug 20010506.041 (#6952) "abcd\x{1234}" =~ /(a)(b[c])(d+)?/i and print "ok\n"; EXPECT ok @@ -663,13 +663,13 @@ Bar=ARRAY(0x...) BEGIN { print "ok\n" } EXPECT ok -######## scalar ref to file test operator segfaults on 5.6.1 [ID 20011127.155] +######## scalar ref to file test operator segfaults on 5.6.1 [ID 20011127.155 (#7947)] # This only happens if the filename is 11 characters or less. $foo = \-f "blah"; print "ok" if ref $foo && !$$foo; EXPECT ok -######## [ID 20011128.159] 'X' =~ /\X/ segfault in 5.6.1 +######## [ID 20011128.159 (#7951)] 'X' =~ /\X/ segfault in 5.6.1 print "ok" if 'X' =~ /\X/; EXPECT ok @@ -725,7 +725,7 @@ $code = eval q[ print $x; EXPECT ok 1 -######## [ID 20020623.009] nested eval/sub segfaults +######## [ID 20020623.009 (#9728)] nested eval/sub segfaults $eval = eval 'sub { eval "sub { %S }" }'; $eval->({}); ######## [perl #17951] Strange UTF error diff --git a/t/run/switches.t b/t/run/switches.t index aa9bda3..0018a74 100644 --- a/t/run/switches.t +++ b/t/run/switches.t @@ -165,7 +165,7 @@ SWTEST is( $r, 'foo1', '-s on the shebang line' ); } -# Bug ID 20011106.084 +# Bug ID 20011106.084 (#7876) $filename = tempfile(); SKIP: { open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" ); diff --git a/t/uni/caller.t b/t/uni/caller.t index b98ae07..9f804aa 100644 --- a/t/uni/caller.t +++ b/t/uni/caller.t @@ -24,7 +24,7 @@ sub { @c = caller(0) } -> (); ::is( $c[3], "ï½ï½ï½ï½::__ANON__", "anonymous subroutine name" ); ::ok( $c[4], "hasargs true with anon sub" ); -# Bug 20020517.003, used to dump core +# Bug 20020517.003 (#9367), used to dump core sub ï½ï½ï½ { @c = caller(0) } my $fooref = delete $ï½ï½ï½ï½::{ï½ï½ï½}; $fooref -> (); diff --git a/t/uni/gv.t b/t/uni/gv.t index da48910..f518831 100644 --- a/t/uni/gv.t +++ b/t/uni/gv.t @@ -219,7 +219,7 @@ is (*{*áº{GLOB}}, "*main::STDOUT"); is ($state, 'ok'); } -# [ID 20010526.001] localized glob loses value when assigned to +# [ID 20010526.001 (#7038)] localized glob loses value when assigned to $Ｊ=1; %Ｊ=(a=>1); @Ｊ=(1); local *Ｊ=*Ｊ; *Ｊ = sub{}; diff --git a/t/uni/sprintf.t b/t/uni/sprintf.t index 258ab54..1349bb7 100644 --- a/t/uni/sprintf.t +++ b/t/uni/sprintf.t @@ -113,7 +113,7 @@ $c = 0x200; } { - # 20010407.008 sprintf removes utf8-ness + # 20010407.008 (#6769) sprintf removes utf8-ness $a = sprintf "\x{1234}"; is((sprintf "%x %d", unpack("U*", $a), length($a)), "1234 1", '\x{1234}'); -- Perl5 Master Repository
