1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 if ($^O eq 'MacOS') { 6 @INC = qw(: ::lib ::macos:lib); 7 } else { 8 @INC = '.'; 9 push @INC, '../lib'; 10 } 11} 12 13$| = 1; 14use warnings; 15use strict; 16use Config; 17 18print "1..32\n"; 19 20use B::Deparse; 21my $deparse = B::Deparse->new() or print "not "; 22my $i=1; 23print "ok " . $i++ . "\n"; 24 25 26# Tell B::Deparse about our ambient pragmas 27{ my ($hint_bits, $warning_bits); 28 BEGIN { ($hint_bits, $warning_bits) = ($^H, ${^WARNING_BITS}); } 29 $deparse->ambient_pragmas ( 30 hint_bits => $hint_bits, 31 warning_bits => $warning_bits, 32 '$[' => 0 + $[ 33 ); 34} 35 36$/ = "\n####\n"; 37while (<DATA>) { 38 chomp; 39 s/#.*$//mg; 40 41 my ($input, $expected); 42 if (/(.*)\n>>>>\n(.*)/s) { 43 ($input, $expected) = ($1, $2); 44 } 45 else { 46 ($input, $expected) = ($_, $_); 47 } 48 49 my $coderef = eval "sub {$input}"; 50 51 if ($@) { 52 print "not ok " . $i++ . "\n"; 53 print "# $@"; 54 } 55 else { 56 my $deparsed = $deparse->coderef2text( $coderef ); 57 my $regex = quotemeta($expected); 58 do { 59 no warnings 'misc'; 60 $regex =~ s/\s+/\s+/g; 61 }; 62 63 my $ok = ($deparsed =~ /^\{\s*$regex\s*\}$/); 64 print (($ok ? "ok " : "not ok ") . $i++ . "\n"); 65 if (!$ok) { 66 print "# EXPECTED:\n"; 67 $regex =~ s/^/# /mg; 68 print "$regex\n"; 69 70 print "\n# GOT: \n"; 71 $deparsed =~ s/^/# /mg; 72 print "$deparsed\n"; 73 } 74 } 75} 76 77use constant 'c', 'stuff'; 78print "not " if (eval "sub ".$deparse->coderef2text(\&c))->() ne 'stuff'; 79print "ok " . $i++ . "\n"; 80 81$a = 0; 82print "not " if "{\n (-1) ** \$a;\n}" 83 ne $deparse->coderef2text(sub{(-1) ** $a }); 84print "ok " . $i++ . "\n"; 85 86use constant cr => ['hello']; 87my $string = "sub " . $deparse->coderef2text(\&cr); 88my $val = (eval $string)->(); 89print "not " if ref($val) ne 'ARRAY' || $val->[0] ne 'hello'; 90print "ok " . $i++ . "\n"; 91 92my $a; 93my $Is_VMS = $^O eq 'VMS'; 94my $Is_MacOS = $^O eq 'MacOS'; 95 96my $path = join " ", map { qq["-I$_"] } @INC; 97$path .= " -MMac::err=unix" if $Is_MacOS; 98my $redir = $Is_MacOS ? "" : "2>&1"; 99 100$a = `$^X $path "-MO=Deparse" -anlwi.bak -e 1 $redir`; 101$a =~ s/-e syntax OK\n//g; 102$a =~ s/.*possible typo.*\n//; # Remove warning line 103$a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037 104$a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc' 105$b = <<'EOF'; 106BEGIN { $^I = ".bak"; } 107BEGIN { $^W = 1; } 108BEGIN { $/ = "\n"; $\ = "\n"; } 109LINE: while (defined($_ = <ARGV>)) { 110 chomp $_; 111 our(@F) = split(" ", $_, 0); 112 '???'; 113} 114EOF 115$b =~ s/(LINE:)/sub BEGIN { 116 'MacPerl'->bootstrap; 117 'OSA'->bootstrap; 118 'XL'->bootstrap; 119} 120$1/ if $Is_MacOS; 121print "# [$a]\n\# vs expected\n# [$b]\nnot " if $a ne $b; 122print "ok " . $i++ . "\n"; 123 124__DATA__ 125# 2 1261; 127#### 128# 3 129{ 130 no warnings; 131 '???'; 132 2; 133} 134#### 135# 4 136my $test; 137++$test and $test /= 2; 138>>>> 139my $test; 140$test /= 2 if ++$test; 141#### 142# 5 143-((1, 2) x 2); 144#### 145# 6 146{ 147 my $test = sub : lvalue { 148 my $x; 149 } 150 ; 151} 152#### 153# 7 154{ 155 my $test = sub : method { 156 my $x; 157 } 158 ; 159} 160#### 161# 8 162{ 163 my $test = sub : locked method { 164 my $x; 165 } 166 ; 167} 168#### 169# 9 170{ 171 234; 172} 173continue { 174 123; 175} 176#### 177# 10 178my $x; 179print $main::x; 180#### 181# 11 182my @x; 183print $main::x[1]; 184#### 185# 12 186my %x; 187$x{warn()}; 188#### 189# 13 190my $foo; 191$_ .= <ARGV> . <$foo>; 192#### 193# 14 194my $foo = "Ab\x{100}\200\x{200}\377Cd\000Ef\x{1000}\cA\x{2000}\cZ"; 195#### 196# 15 197s/x/'y';/e; 198#### 199# 16 - various lypes of loop 200{ my $x; } 201#### 202# 17 203while (1) { my $k; } 204#### 205# 18 206my ($x,@a); 207$x=1 for @a; 208>>>> 209my($x, @a); 210foreach $_ (@a) { 211 $x = 1; 212} 213#### 214# 19 215for (my $i = 0; $i < 2;) { 216 my $z = 1; 217} 218#### 219# 20 220for (my $i = 0; $i < 2; ++$i) { 221 my $z = 1; 222} 223#### 224# 21 225for (my $i = 0; $i < 2; ++$i) { 226 my $z = 1; 227} 228#### 229# 22 230my $i; 231while ($i) { my $z = 1; } continue { $i = 99; } 232#### 233# 23 234foreach $i (1, 2) { 235 my $z = 1; 236} 237#### 238# 24 239my $i; 240foreach $i (1, 2) { 241 my $z = 1; 242} 243#### 244# 25 245my $i; 246foreach my $i (1, 2) { 247 my $z = 1; 248} 249#### 250# 26 251foreach my $i (1, 2) { 252 my $z = 1; 253} 254#### 255# 27 256foreach our $i (1, 2) { 257 my $z = 1; 258} 259#### 260# 28 261my $i; 262foreach our $i (1, 2) { 263 my $z = 1; 264} 265