Commit | Line | Data |
ccc418af |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | unshift @INC, '../lib'; |
6 | } |
7 | |
8 | $| = 1; |
9 | use warnings; |
10 | use strict; |
11 | use Config; |
12 | |
9b86dfa2 |
13 | print "1..13\n"; |
ccc418af |
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; |
9b86dfa2 |
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 | } |
ccc418af |
55 | |
885a8af1 |
56 | my $a; |
57 | my $Is_VMS = $^O eq 'VMS'; |
58 | if ($Is_VMS) { |
59 | $^X = "MCR $^X"; |
60 | $a = `$^X "-I../lib" "-MO=Deparse" -anle "1"`; |
61 | } |
62 | else { |
63 | $a = `$^X -I../lib -MO=Deparse -anle 1 2>&1`; |
64 | } |
5fb4d820 |
65 | $a =~ s/-e syntax OK\n//g; |
ccc418af |
66 | $b = <<'EOF'; |
ccc418af |
67 | |
68 | LINE: while (defined($_ = <ARGV>)) { |
69 | chomp $_; |
70 | @F = split(/\s+/, $_, 0); |
71 | '???' |
72 | } |
73 | continue { |
74 | '???' |
75 | } |
76 | |
77 | EOF |
5fb4d820 |
78 | print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b; |
ccc418af |
79 | ok; |
80 | |
81 | #6 |
885a8af1 |
82 | if ($Is_VMS) { |
83 | $a = `$^X "-I../lib" "-MO=Debug" -e "1"`; |
84 | } |
85 | else { |
86 | $a = `$^X -I../lib -MO=Debug -e 1 2>&1`; |
87 | } |
ccc418af |
88 | print "not " unless $a =~ |
89 | /\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s; |
90 | ok; |
91 | |
92 | #7 |
885a8af1 |
93 | if ($Is_VMS) { |
94 | $a = `$^X "-I../lib" "-MO=Terse" -e "1"`; |
95 | } |
96 | else { |
97 | $a = `$^X -I../lib -MO=Terse -e 1 2>&1`; |
98 | } |
ccc418af |
99 | print "not " unless $a =~ |
100 | /\bLISTOP\b.*leave.*\bOP\b.*enter.*\bCOP\b.*nextstate.*\bOP\b.*null/s; |
101 | ok; |
102 | |
885a8af1 |
103 | if ($Is_VMS) { |
104 | $a = `$^X "-I../lib" "-MO=Terse" -ane "s/foo/bar/"`; |
105 | } |
106 | else { |
107 | $a = `$^X -I../lib -MO=Terse -ane "s/foo/bar/" 2>&1`; |
108 | } |
ccc418af |
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 |
115 | $a =~ s/^\s+//; |
116 | $a =~ s/\s+$//; |
208edb77 |
117 | my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define'; |
118 | if ($is_thread) { |
cfe9256d |
119 | $b=<<EOF; |
120 | leave enter nextstate label leaveloop enterloop null and defined null |
121 | threadsv readline gv lineseq nextstate aassign null pushmark split pushre |
122 | threadsv const null pushmark rvav gv nextstate subst const unstack nextstate |
123 | EOF |
124 | } else { |
125 | $b=<<EOF; |
ccc418af |
126 | leave enter nextstate label leaveloop enterloop null and defined null |
127 | null gvsv readline gv lineseq nextstate aassign null pushmark split pushre |
cfe9256d |
128 | null gvsv const null pushmark rvav gv nextstate subst const unstack nextstate |
ccc418af |
129 | EOF |
cfe9256d |
130 | } |
ccc418af |
131 | $b=~s/\n/ /g;$b=~s/\s+/ /g; |
132 | $b =~ s/\s+$//; |
cfe9256d |
133 | print "# [$a]\n# vs\n# [$b]\nnot " if $a ne $b; |
ccc418af |
134 | ok; |
135 | |
885a8af1 |
136 | if ($Is_VMS) { |
137 | chomp($a = `$^X "-I../lib" "-MB::Stash" "-Mwarnings" -e "1"`); |
138 | } |
139 | else { |
140 | chomp($a = `$^X -I../lib -MB::Stash -Mwarnings -e1`); |
141 | } |
ccc418af |
142 | $a = join ',', sort split /,/, $a; |
754a99e1 |
143 | $a =~ s/-uWin32,// if $^O eq 'MSWin32'; |
144 | $a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2'; |
5d129265 |
145 | $a =~ s/-uCwd,// if $^O eq 'cygwin'; |
f3ff050f |
146 | if ($Config{static_ext} eq ' ') { |
147 | $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,' |
148 | . '-umain,-uwarnings'; |
149 | print "# [$a] vs [$b]\nnot " if $a ne $b; |
150 | ok; |
151 | } else { |
152 | print "ok $test # skipped: one or more static extensions\n"; $test++; |
153 | } |
ccc418af |
154 | |
208edb77 |
155 | if ($is_thread) { |
cfe9256d |
156 | print "# use5005threads: test $test skipped\n"; |
157 | } else { |
158 | if ($Is_VMS) { |
159 | $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one"`; |
160 | } |
161 | else { |
162 | $a = `$^X -I../lib -MO=Showlex -e "my %one" 2>&1`; |
163 | } |
164 | print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s; |
885a8af1 |
165 | } |
ccc418af |
166 | ok; |