Upgrade to Win32API-File 0.1101

[p5sagit/p5-mst-13.2.git] / ext / B / t / terse.t

diff --git a/ext/B/t/terse.t b/ext/B/t/terse.t
index cf9bdb4..8d86a49 100644 (file)
--- a/ext/B/t/terse.t
+++ b/ext/B/t/terse.t
@@ -1,29 +1,38 @@
 #!./perl
 
 BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
+        if ($ENV{PERL_CORE}){
+               chdir('t') if -d 't';
+               @INC = ('.', '../lib');
+        } else {
+               unshift @INC, 't';
+        }
+       require Config;
+       if (($Config::Config{'extensions'} !~ /\bB\b/) ){
+               print "1..0 # Skip -- Perl configured without B module\n";
+               exit 0;
+       }
 }
 
-use Test::More tests => 15;
+use Test::More tests => 16;
 
 use_ok( 'B::Terse' );
 
 # indent should return a string indented four spaces times the argument
-is( B::Terse::indent(2), ' ' x 8, 'indent works with an argument' );
-is( B::Terse::indent(), '', 'indent works with no argument' );
+is( B::Terse::indent(2), ' ' x 8, 'indent with an argument' );
+is( B::Terse::indent(), '', 'indent with no argument' );
 
 # this should fail without a reference
 eval { B::Terse::terse('scalar') };
-like( $@, qr/not a reference/, 'terse() caught bad parameters okay' );
+like( $@, qr/not a reference/, 'terse() fed bad parameters' );
 
 # now point it at a sub and see what happens
 sub foo {}
 
 my $sub;
 eval{ $sub = B::Terse::compile('', 'foo') };
-is( $@, '', 'compile() worked without error' );
-ok( defined &$sub, 'got a valid subref back from compile()' );
+is( $@, '', 'compile()' );
+ok( defined &$sub, 'valid subref back from compile()' );
 
 # and point it at a real sub and hope the returned ops look alright
 my $out = tie *STDOUT, 'TieOut';
@@ -33,7 +42,7 @@ $sub->();
 # now build some regexes that should match the dumped ops
 my ($hex, $op) = ('\(0x[a-f0-9]+\)', '\s+\w+');
 my %ops = map { $_ => qr/$_ $hex$op/ }
-       qw ( OP COP     LOOP PMOP UNOP BINOP LOGOP LISTOP );
+       qw ( OP COP LOOP PMOP UNOP BINOP LOGOP LISTOP PVOP );
 
 # split up the output lines into individual ops (terse is, well, terse!)
 # use an array here so $_ is modifiable
@@ -44,9 +53,9 @@ foreach (@lines) {
        if (/^([A-Z]+)\s+/) {
                my $op = $1;
                next unless exists $ops{$op};
-               like( $_, $ops{$op}, "$op appears okay" );
-               delete $ops{$op};
+               like( $_, $ops{$op}, "$op " );
                s/$ops{$op}//;
+               delete $ops{$op};
                redo if $_;
        }
 }
@@ -55,7 +64,9 @@ warn "# didn't find " . join(' ', keys %ops) if keys %ops;
 
 # XXX:
 # this tries to get at all tersified optypes in B::Terse
-# if you add AV, NULL, PADOP, PVOP, or SPECIAL, add it to the regex above too
+# if you can think of a way to produce AV, NULL, PADOP, or SPECIAL,
+# add it to the regex above too. (PADOPs are currently only produced
+# under ithreads, though).
 #
 use vars qw( $a $b );
 sub bar {
@@ -69,22 +80,30 @@ sub bar {
        $a = 1.234;
 
        # this is awful, but it gives a PMOP
-       my $boo = split('', $foo);
+       our @ary = split('', $foo);
 
-       # PMOP
+       # PVOP, LOOP
        LOOP: for (1 .. 10) {
                last LOOP if $_ % 2;
        }
 
        # make a PV
        $foo = "a string";
+
+       # make an OP_SUBSTCONT
+       $foo =~ s/(a)/$1/;
 }
 
 # Schwern's example of finding an RV
 my $path = join " ", map { qq["-I$_"] } @INC;
+$path = '-I::lib -MMac::err=unix' if $^O eq 'MacOS';
 my $redir = $^O eq 'MacOS' ? '' : "2>&1";
 my $items = qx{$^X $path "-MO=Terse" -le "print \\42" $redir};
-like( $items, qr/RV $hex \\42/, 'found an RV, appears okay!' );
+if( $] >= 5.011 ) {
+    like( $items, qr/IV $hex \\42/, 'RV (but now stored in an IV)' );
+} else {
+    like( $items, qr/RV $hex \\42/, 'RV' );
+}
 
 package TieOut;