This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix pragma/utf8.t # 15
[perl5.git] / t / lib / b.t
CommitLineData
ccc418af
GS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
db5fd395
CN
5 if ($^O eq 'MacOS') {
6 @INC = qw(: ::lib ::macos:lib);
7 } else {
8 @INC = '.';
9 push @INC, '../lib';
10 }
ccc418af
GS
11}
12
13$| = 1;
14use warnings;
15use strict;
16use Config;
17
1e1dbab6 18print "1..17\n";
ccc418af
GS
19
20my $test = 1;
21
22sub ok { print "ok $test\n"; $test++ }
23
24use B::Deparse;
25my $deparse = B::Deparse->new() or print "not ";
26ok;
27
28print "not " if "{\n 1;\n}" ne $deparse->coderef2text(sub {1});
29ok;
30
31print "not " if "{\n '???';\n 2;\n}" ne
32 $deparse->coderef2text(sub {1;2});
33ok;
34
35print "not " if "{\n \$test /= 2 if ++\$test;\n}" ne
36 $deparse->coderef2text(sub {++$test and $test/=2;});
37ok;
9b86dfa2
SC
38{
39my $a = <<'EOF';
40{
41 $test = sub : lvalue {
78f9721b 42 my $x;
9b86dfa2
SC
43 }
44 ;
45}
46EOF
47chomp $a;
78f9721b 48print "not " if $deparse->coderef2text(sub{$test = sub : lvalue{my $x}}) ne $a;
9b86dfa2
SC
49ok;
50
51$a =~ s/lvalue/method/;
78f9721b 52print "not " if $deparse->coderef2text(sub{$test = sub : method{my $x}}) ne $a;
9b86dfa2
SC
53ok;
54
55$a =~ s/method/locked method/;
78f9721b 56print "not " if $deparse->coderef2text(sub{$test = sub : method locked {my $x}})
9b86dfa2
SC
57 ne $a;
58ok;
59}
ccc418af 60
de3f1649
JT
61print "not " if (eval "sub ".$deparse->coderef2text(sub () { 42 }))->() != 42;
62ok;
63
64use constant 'c', 'stuff';
65print "not " if (eval "sub ".$deparse->coderef2text(\&c))->() ne 'stuff';
66ok;
67
68# XXX ToDo - constsub that returns a reference
69#use constant cr => ['hello'];
70#my $string = "sub " . $deparse->coderef2text(\&cr);
71#my $val = (eval $string)->();
72#print "not " if ref($val) ne 'ARRAY' || $val->[0] ne 'hello';
73#ok;
74
885a8af1
JH
75my $a;
76my $Is_VMS = $^O eq 'VMS';
db5fd395
CN
77my $Is_MacOS = $^O eq 'MacOS';
78
79my $path = join " ", map { qq["-I$_"] } @INC;
80my $redir = $Is_MacOS ? "" : "2>&1";
81
82$a = `$^X $path "-MO=Deparse" -anle 1 $redir`;
5fb4d820 83$a =~ s/-e syntax OK\n//g;
bd145f00
PP
84$a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037
85$a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc'
ccc418af 86$b = <<'EOF';
ccc418af
GS
87
88LINE: while (defined($_ = <ARGV>)) {
89 chomp $_;
90 @F = split(/\s+/, $_, 0);
58cccf98 91 '???';
ccc418af 92}
ccc418af
GS
93
94EOF
5fb4d820 95print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b;
ccc418af
GS
96ok;
97
db5fd395 98$a = `$^X $path "-MO=Debug" -e 1 $redir`;
ccc418af
GS
99print "not " unless $a =~
100/\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s;
101ok;
102
db5fd395 103$a = `$^X $path "-MO=Terse" -e 1 $redir`;
ccc418af 104print "not " unless $a =~
f72d64f0 105/\bLISTOP\b.*leave.*\n OP\b.*enter.*\n COP\b.*nextstate.*\n OP\b.*null/s;
ccc418af
GS
106ok;
107
db5fd395 108$a = `$^X $path "-MO=Terse" -ane "s/foo/bar/" $redir`;
ccc418af
GS
109$a =~ s/\(0x[^)]+\)//g;
110$a =~ s/\[[^\]]+\]//g;
111$a =~ s/-e syntax OK//;
112$a =~ s/[^a-z ]+//g;
113$a =~ s/\s+/ /g;
b2ec7025 114$a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
ccc418af
GS
115$a =~ s/^\s+//;
116$a =~ s/\s+$//;
208edb77
MG
117my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
118if ($is_thread) {
cfe9256d
JH
119 $b=<<EOF;
120leave enter nextstate label leaveloop enterloop null and defined null
121threadsv readline gv lineseq nextstate aassign null pushmark split pushre
122threadsv const null pushmark rvav gv nextstate subst const unstack nextstate
123EOF
124} else {
125 $b=<<EOF;
ccc418af
GS
126leave enter nextstate label leaveloop enterloop null and defined null
127null gvsv readline gv lineseq nextstate aassign null pushmark split pushre
cfe9256d 128null gvsv const null pushmark rvav gv nextstate subst const unstack nextstate
ccc418af 129EOF
cfe9256d 130}
ccc418af
GS
131$b=~s/\n/ /g;$b=~s/\s+/ /g;
132$b =~ s/\s+$//;
cfe9256d 133print "# [$a]\n# vs\n# [$b]\nnot " if $a ne $b;
ccc418af
GS
134ok;
135
db5fd395 136chomp($a = `$^X $path "-MB::Stash" "-Mwarnings" -e1`);
ccc418af 137$a = join ',', sort split /,/, $a;
3ca0b005 138$a =~ s/-u(perlio|open)(?:::\w+)?,//g if defined $Config{'useperlio'} and $Config{'useperlio'} eq 'define';
754a99e1
GS
139$a =~ s/-uWin32,// if $^O eq 'MSWin32';
140$a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
5d129265 141$a =~ s/-uCwd,// if $^O eq 'cygwin';
f3ff050f
JH
142if ($Config{static_ext} eq ' ') {
143 $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
c6eba773 144 . '-umain,-ustrict,-uwarnings';
e5befd65
PP
145 if (ord('A') == 193) { # EBCDIC sort order is qw(a A) not qw(A a)
146 $b = join ',', sort split /,/, $b;
147 }
f3ff050f
JH
148 print "# [$a] vs [$b]\nnot " if $a ne $b;
149 ok;
150} else {
151 print "ok $test # skipped: one or more static extensions\n"; $test++;
152}
ccc418af 153
208edb77 154if ($is_thread) {
cfe9256d
JH
155 print "# use5005threads: test $test skipped\n";
156} else {
db5fd395 157 $a = `$^X $path "-MO=Showlex" -e "my %one" $redir`;
bd145f00
PP
158 if (ord('A') != 193) { # ASCIIish
159 print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
160 }
161 else { # EBCDICish C<1: PVNV (0x1a7ede34) "%\226\225\205">
162 print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%\\[0-9].*sv_undef.*HV/s;
163 }
885a8af1 164}
ccc418af 165ok;
1e1dbab6
SC
166
167# Bug 20001204.07
168{
169my $foo = $deparse->coderef2text(sub { { 234; }});
170# Constants don't get optimised here.
171print "not " unless $foo =~ /{.*{.*234;.*}.*}/sm;
172ok;
173$foo = $deparse->coderef2text(sub { { 234; } continue { 123; } });
174print "not " unless $foo =~ /{.*{.*234;.*}.*continue.*{.*123.*}/sm;
175ok;
176}