Move all the cut&paste open TODO logic into OptreeCheck.pm, where it

should have been in the first place. Apply strict and warnings to
OptreeCheck.pm, and remove dead code they show up.

p4raw-id: //depot/perl@30333

diff --git a/ext/B/t/OptreeCheck.pm b/ext/B/t/OptreeCheck.pm
index a3dd3e0..68a6247 100644 (file)
--- a/ext/B/t/OptreeCheck.pm
+++ b/ext/B/t/OptreeCheck.pm
@@ -1,14 +1,24 @@
 package OptreeCheck;
 use base 'Exporter';
+use strict;
+use warnings;
+use vars qw(@open_todo $TODO);
 require "test.pl";
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 # now export checkOptree, and those test.pl functions used by tests
 our @EXPORT = qw( checkOptree plan skip skip_all pass is like unlike
-                 require_ok runperl );
+                 require_ok runperl @open_todo);
 
 
+# This is a bit of a kludge. Really we need to find a way to encode in the
+# golden results that the hints wll differ because ${^OPEN} is set.
+
+if (((caller 0)[10]||{})->{'open'}) {
+    @open_todo = (skip => "\${^OPEN} is set");
+}
+
 =head1 NAME
 
 OptreeCheck - check optrees as rendered by B::Concise
@@ -429,7 +439,7 @@ sub checkOptree {
        $tc->checkErrs();
 
       TODO:
-       foreach $want (@{$modes{$gOpts{testmode}}}) {
+       foreach my $want (@{$modes{$gOpts{testmode}}}) {
            local $TODO = $tc->{todo} if $tc->{todo};
 
            $tc->{cross} = $msgs{"$want-$thrstat"};
@@ -438,7 +448,7 @@ sub checkOptree {
            $tc->mylike();
        }
     }
-    $res;
+    return;
 }
 
 sub newTestCases {
@@ -449,7 +459,7 @@ sub newTestCases {
     $tc->label();
 
     # cpy globals into each test
-    foreach $k (keys %gOpts) {
+    foreach my $k (keys %gOpts) {
        if ($gOpts{$k}) {
            $tc->{$k} = $gOpts{$k} unless defined $tc->{$k};
        }
@@ -508,7 +518,11 @@ sub getRendering {
            # treat as source, and wrap into subref 
            #  in caller's package ( to test arg-fixup, comment next line)
            my $pkg = '{ package '.caller(1) .';';
-           $code = eval "$pkg sub { $code } }";
+           {
+               no strict;
+               no warnings;
+               $code = eval "$pkg sub { $code } }";
+           }
            # return errors
            if ($@) { chomp $@; push @errs, $@ }
        }
@@ -559,6 +573,7 @@ sub checkErrs {
 
     # check for agreement, by hash (order less important)
     my (%goterrs, @got);
+    $tc->{goterrs} ||= [];
     @goterrs{@{$tc->{goterrs}}} = (1) x scalar @{$tc->{goterrs}};
     
     foreach my $k (keys %{$tc->{errs}}) {
@@ -573,7 +588,7 @@ sub checkErrs {
     if (%{$tc->{errs}} or %{$tc->{goterrs}}) {
        $tc->diag_or_fail();
     }
-    fail("FORCED: $tc->{name}:\n$rendering") if $gOpts{fail}; # silly ?
+    fail("FORCED: $tc->{name}:\n") if $gOpts{fail}; # silly ?
 }
 
 sub diag_or_fail {
@@ -691,7 +706,6 @@ sub mkCheckRex {
     $str = "(-e .*?)?(B::Concise::compile.*?)?\n" . $str
        unless $tc->{noanchors} or $tc->{rxnoorder};
     
-    eval "use re 'debug'" if $debug;
     my $qr = ($tc->{noanchors})        ? qr/$str/ms : qr/^$str$/ms ;
     no re 'debug';
 
@@ -879,7 +893,7 @@ sub mydumper {
        or do{
            print "Sorry, Data::Dumper is not available\n";
            print "half hearted attempt:\n";
-           foreach $it (@_) {
+           foreach my $it (@_) {
                if (ref $it eq 'HASH') {
                    print " $_ => $it->{$_}\n" foreach sort keys %$it;
                }
@@ -963,13 +977,6 @@ sub OptreeCheck::gentest {
        my $af = q{expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'};
        $testcode =~ s/$b4/$af/;
        
-       my $got;
-       if ($internal_retest) {
-           $got = runperl( prog => "$preamble $testcode", stderr => 1,
-                           #switches => ["-I../ext/B/t", "-MOptreeCheck"], 
-                           verbose => 1);
-           print "got: $got\n";
-       }
        return $testcode;
     }
     return '';
@@ -987,7 +994,7 @@ sub OptreeCheck::processExamples {
        $/ = "";
        my @chunks = <$fh>;
        print preamble (scalar @chunks);
-       foreach $t (@chunks) {
+       foreach my $t (@chunks) {
            print "\n\n=for gentest\n\n# chunk: $t=cut\n\n";
            print OptreeCheck::gentest ($t);
        }

diff --git a/ext/B/t/optree_check.t b/ext/B/t/optree_check.t
index b603ec9..5128b45 100644 (file)
--- a/ext/B/t/optree_check.t
+++ b/ext/B/t/optree_check.t
@@ -36,13 +36,6 @@ SKIP: {
     skip "no perlio in this build", $tests
     unless $Config::Config{useperlio};
 
-my @open_todo;
-sub open_todo {
-    if (((caller 0)[10]||{})->{open}) {
-       @open_todo = (skip => "\$^OPEN is set");
-    }
-}
-open_todo;
 
 pass("REGEX TEST HARNESS SELFTEST");
 

diff --git a/ext/B/t/optree_concise.t b/ext/B/t/optree_concise.t
index d37c06b..c7166c9 100644 (file)
--- a/ext/B/t/optree_concise.t
+++ b/ext/B/t/optree_concise.t
@@ -32,14 +32,6 @@ $SIG{__WARN__} = sub {
 #################################
 pass("CANONICAL B::Concise EXAMPLE");
 
-my @open_todo;
-sub open_todo {
-    if (((caller 0)[10]||{})->{open}) {
-       @open_todo = (skip => "\$^OPEN is set");
-    }
-}
-open_todo;
-
 checkOptree ( name     => 'canonical example w -basic',
              bcopts    => '-basic',
              code      =>  sub{$a=$b+42},

diff --git a/ext/B/t/optree_constants.t b/ext/B/t/optree_constants.t
index b8ea287..5ae18b6 100644 (file)
--- a/ext/B/t/optree_constants.t
+++ b/ext/B/t/optree_constants.t
@@ -24,14 +24,6 @@ plan tests => $tests;
 SKIP: {
 skip "no perlio in this build", $tests unless $Config::Config{useperlio};
 
-my @open_todo;
-sub open_todo {
-    if (((caller 0)[10]||{})->{open}) {
-       @open_todo = (skip => "\$^OPEN is set");
-    }
-}
-open_todo;
-
 #################################
 
 use constant {         # see also t/op/gv.t line 282

diff --git a/ext/B/t/optree_misc.t b/ext/B/t/optree_misc.t
index 32e75dc..1c7a53d 100644 (file)
--- a/ext/B/t/optree_misc.t
+++ b/ext/B/t/optree_misc.t
@@ -21,14 +21,6 @@ plan tests => 1;
 SKIP: {
 skip "no perlio in this build", 1 unless $Config::Config{useperlio};
 
-my @open_todo;
-sub open_todo {
-    if (((caller 0)[10]||{})->{open}) {
-       @open_todo = (skip => "\$^OPEN is set");
-    }
-}
-open_todo;
-
 # The regression this is testing is that the first aelemfast, derived
 # from a lexical array, is supposed to be a BASEOP "<0>", while the
 # second, from a global, is an SVOP "<$>" or a PADOP "<#>" depending

diff --git a/ext/B/t/optree_samples.t b/ext/B/t/optree_samples.t
index 874e6db..d198c59 100644 (file)
--- a/ext/B/t/optree_samples.t
+++ b/ext/B/t/optree_samples.t
@@ -25,14 +25,6 @@ pass("GENERAL OPTREE EXAMPLES");
 
 pass("IF,THEN,ELSE, ?:");
 
-my @open_todo;
-sub open_todo {
-    if (((caller 0)[10]||{})->{open}) {
-       @open_todo = (skip => "\$^OPEN is set");
-    }
-}
-open_todo;
-
 checkOptree ( name     => '-basic sub {if shift print then,else}',
              bcopts    => '-basic',
              code      => sub { if (shift) { print "then" }

diff --git a/ext/B/t/optree_sort.t b/ext/B/t/optree_sort.t
index 8776e4f..62068e1 100644 (file)
--- a/ext/B/t/optree_sort.t
+++ b/ext/B/t/optree_sort.t
@@ -24,14 +24,6 @@ skip "no perlio in this build", 11 unless $Config::Config{useperlio};
 
 pass("SORT OPTIMIZATION");
 
-my @open_todo;
-sub open_todo {
-    if (((caller 0)[10]||{})->{open}) {
-       @open_todo = (skip => "\$^OPEN is set");
-    }
-}
-open_todo;
-
 checkOptree ( name     => 'sub {sort @a}',
              code      => sub {sort @a},
              bcopts    => '-exec',

diff --git a/ext/B/t/optree_specials.t b/ext/B/t/optree_specials.t
index 9d2a36e..5db9d02 100644 (file)
--- a/ext/B/t/optree_specials.t
+++ b/ext/B/t/optree_specials.t
@@ -47,14 +47,6 @@ my @warnings_todo;
    . "propagated to 5.8.x")
     if $] < 5.009;
 
-my @open_todo;
-sub open_todo {
-    if (((caller 0)[10]||{})->{open}) {
-       @open_todo = (skip => "\$^OPEN is set");
-    }
-}
-open_todo;
-
 checkOptree ( name     => 'BEGIN',
              bcopts    => 'BEGIN',
              prog      => $src,

diff --git a/ext/B/t/optree_varinit.t b/ext/B/t/optree_varinit.t
index e25447d..040757b 100644 (file)
--- a/ext/B/t/optree_varinit.t
+++ b/ext/B/t/optree_varinit.t
@@ -23,14 +23,6 @@ skip "no perlio in this build", 22 unless $Config::Config{useperlio};
 
 pass("OPTIMIZER TESTS - VAR INITIALIZATION");
 
-my @open_todo;
-sub open_todo {
-    if (((caller 0)[10]||{})->{open}) {
-       @open_todo = (skip => "\$^OPEN is set");
-    }
-}
-open_todo;
-
 checkOptree ( name     => 'sub {my $a}',
              bcopts    => '-exec',
              code      => sub {my $a},