6 @INC = qw(: ::lib ::macos:lib);
22 sub ok { print "ok $test\n"; $test++ }
26 my $deparse = B::Deparse->new() or print "not ";
29 # Tell B::Deparse about our ambient pragmas
30 { my ($hint_bits, $warning_bits);
31 BEGIN {($hint_bits, $warning_bits) = ($^H, ${^WARNING_BITS})}
32 $deparse->ambient_pragmas (
33 hint_bits => $hint_bits,
34 warning_bits => $warning_bits,
39 print "not " if "{\n 1;\n}" ne $deparse->coderef2text(sub {1});
42 print "not " if "{\n '???';\n 2;\n}" ne
43 $deparse->coderef2text(sub {1;2});
46 print "not " if "{\n \$test /= 2 if ++\$test;\n}" ne
47 $deparse->coderef2text(sub {++$test and $test/=2;});
50 print "not " if "{\n -((1, 2) x 2);\n}" ne
51 $deparse->coderef2text(sub {-((1,2)x2)});
57 $test = sub : lvalue {
64 print "not " if $deparse->coderef2text(sub{$test = sub : lvalue{my $x}}) ne $a;
67 $a =~ s/lvalue/method/;
68 print "not " if $deparse->coderef2text(sub{$test = sub : method{my $x}}) ne $a;
71 $a =~ s/method/locked method/;
72 print "not " if $deparse->coderef2text(sub{$test = sub : method locked {my $x}})
77 print "not " if (eval "sub ".$deparse->coderef2text(sub () { 42 }))->() != 42;
80 use constant 'c', 'stuff';
81 print "not " if (eval "sub ".$deparse->coderef2text(\&c))->() ne 'stuff';
85 print "not " if "{\n (-1) ** \$a;\n}"
86 ne $deparse->coderef2text(sub{(-1) ** $a });
89 # XXX ToDo - constsub that returns a reference
90 #use constant cr => ['hello'];
91 #my $string = "sub " . $deparse->coderef2text(\&cr);
92 #my $val = (eval $string)->();
93 #print "not " if ref($val) ne 'ARRAY' || $val->[0] ne 'hello';
97 my $Is_VMS = $^O eq 'VMS';
98 my $Is_MacOS = $^O eq 'MacOS';
100 my $path = join " ", map { qq["-I$_"] } @INC;
101 my $redir = $Is_MacOS ? "" : "2>&1";
103 $a = `$^X $path "-MO=Deparse" -anle 1 $redir`;
104 $a =~ s/-e syntax OK\n//g;
105 $a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037
106 $a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc'
109 LINE: while (defined($_ = <ARGV>)) {
111 @F = split(" ", $_, 0);
116 print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b;
122 my $foo = $deparse->coderef2text(sub { { 234; }});
123 # Constants don't get optimised here.
124 print "not " unless $foo =~ /{.*{.*234;.*}.*}/sm;
126 $foo = $deparse->coderef2text(sub { { 234; } continue { 123; } });
127 print "not " unless $foo =~ /{.*{.*234;.*}.*continue.*{.*123.*}/sm;