In deparse.t, give a description to every test. Remove the test numbers.

Pass all test descriptions to Test::More. Remove one duplicated test.

1 files changed, 98 insertions, 83 deletions

diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t
index 570f64efb3..3ae14e92b8 100644
--- a/dist/B-Deparse/t/deparse.t
+++ b/dist/B-Deparse/t/deparse.t
@@ -17,12 +17,12 @@ BEGIN {
     require feature;
     feature->import(':5.10');
 }
-use Test::More tests => 94;
+use Test::More;
 use Config ();
 
 use B::Deparse;
 my $deparse = B::Deparse->new();
-ok($deparse);
+isa_ok($deparse, 'B::Deparse', 'instantiate a B::Deparse object');
 
 # Tell B::Deparse about our ambient pragmas
 { my ($hint_bits, $warning_bits, $hinthash);
@@ -56,7 +56,8 @@ while (<DATA>) {
     }
 
     s/^\s*#\s*(.*)$//mg;
-    my ($num, $testname) = $1 =~ m/(\d+)\s*(.*)/;
+    my $desc = $1;
+    die "Missing name in test $_" unless defined $desc;
 
     if ($reason{skip}) {
 	# Like this to avoid needing a label SKIP:
@@ -75,8 +76,7 @@ while (<DATA>) {
     my $coderef = eval "sub {$input}";
 
     if ($@) {
-	diag("$num deparsed: $@");
-	ok(0, $testname);
+	is($@, "", "compilation of $desc");
     }
     else {
 	my $deparsed = $deparse->coderef2text( $coderef );
@@ -86,21 +86,23 @@ while (<DATA>) {
 	$regex = '^\{\s*' . $regex . '\s*\}$';
 
 	local $::TODO = $reason{todo};
-        like($deparsed, qr/$regex/, $testname);
+        like($deparsed, qr/$regex/, $desc);
     }
 }
 
 use constant 'c', 'stuff';
-is((eval "sub ".$deparse->coderef2text(\&c))->(), 'stuff');
+is((eval "sub ".$deparse->coderef2text(\&c))->(), 'stuff',
+   'the subroutine generated by use constant deparses');
 
 my $a = 0;
-is("{\n    (-1) ** \$a;\n}", $deparse->coderef2text(sub{(-1) ** $a }));
+is($deparse->coderef2text(sub{(-1) ** $a }), "{\n    (-1) ** \$a;\n}",
+   'anon sub capturing an external lexical');
 
 use constant cr => ['hello'];
 my $string = "sub " . $deparse->coderef2text(\&cr);
 my $val = (eval $string)->() or diag $string;
-is(ref($val), 'ARRAY');
-is($val->[0], 'hello');
+is(ref($val), 'ARRAY', 'constant array references deparse');
+is($val->[0], 'hello', 'and return the correct value');
 
 my $path = join " ", map { qq["-I$_"] } @INC;
 
@@ -119,7 +121,8 @@ LINE: while (defined($_ = <ARGV>)) {
     '???';
 }
 EOF
-is($a, $b);
+is($a, $b,
+   'command line flags deparse as BEGIN blocks setting control variables');
 
 $a = `$^X $path "-MO=Deparse" -e "use constant PI => 4" 2>&1`;
 $a =~ s/-e syntax OK\n//g;
@@ -152,7 +155,8 @@ use POSIX qw/O_CREAT/;
 sub test {
    my $val = shift;
    my $res = B::Deparse::Wrapper::getcode($val);
-   like( $res, qr/use warnings/);
+   like($res, qr/use warnings/,
+	'[perl #35857] [PATCH] B::Deparse doesnt handle warnings register properly');
 }
 my ($q,$p);
 my $x=sub { ++$q,++$p };
@@ -179,28 +183,30 @@ EOCODE
   is $deparsed, $code, 'our $funny_Unicode_chars';
 }
 
+done_testing();
+
 __DATA__
-# 2
+# A constant
 1;
 ####
-# 3
+# Constants in a block
 {
     no warnings;
     '???';
     2;
 }
 ####
-# 4
+# Lexical and simple arithmetic
 my $test;
 ++$test and $test /= 2;
 >>>>
 my $test;
 $test /= 2 if ++$test;
 ####
-# 5
+# list x
 -((1, 2) x 2);
 ####
-# 6
+# lvalue sub
 {
     my $test = sub : lvalue {
 	my $x;
@@ -208,7 +214,7 @@ $test /= 2 if ++$test;
     ;
 }
 ####
-# 7
+# method
 {
     my $test = sub : method {
 	my $x;
@@ -216,11 +222,7 @@ $test /= 2 if ++$test;
     ;
 }
 ####
-# 8
-# Was sub : locked method { ... }
-# This number could be re-used.
-####
-# 9
+# block with continue
 {
     234;
 }
@@ -228,166 +230,166 @@ continue {
     123;
 }
 ####
-# 10
+# lexical and package scalars
 my $x;
 print $main::x;
 ####
-# 11
+# lexical and package arrays
 my @x;
 print $main::x[1];
 ####
-# 12
+# lexical and package hashes
 my %x;
 $x{warn()};
 ####
-# 13
+# <>
 my $foo;
 $_ .= <ARGV> . <$foo>;
 ####
-# 14
+# \x{}
 my $foo = "Ab\x{100}\200\x{200}\377Cd\000Ef\x{1000}\cA\x{2000}\cZ";
 ####
-# 15
+# s///e
 s/x/'y';/e;
 ####
-# 16 - various lypes of loop
+# block
 { my $x; }
 ####
-# 17
+# while 1
 while (1) { my $k; }
 ####
-# 18
+# trailing for
 my ($x,@a);
 $x=1 for @a;
 >>>>
 my($x, @a);
 $x = 1 foreach (@a);
 ####
-# 19
+# 2 arguments in a 3 argument for
 for (my $i = 0; $i < 2;) {
     my $z = 1;
 }
 ####
-# 20
+# 3 argument for
 for (my $i = 0; $i < 2; ++$i) {
     my $z = 1;
 }
 ####
-# 21
+# 3 argument for again
 for (my $i = 0; $i < 2; ++$i) {
     my $z = 1;
 }
 ####
-# 22
+# while/continue
 my $i;
 while ($i) { my $z = 1; } continue { $i = 99; }
 ####
-# 23
+# foreach with my
 foreach my $i (1, 2) {
     my $z = 1;
 }
 ####
-# 24
+# foreach
 my $i;
 foreach $i (1, 2) {
     my $z = 1;
 }
 ####
-# 25
+# foreach, 2 mys
 my $i;
 foreach my $i (1, 2) {
     my $z = 1;
 }
 ####
-# 26
+# foreach
 foreach my $i (1, 2) {
     my $z = 1;
 }
 ####
-# 27
+# foreach with our
 foreach our $i (1, 2) {
     my $z = 1;
 }
 ####
-# 28
+# foreach with my and our
 my $i;
 foreach our $i (1, 2) {
     my $z = 1;
 }
 ####
-# 29
+# reverse sort
 my @x;
 print reverse sort(@x);
 ####
-# 30
+# sort with cmp
 my @x;
 print((sort {$b cmp $a} @x));
 ####
-# 31
+# reverse sort with block
 my @x;
 print((reverse sort {$b <=> $a} @x));
 ####
-# 32
+# foreach reverse
 our @a;
 print $_ foreach (reverse @a);
 ####
-# 33
+# foreach reverse (not inplace)
 our @a;
 print $_ foreach (reverse 1, 2..5);
 ####
-# 34  (bug #38684)
+# bug #38684
 our @ary;
 @ary = split(' ', 'foo', 0);
 ####
-# 35 (bug #40055)
+# bug #40055
 do { () }; 
 ####
-# 36 (ibid.)
+# bug #40055
 do { my $x = 1; $x }; 
 ####
-# 37 <20061012113037.GJ25805@c4.convolution.nl>
+# <20061012113037.GJ25805@c4.convolution.nl>
 my $f = sub {
     +{[]};
 } ;
 ####
-# 38 (bug #43010)
+# bug #43010
 '!@$%'->();
 ####
-# 39 (ibid.)
+# bug #43010
 ::();
 ####
-# 40 (ibid.)
+# bug #43010
 '::::'->();
 ####
-# 41 (ibid.)
+# bug #43010
 &::::;
 ####
-# 42
+# variables as method names
 my $bar;
 'Foo'->$bar('orz');
 ####
-# 43
+# constants as method names
 'Foo'->bar('orz');
 ####
-# 44
+# constants as method names without ()
 'Foo'->bar;
 ####
 # SKIP ?$] < 5.010 && "say not implemented on this Perl version"
-# 45 say
+# say
 say 'foo';
 ####
 # SKIP ?$] < 5.010 && "state vars not implemented on this Perl version"
-# 46 state vars
+# state vars
 state $x = 42;
 ####
 # SKIP ?$] < 5.010 && "state vars not implemented on this Perl version"
-# 47 state var assignment
+# state var assignment
 {
     my $y = (state $x = 42);
 }
 ####
 # SKIP ?$] < 5.010 && "state vars not implemented on this Perl version"
-# 48 state vars in anoymous subroutines
+# state vars in anoymous subroutines
 $a = sub {
     state $x;
     return $x++;
@@ -395,53 +397,53 @@ $a = sub {
 ;
 ####
 # SKIP ?$] < 5.011 && 'each @array not implemented on this Perl version'
-# 49 each @array;
+# each @array;
 each @ARGV;
 each @$a;
 ####
 # SKIP ?$] < 5.011 && 'each @array not implemented on this Perl version'
-# 50 keys @array; values @array
+# keys @array; values @array
 keys @$a if keys @ARGV;
 values @ARGV if values @$a;
 ####
-# 51 Anonymous arrays and hashes, and references to them
+# Anonymous arrays and hashes, and references to them
 my $a = {};
 my $b = \{};
 my $c = [];
 my $d = \[];
 ####
 # SKIP ?$] < 5.010 && "smartmatch and given/when not implemented on this Perl version"
-# 52 implicit smartmatch in given/when
+# implicit smartmatch in given/when
 given ('foo') {
     when ('bar') { continue; }
     when ($_ ~~ 'quux') { continue; }
     default { 0; }
 }
 ####
-# 53 conditions in elsifs (regression in change #33710 which fixed bug #37302)
+# conditions in elsifs (regression in change #33710 which fixed bug #37302)
 if ($a) { x(); }
 elsif ($b) { x(); }
 elsif ($a and $b) { x(); }
 elsif ($a or $b) { x(); }
 else { x(); }
 ####
-# 54 interpolation in regexps
+# interpolation in regexps
 my($y, $t);
 /x${y}z$t/;
 ####
 # TODO new undocumented cpan-bug #33708
-# 55  (cpan-bug #33708)
+# cpan-bug #33708
 %{$_ || {}}
 ####
 # TODO hash constants not yet fixed
-# 56  (cpan-bug #33708)
+# cpan-bug #33708
 use constant H => { "#" => 1 }; H->{"#"}
 ####
 # TODO optimized away 0 not yet fixed
-# 57  (cpan-bug #33708)
+# cpan-bug #33708
 foreach my $i (@_) { 0 }
 ####
-# 58 tests with not, not optimized
+# tests with not, not optimized
 my $c;
 x() unless $a;
 x() if not $a and $b;
@@ -461,7 +463,7 @@ x() if not $a or $b or not $c;
 x() unless $a or not $b or $c;
 x() unless not $a or $b or not $c;
 ####
-# 59 tests with not, optimized
+# tests with not, optimized
 my $c;
 x() if not $a;
 x() unless not $a;
@@ -496,7 +498,7 @@ x() unless $a and $b and $c;
 x() if $a and $b and $c;
 x() unless not $a && $b && $c;
 ####
-# 60 tests that should be constant folded
+# tests that should be constant folded
 x() if 1;
 x() if GLIPP;
 x() if !GLIPP;
@@ -549,7 +551,7 @@ do {
 ####
 # TODO constant deparsing has been backed out for 5.12
 # XXXTODO ? $Config::Config{useithreads} && "doesn't work with threads"
-# 61 tests that shouldn't be constant folded
+# tests that shouldn't be constant folded
 # It might be fundamentally impossible to make this work on ithreads, in which
 # case the TODO should become a SKIP
 x() if $a;
@@ -563,24 +565,24 @@ if (do { foo(); GLIPP }) { x(); }
 if (do { ++$a; GLIPP }) { x(); }
 ####
 # TODO constant deparsing has been backed out for 5.12
-# 62 tests for deparsing constants
+# tests for deparsing constants
 warn PI;
 ####
 # TODO constant deparsing has been backed out for 5.12
-# 63 tests for deparsing imported constants
+# tests for deparsing imported constants
 warn O_TRUNC;
 ####
 # TODO constant deparsing has been backed out for 5.12
-# 64 tests for deparsing re-exported constants
+# tests for deparsing re-exported constants
 warn O_CREAT;
 ####
 # TODO constant deparsing has been backed out for 5.12
-# 65 tests for deparsing imported constants that got deleted from the original namespace
+# tests for deparsing imported constants that got deleted from the original namespace
 warn O_APPEND;
 ####
 # TODO constant deparsing has been backed out for 5.12
 # XXXTODO ? $Config::Config{useithreads} && "doesn't work with threads"
-# 66 tests for deparsing constants which got turned into full typeglobs
+# tests for deparsing constants which got turned into full typeglobs
 # It might be fundamentally impossible to make this work on ithreads, in which
 # case the TODO should become a SKIP
 warn O_EXCL;
@@ -588,19 +590,21 @@ eval '@Fcntl::O_EXCL = qw/affe tiger/;';
 warn O_EXCL;
 ####
 # TODO constant deparsing has been backed out for 5.12
-# 67 tests for deparsing of blessed constant with overloaded numification
+# tests for deparsing of blessed constant with overloaded numification
 warn OVERLOADED_NUMIFICATION;
 ####
 # TODO Only strict 'refs' currently supported
-# 68 strict
+# strict
 no strict;
 $x;
 ####
 # TODO Subsets of warnings could be encoded textually, rather than as bitflips.
+# subsets of warnings
 no warnings 'deprecated';
 my $x;
 ####
 # TODO Better test for CPAN #33708 - the deparsed code has different behaviour
+# CPAN #33708
 use strict;
 no warnings;
 
@@ -612,54 +616,65 @@ foreach (0..3) {
     }
 }
 ####
+# no attribute list
 my $pi = 4;
 ####
+# := empty attribute list
 no warnings;
 my $pi := 4;
 >>>>
 no warnings;
 my $pi = 4;
 ####
+# : = empty attribute list
 my $pi : = 4;
 >>>>
 my $pi = 4;
 ####
+# in place sort
 our @a;
 my @b;
 @a = sort @a;
 @b = sort @b;
 ();
 ####
+# in place reverse
 our @a;
 my @b;
 @a = reverse @a;
 @b = reverse @b;
 ();
 ####
+# #71870 Use of uninitialized value in bitwise and B::Deparse
 my($r, $s, @a);
 @a = split(/foo/, $s, 0);
 $r = qr/foo/;
 @a = split(/$r/, $s, 0);
 ();
 ####
+# package declaration before label
 {
     package Foo;
     label: print 123;
 }
 ####
+# shift optimisation
 shift;
 >>>>
 shift();
 ####
+# shift optimisation
 shift @_;
 ####
+# shift optimisation
 pop;
 >>>>
 pop();
 ####
+# shift optimisation
 pop @_;
 ####
-# 82 [perl #20444]
+#[perl #20444]
 "foo" =~ (1 ? /foo/ : /bar/);
 "foo" =~ (1 ? y/foo// : /bar/);
 "foo" =~ (1 ? s/foo// : /bar/);