From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 28 Sep 2007 18:04:55 +0000 (+0000)
Subject: Make all of B work on 5.8.x
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e9c69003cd5757daef3982da8dfabe87831a81bf;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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;