6 @INC = qw(: ::lib ::macos:lib);
21 my $deparse = B::Deparse->new() or print "not ";
23 print "ok " . $i++ . "\n";
26 # Tell B::Deparse about our ambient pragmas
27 { my ($hint_bits, $warning_bits);
28 # Note: there used to be ${^WARNING_BITS} here, instead of
29 # warnings::bits('all'), but this doesn't work, as ${^WARNING_BITS} is
30 # supposed to be the set of warnings this code has been compiled with, and
31 # later in this test we include modules that themselves use warnings::register
32 # (thus modyfing the warnings mask).
33 BEGIN { ($hint_bits, $warning_bits) = ($^H, warnings::bits('all')); }
34 $deparse->ambient_pragmas (
35 hint_bits => $hint_bits,
36 warning_bits => $warning_bits,
46 my ($input, $expected);
47 if (/(.*)\n>>>>\n(.*)/s) {
48 ($input, $expected) = ($1, $2);
51 ($input, $expected) = ($_, $_);
54 my $coderef = eval "sub {$input}";
57 print "not ok " . $i++ . "\n";
61 my $deparsed = $deparse->coderef2text( $coderef );
62 my $regex = quotemeta($expected);
65 $regex =~ s/\s+/\s+/g;
68 my $ok = ($deparsed =~ /^\{\s*$regex\s*\}$/);
69 print (($ok ? "ok " : "not ok ") . $i++ . "\n");
71 print "# EXPECTED:\n";
76 $deparsed =~ s/^/# /mg;
82 use constant 'c', 'stuff';
83 print "not " if (eval "sub ".$deparse->coderef2text(\&c))->() ne 'stuff';
84 print "ok " . $i++ . "\n";
87 print "not " if "{\n (-1) ** \$a;\n}"
88 ne $deparse->coderef2text(sub{(-1) ** $a });
89 print "ok " . $i++ . "\n";
91 # XXX ToDo - constsub that returns a reference
92 #use constant cr => ['hello'];
93 #my $string = "sub " . $deparse->coderef2text(\&cr);
94 #my $val = (eval $string)->();
95 #print "not " if ref($val) ne 'ARRAY' || $val->[0] ne 'hello';
96 #print "ok " . $i++ . "\n";
99 my $Is_VMS = $^O eq 'VMS';
100 my $Is_MacOS = $^O eq 'MacOS';
102 my $path = join " ", map { qq["-I$_"] } @INC;
103 $path .= " -MMac::err=unix" if $Is_MacOS;
104 my $redir = $Is_MacOS ? "" : "2>&1";
106 $a = `$^X $path "-MO=Deparse" -anlwi.bak -e 1 $redir`;
107 $a =~ s/-e syntax OK\n//g;
108 $a =~ s/.*possible typo.*\n//; # Remove warning line
109 $a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037
110 $a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc'
112 BEGIN { $^I = ".bak"; }
114 BEGIN { $/ = "\n"; $\ = "\n"; }
115 LINE: while (defined($_ = <ARGV>)) {
117 our(@F) = split(" ", $_, 0);
121 $b =~ s/(LINE:)/sub BEGIN {
122 'MacPerl'->bootstrap;
127 print "# [$a]\n\# vs expected\n# [$b]\nnot " if $a ne $b;
128 print "ok " . $i++ . "\n";
143 ++$test and $test /= 2;
146 $test /= 2 if ++$test;
153 my $test = sub : lvalue {
161 my $test = sub : method {
169 my $test = sub : locked method {
197 $_ .= <ARGV> . <$foo>;
200 my $foo = "Ab\x{100}\200\x{200}\377Cd\000Ef\x{1000}\cA\x{2000}\cZ";