BEGIN {
chdir 't' if -d 't';
- @INC = '../lib';
+ if ($^O eq 'MacOS') {
+ @INC = qw(: ::lib ::macos:lib);
+ } else {
+ @INC = '.';
+ push @INC, '../lib';
+ }
}
$| = 1;
use strict;
use Config;
-print "1..15\n";
+print "1..19\n";
my $test = 1;
my $deparse = B::Deparse->new() or print "not ";
ok;
+# Tell B::Deparse about our ambient pragmas
+{ my ($hint_bits, $warning_bits);
+ BEGIN {($hint_bits, $warning_bits) = ($^H, ${^WARNING_BITS})}
+ $deparse->ambient_pragmas (
+ hint_bits => $hint_bits,
+ warning_bits => $warning_bits,
+ '$[' => 0 + $[
+ );
+}
+
print "not " if "{\n 1;\n}" ne $deparse->coderef2text(sub {1});
ok;
print "not " if "{\n \$test /= 2 if ++\$test;\n}" ne
$deparse->coderef2text(sub {++$test and $test/=2;});
ok;
+
+print "not " if "{\n -((1, 2) x 2);\n}" ne
+ $deparse->coderef2text(sub {-((1,2)x2)});
+ok;
+
{
my $a = <<'EOF';
{
$test = sub : lvalue {
- 1;
+ my $x;
}
;
}
EOF
chomp $a;
-print "not " if $deparse->coderef2text(sub{$test = sub : lvalue { 1 }}) ne $a;
+print "not " if $deparse->coderef2text(sub{$test = sub : lvalue{my $x}}) ne $a;
ok;
$a =~ s/lvalue/method/;
-print "not " if $deparse->coderef2text(sub{$test = sub : method { 1 }}) ne $a;
+print "not " if $deparse->coderef2text(sub{$test = sub : method{my $x}}) ne $a;
ok;
$a =~ s/method/locked method/;
-print "not " if $deparse->coderef2text(sub{$test = sub : method locked { 1 }})
+print "not " if $deparse->coderef2text(sub{$test = sub : method locked {my $x}})
ne $a;
ok;
}
print "not " if (eval "sub ".$deparse->coderef2text(\&c))->() ne 'stuff';
ok;
+$a = 0;
+print "not " if "{\n (-1) ** \$a;\n}"
+ ne $deparse->coderef2text(sub{(-1) ** $a });
+ok;
+
# XXX ToDo - constsub that returns a reference
#use constant cr => ['hello'];
#my $string = "sub " . $deparse->coderef2text(\&cr);
my $a;
my $Is_VMS = $^O eq 'VMS';
-$a = `$^X "-I../lib" "-MO=Deparse" -anle 1 2>&1`;
+my $Is_MacOS = $^O eq 'MacOS';
+
+my $path = join " ", map { qq["-I$_"] } @INC;
+my $redir = $Is_MacOS ? "" : "2>&1";
+
+$a = `$^X $path "-MO=Deparse" -anle 1 $redir`;
$a =~ s/-e syntax OK\n//g;
+$a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037
+$a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc'
$b = <<'EOF';
LINE: while (defined($_ = <ARGV>)) {
chomp $_;
- @F = split(/\s+/, $_, 0);
- '???'
-}
-continue {
- '???'
+ @F = split(" ", $_, 0);
+ '???';
}
EOF
print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b;
ok;
-$a = `$^X "-I../lib" "-MO=Debug" -e 1 2>&1`;
+$a = `$^X $path "-MO=Debug" -e 1 $redir`;
print "not " unless $a =~
/\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s;
ok;
-$a = `$^X "-I../lib" "-MO=Terse" -e 1 2>&1`;
+$a = `$^X $path "-MO=Terse" -e 1 $redir`;
print "not " unless $a =~
-/\bLISTOP\b.*leave.*\bOP\b.*enter.*\bCOP\b.*nextstate.*\bOP\b.*null/s;
+/\bLISTOP\b.*leave.*\n OP\b.*enter.*\n COP\b.*nextstate.*\n OP\b.*null/s;
ok;
-$a = `$^X "-I../lib" "-MO=Terse" -ane "s/foo/bar/" 2>&1`;
+$a = `$^X $path "-MO=Terse" -ane "s/foo/bar/" $redir`;
$a =~ s/\(0x[^)]+\)//g;
$a =~ s/\[[^\]]+\]//g;
$a =~ s/-e syntax OK//;
print "# [$a]\n# vs\n# [$b]\nnot " if $a ne $b;
ok;
-chomp($a = `$^X "-I../lib" "-MB::Stash" "-Mwarnings" -e1`);
+chomp($a = `$^X $path "-MB::Stash" "-Mwarnings" -e1`);
$a = join ',', sort split /,/, $a;
-$a =~ s/-uperlio(?:::\w+)?,//g if $Config{'useperlio'} eq 'define';
+$a =~ s/-u(PerlIO|open)(?:::\w+)?,//g if defined $Config{'useperlio'} and $Config{'useperlio'} eq 'define';
$a =~ s/-uWin32,// if $^O eq 'MSWin32';
$a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
$a =~ s/-uCwd,// if $^O eq 'cygwin';
if ($Config{static_ext} eq ' ') {
$b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
- . '-umain,-uwarnings';
+ . '-umain,-ustrict,-uutf8,-uwarnings';
+ if (ord('A') == 193) { # EBCDIC sort order is qw(a A) not qw(A a)
+ $b = join ',', sort split /,/, $b;
+ }
print "# [$a] vs [$b]\nnot " if $a ne $b;
ok;
} else {
if ($is_thread) {
print "# use5005threads: test $test skipped\n";
} else {
- $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one" 2>&1`;
- print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
+ $a = `$^X $path "-MO=Showlex" -e "my %one" $redir`;
+ if (ord('A') != 193) { # ASCIIish
+ print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
+ }
+ else { # EBCDICish C<1: PVNV (0x1a7ede34) "%\226\225\205">
+ print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%\\[0-9].*sv_undef.*HV/s;
+ }
}
ok;
+
+# Bug 20001204.07
+{
+my $foo = $deparse->coderef2text(sub { { 234; }});
+# Constants don't get optimised here.
+print "not " unless $foo =~ /{.*{.*234;.*}.*}/sm;
+ok;
+$foo = $deparse->coderef2text(sub { { 234; } continue { 123; } });
+print "not " unless $foo =~ /{.*{.*234;.*}.*continue.*{.*123.*}/sm;
+ok;
+}