Better diagnostics by removing an && from an ok() and converting it to
[p5sagit/p5-mst-13.2.git] / ext / B / t / deparse.t
index 3d3df2d..7aeb159 100644 (file)
@@ -21,8 +21,13 @@ BEGIN {
 
 use warnings;
 use strict;
-use feature ":5.10";
-use Test::More tests => 52;
+BEGIN {
+    # BEGIN block is acutally a subroutine :-)
+    return unless $] > 5.009;
+    require feature;
+    feature->import(':5.10');
+}
+use Test::More tests => 57;
 
 use B::Deparse;
 my $deparse = B::Deparse->new();
@@ -42,8 +47,29 @@ ok($deparse);
 $/ = "\n####\n";
 while (<DATA>) {
     chomp;
+    # This code is pinched from the t/lib/common.pl for TODO.
+    # It's not clear how to avoid duplication
+    my ($skip, $skip_reason);
+    s/^#\s*SKIP\s*(.*)\n//m and $skip_reason = $1;
+    # If the SKIP reason starts ? then it's taken as a code snippet to evaluate
+    # This provides the flexibility to have conditional SKIPs
+    if ($skip_reason && $skip_reason =~ s/^\?//) {
+       my $temp = eval $skip_reason;
+       if ($@) {
+           die "# In SKIP code reason:\n# $skip_reason\n$@";
+       }
+       $skip_reason = $temp;
+    }
+
     s/#\s*(.*)$//mg;
     my ($num, $testname) = $1 =~ m/(\d+)\s*(.*)/;
+
+    if ($skip_reason) {
+       # Like this to avoid needing a label SKIP:
+       Test::More->builder->skip($skip_reason);
+       next;
+    }
+
     my ($input, $expected);
     if (/(.*)\n>>>>\n(.*)/s) {
        ($input, $expected) = ($1, $2);
@@ -76,8 +102,9 @@ is("{\n    (-1) ** \$a;\n}", $deparse->coderef2text(sub{(-1) ** $a }));
 
 use constant cr => ['hello'];
 my $string = "sub " . $deparse->coderef2text(\&cr);
-my $val = (eval $string)->();
-ok( ref($val) eq 'ARRAY' && $val->[0] eq 'hello');
+my $val = (eval $string)->() or diag $string;
+is(ref($val), 'ARRAY');
+is($val->[0], 'hello');
 
 my $Is_VMS = $^O eq 'VMS';
 my $Is_MacOS = $^O eq 'MacOS';
@@ -337,8 +364,34 @@ my $bar;
 # 44
 'Foo'->bar;
 ####
-# 45 state vars
+# SKIP ?$] < 5.010 && "say not implemented on this Perl version"
+# 45 say
+say 'foo';
+####
+# SKIP ?$] < 5.010 && "state vars not implemented on this Perl version"
+# 46 state vars
 state $x = 42;
 ####
-# 46 say
-say 'foo';
+# SKIP ?$] < 5.010 && "state vars not implemented on this Perl version"
+# 47 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
+$a = sub {
+    state $x;
+    return $x++;
+}
+;
+####
+# SKIP ?$] < 5.011 && 'each @array not implemented on this Perl version'
+# 49 each @array;
+each @ARGV;
+each @$a;
+####
+# SKIP ?$] < 5.011 && 'each @array not implemented on this Perl version'
+# 50 keys @array; values @array
+keys @$a if keys @ARGV;
+values @ARGV if values @$a;