This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Document ANYOF_CLASS.
[perl5.git] / t / lib / b-deparse.t
CommitLineData
87a42246
MS
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..14\n";
19
20my $test = 1;
21
22sub ok { print "ok $test\n"; $test++ }
23
24
25use B::Deparse;
26my $deparse = B::Deparse->new() or print "not ";
27ok;
28
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,
35 '$[' => 0 + $[
36 );
37}
38
39print "not " if "{\n 1;\n}" ne $deparse->coderef2text(sub {1});
40ok;
41
42print "not " if "{\n '???';\n 2;\n}" ne
43 $deparse->coderef2text(sub {1;2});
44ok;
45
46print "not " if "{\n \$test /= 2 if ++\$test;\n}" ne
47 $deparse->coderef2text(sub {++$test and $test/=2;});
48ok;
49
50print "not " if "{\n -((1, 2) x 2);\n}" ne
51 $deparse->coderef2text(sub {-((1,2)x2)});
52ok;
53
54{
55my $a = <<'EOF';
56{
57 $test = sub : lvalue {
58 my $x;
59 }
60 ;
61}
62EOF
63chomp $a;
64print "not " if $deparse->coderef2text(sub{$test = sub : lvalue{my $x}}) ne $a;
65ok;
66
67$a =~ s/lvalue/method/;
68print "not " if $deparse->coderef2text(sub{$test = sub : method{my $x}}) ne $a;
69ok;
70
71$a =~ s/method/locked method/;
72print "not " if $deparse->coderef2text(sub{$test = sub : method locked {my $x}})
73 ne $a;
74ok;
75}
76
77print "not " if (eval "sub ".$deparse->coderef2text(sub () { 42 }))->() != 42;
78ok;
79
80use constant 'c', 'stuff';
81print "not " if (eval "sub ".$deparse->coderef2text(\&c))->() ne 'stuff';
82ok;
83
84$a = 0;
85print "not " if "{\n (-1) ** \$a;\n}"
86 ne $deparse->coderef2text(sub{(-1) ** $a });
87ok;
88
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';
94#ok;
95
96my $a;
97my $Is_VMS = $^O eq 'VMS';
98my $Is_MacOS = $^O eq 'MacOS';
99
100my $path = join " ", map { qq["-I$_"] } @INC;
101my $redir = $Is_MacOS ? "" : "2>&1";
102
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'
107$b = <<'EOF';
108
109LINE: while (defined($_ = <ARGV>)) {
110 chomp $_;
111 @F = split(" ", $_, 0);
112 '???';
113}
114
115EOF
116print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b;
117ok;
118
119
120# Bug 20001204.07
121{
122my $foo = $deparse->coderef2text(sub { { 234; }});
123# Constants don't get optimised here.
124print "not " unless $foo =~ /{.*{.*234;.*}.*}/sm;
125ok;
126$foo = $deparse->coderef2text(sub { { 234; } continue { 123; } });
127print "not " unless $foo =~ /{.*{.*234;.*}.*continue.*{.*123.*}/sm;
128ok;
129}