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