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
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6 }
7
8 $|  = 1;
9 use warnings;
10 use strict;
11 use Config;
12
13 print "1..17\n";
14
15 my $test = 1;
16
17 sub ok { print "ok $test\n"; $test++ }
18
19 use B::Deparse;
20 my $deparse = B::Deparse->new() or print "not ";
21 ok;
22
23 print "not " if "{\n    1;\n}" ne $deparse->coderef2text(sub {1});
24 ok;
25
26 print "not " if "{\n    '???';\n    2;\n}" ne
27                     $deparse->coderef2text(sub {1;2});
28 ok;
29
30 print "not " if "{\n    \$test /= 2 if ++\$test;\n}" ne
31                     $deparse->coderef2text(sub {++$test and $test/=2;});
32 ok;
33 {
34 my $a = <<'EOF';
35 {
36     $test = sub : lvalue {
37         1;
38     }
39     ;
40 }
41 EOF
42 chomp $a;
43 print "not " if $deparse->coderef2text(sub{$test = sub : lvalue { 1 }}) ne $a;
44 ok;
45
46 $a =~ s/lvalue/method/;
47 print "not " if $deparse->coderef2text(sub{$test = sub : method { 1 }}) ne $a;
48 ok;
49
50 $a =~ s/method/locked method/;
51 print "not " if $deparse->coderef2text(sub{$test = sub : method locked { 1 }})
52                                      ne $a;
53 ok;
54 }
55
56 print "not " if (eval "sub ".$deparse->coderef2text(sub () { 42 }))->() != 42;
57 ok;
58
59 use constant 'c', 'stuff';
60 print "not " if (eval "sub ".$deparse->coderef2text(\&c))->() ne 'stuff';
61 ok;
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
70 my $a;
71 my $Is_VMS = $^O eq 'VMS';
72 $a = `$^X "-I../lib" "-MO=Deparse" -anle 1 2>&1`;
73 $a =~ s/-e syntax OK\n//g;
74 $b = <<'EOF';
75
76 LINE: while (defined($_ = <ARGV>)) {
77     chomp $_;
78     @F = split(/\s+/, $_, 0);
79     '???'
80 }
81
82 EOF
83 print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b;
84 ok;
85
86 $a = `$^X "-I../lib" "-MO=Debug" -e 1 2>&1`;
87 print "not " unless $a =~
88 /\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s;
89 ok;
90
91 $a = `$^X "-I../lib" "-MO=Terse" -e 1 2>&1`;
92 print "not " unless $a =~
93 /\bLISTOP\b.*leave.*\bOP\b.*enter.*\bCOP\b.*nextstate.*\bOP\b.*null/s;
94 ok;
95
96 $a = `$^X "-I../lib" "-MO=Terse" -ane "s/foo/bar/" 2>&1`;
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;
102 $a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
103 $a =~ s/^\s+//;
104 $a =~ s/\s+$//;
105 my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
106 if ($is_thread) {
107     $b=<<EOF;
108 leave enter nextstate label leaveloop enterloop null and defined null
109 threadsv readline gv lineseq nextstate aassign null pushmark split pushre
110 threadsv const null pushmark rvav gv nextstate subst const unstack nextstate
111 EOF
112 } else {
113     $b=<<EOF;
114 leave enter nextstate label leaveloop enterloop null and defined null
115 null gvsv readline gv lineseq nextstate aassign null pushmark split pushre
116 null gvsv const null pushmark rvav gv nextstate subst const unstack nextstate
117 EOF
118 }
119 $b=~s/\n/ /g;$b=~s/\s+/ /g;
120 $b =~ s/\s+$//;
121 print "# [$a]\n# vs\n# [$b]\nnot " if $a ne $b;
122 ok;
123
124 chomp($a = `$^X "-I../lib" "-MB::Stash" "-Mwarnings" -e1`);
125 $a = join ',', sort split /,/, $a;
126 $a =~ s/-u(perlio|open)(?:::\w+)?,//g if defined $Config{'useperlio'} and $Config{'useperlio'} eq 'define';
127 $a =~ s/-uWin32,// if $^O eq 'MSWin32';
128 $a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
129 $a =~ s/-uCwd,// if $^O eq 'cygwin';
130 if ($Config{static_ext} eq ' ') {
131   $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
132      . '-umain,-ustrict,-uwarnings';
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 }
138
139 if ($is_thread) {
140     print "# use5005threads: test $test skipped\n";
141 } else {
142     $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one" 2>&1`;
143     print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
144 }
145 ok;
146
147 # Bug 20001204.07
148 {
149 my $foo = $deparse->coderef2text(sub { { 234; }});
150 # Constants don't get optimised here.
151 print "not " unless $foo =~ /{.*{.*234;.*}.*}/sm;
152 ok;
153 $foo = $deparse->coderef2text(sub { { 234; } continue { 123; } });
154 print "not " unless $foo =~ /{.*{.*234;.*}.*continue.*{.*123.*}/sm; 
155 ok;
156 }