Make all of B work on 5.8.x

p4raw-id: //depot/perl@31994

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index af9c999..85da4e5 100644 (file)
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -835,8 +835,11 @@ sub concise_op {
        $h{arg} = "($label$stash $cseq $loc$arybase)";
        if ($show_src) {
            fill_srclines($pathnm) unless exists $srclines{$pathnm};
-           $h{src} = "$ln: " . ($srclines{$pathnm}[$ln]
-                                // "-src unavailable under -e");
+           # Would love to retain Jim's use of // but this code needs to be
+           # portable to 5.8.x
+           my $line = $srclines{$pathnm}[$ln];
+           $line = "-src unavailable under -e" unless defined $line;
+           $h{src} = "$ln: $line";
        }
     } elsif ($h{class} eq "LOOP") {
        $h{arg} = "(next->" . seq($op->nextop) . " last->" . seq($op->lastop)

diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index 16c5983..b0b3175 100644 (file)
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -1408,7 +1408,9 @@ sub pp_nextstate {
     }
 
     # hack to check that the hint hash hasn't changed
-    if ("@{[sort %{$self->{'hinthash'} || {}}]}" ne "@{[sort %{$op->hints_hash->HASH || {}}]}") {
+    if ($] > 5.009 &&
+       "@{[sort %{$self->{'hinthash'} || {}}]}"
+       ne "@{[sort %{$op->hints_hash->HASH || {}}]}") {
        push @text, declare_hinthash($self->{'hinthash'}, $op->hints_hash->HASH, $self->{indent_size});
        $self->{'hinthash'} = $op->hints_hash->HASH;
     }

diff --git a/ext/B/t/deparse.t b/ext/B/t/deparse.t
index bda7937..8ba8cee 100644 (file)
--- a/ext/B/t/deparse.t
+++ b/ext/B/t/deparse.t
@@ -21,7 +21,12 @@ BEGIN {
 
 use warnings;
 use strict;
-use feature ":5.10";
+BEGIN {
+    # BEGIN block is acutally a subroutine :-)
+    return unless $] > 5.009;
+    require feature;
+    feature->import(':5.10');
+}
 use Test::More tests => 54;
 
 use B::Deparse;
@@ -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);
@@ -337,17 +363,21 @@ my $bar;
 # 44
 'Foo'->bar;
 ####
+# 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;
 ####
+# 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;