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