This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
D:P: fix mess.t failures when $0 contains backslashes
[perl5.git] / dist / Devel-PPPort / t / mess.t
1 ################################################################################
2 #
3 #            !!!!!   Do NOT edit this file directly!   !!!!!
4 #
5 #            Edit mktests.PL and/or parts/inc/mess instead.
6 #
7 #  This file was automatically generated from the definition files in the
8 #  parts/inc/ subdirectory by mktests.PL. To learn more about how all this
9 #  works, please read the F<HACKERS> file that came with this distribution.
10 #
11 ################################################################################
12
13 use FindBin ();
14
15 BEGIN {
16   if ($ENV{'PERL_CORE'}) {
17     chdir 't' if -d 't';
18     unshift @INC, '../lib' if -d '../lib' && -d '../ext';
19     require Config; import Config;
20     use vars '%Config';
21     if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) {
22       print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
23       exit 0;
24     }
25   }
26
27   use lib "$FindBin::Bin";
28   use lib "$FindBin::Bin/../parts/inc";
29
30   die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
31
32   sub load {
33     eval "use Test";
34     require 'testutil.pl' if $@;
35     require 'inctools';
36   }
37
38   if (102) {
39     load();
40     plan(tests => 102);
41   }
42 }
43
44 use Devel::PPPort;
45 use strict;
46 BEGIN { $^W = 1; }
47
48 package Devel::PPPort;
49 use vars '@ISA';
50 require DynaLoader;
51 @ISA = qw(DynaLoader);
52 bootstrap Devel::PPPort;
53
54 package main;
55
56 BEGIN { if ("$]" < '5.006') { $^W = 0; } }
57
58 my $warn;
59 my $die;
60 local $SIG{__WARN__} = sub { $warn = $_[0] };
61 local $SIG{__DIE__} = sub { $die = $_[0] };
62
63 my $scalar_ref = \do {my $tmp = 10};
64 my $array_ref = [];
65 my $hash_ref = {};
66 my $obj = bless {}, 'Package';
67
68 undef $die;
69 ok !defined eval { Devel::PPPort::croak_sv("\xE1\n") };
70 ok $@, "\xE1\n";
71 ok $die, "\xE1\n";
72
73 undef $die;
74 ok !defined eval { Devel::PPPort::croak_sv(10) };
75 ok $@ =~ /^10 at \Q$0\E line /;
76 ok $die =~ /^10 at \Q$0\E line /;
77
78 undef $die;
79 $@ = 'should not be visible (1)';
80 ok !defined eval {
81     $@ = 'should not be visible (2)';
82     Devel::PPPort::croak_sv('');
83 };
84 ok $@ =~ /^ at \Q$0\E line /;
85 ok $die =~ /^ at \Q$0\E line /;
86
87 undef $die;
88 $@ = 'should not be visible';
89 ok !defined eval {
90     $@ = 'this must be visible';
91     Devel::PPPort::croak_sv($@)
92 };
93 ok $@ =~ /^this must be visible at \Q$0\E line /;
94 ok $die =~ /^this must be visible at \Q$0\E line /;
95
96 undef $die;
97 $@ = 'should not be visible';
98 ok !defined eval {
99     $@ = "this must be visible\n";
100     Devel::PPPort::croak_sv($@)
101 };
102 ok $@, "this must be visible\n";
103 ok $die, "this must be visible\n";
104
105 undef $die;
106 $@ = 'should not be visible';
107 ok !defined eval {
108     $@ = 'this must be visible';
109     Devel::PPPort::croak_sv_errsv()
110 };
111 ok $@ =~ /^this must be visible at \Q$0\E line /;
112 ok $die =~ /^this must be visible at \Q$0\E line /;
113
114 undef $die;
115 $@ = 'should not be visible';
116 ok !defined eval {
117     $@ = "this must be visible\n";
118     Devel::PPPort::croak_sv_errsv()
119 };
120 ok $@, "this must be visible\n";
121 ok $die, "this must be visible\n";
122
123 undef $die;
124 ok !defined eval { Devel::PPPort::croak_sv_with_counter("message\n") };
125 ok $@, "message\n";
126 ok Devel::PPPort::get_counter(), 1;
127
128 undef $die;
129 ok !defined eval { Devel::PPPort::croak_sv('') };
130 ok $@ =~ /^ at \Q$0\E line /;
131 ok $die =~ /^ at \Q$0\E line /;
132
133 undef $die;
134 ok !defined eval { Devel::PPPort::croak_sv("\xE1") };
135 ok $@ =~ /^\xE1 at \Q$0\E line /;
136 ok $die =~ /^\xE1 at \Q$0\E line /;
137
138 undef $die;
139 ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1") };
140 ok $@ =~ /^\xC3\xA1 at \Q$0\E line /;
141 ok $die =~ /^\xC3\xA1 at \Q$0\E line /;
142
143 undef $warn;
144 Devel::PPPort::warn_sv("\xE1\n");
145 ok $warn, "\xE1\n";
146
147 undef $warn;
148 Devel::PPPort::warn_sv(10);
149 ok $warn =~ /^10 at \Q$0\E line /;
150
151 undef $warn;
152 Devel::PPPort::warn_sv('');
153 ok $warn =~ /^ at \Q$0\E line /;
154
155 undef $warn;
156 Devel::PPPort::warn_sv("\xE1");
157 ok $warn =~ /^\xE1 at \Q$0\E line /;
158
159 undef $warn;
160 Devel::PPPort::warn_sv("\xC3\xA1");
161 ok $warn =~ /^\xC3\xA1 at \Q$0\E line /;
162
163 ok Devel::PPPort::mess_sv("\xE1\n", 0), "\xE1\n";
164 ok Devel::PPPort::mess_sv(do {my $tmp = "\xE1\n"}, 1), "\xE1\n";
165
166 ok Devel::PPPort::mess_sv(10, 0) =~ /^10 at \Q$0\E line /;
167 ok Devel::PPPort::mess_sv(do {my $tmp = 10}, 1) =~ /^10 at \Q$0\E line /;
168
169 ok Devel::PPPort::mess_sv('', 0) =~ /^ at \Q$0\E line /;
170 ok Devel::PPPort::mess_sv(do {my $tmp = ''}, 1) =~ /^ at \Q$0\E line /;
171
172 ok Devel::PPPort::mess_sv("\xE1", 0) =~ /^\xE1 at \Q$0\E line /;
173 ok Devel::PPPort::mess_sv(do {my $tmp = "\xE1"}, 1) =~ /^\xE1 at \Q$0\E line /;
174
175 ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ /^\xC3\xA1 at \Q$0\E line /;
176 ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ /^\xC3\xA1 at \Q$0\E line /;
177
178 if ("$]" >= '5.006') {
179     BEGIN { if ("$]" >= '5.006' && "$]" < '5.008') { require utf8; utf8->import(); } }
180
181     undef $die;
182     ok !defined eval { Devel::PPPort::croak_sv("\x{100}\n") };
183     if ("$]" < '5.007001' || "$]" > '5.007003') {
184         ok $@, "\x{100}\n";
185     } else {
186         skip 'skip: broken utf8 support in die hook', 0;
187     }
188     if ("$]" < '5.007001' || "$]" > '5.008') {
189         ok $die, "\x{100}\n";
190     } else {
191         skip 'skip: broken utf8 support in die hook', 0;
192     }
193
194     undef $die;
195     ok !defined eval { Devel::PPPort::croak_sv("\x{100}") };
196     if ("$]" < '5.007001' || "$]" > '5.007003') {
197         ok $@ =~ /^\x{100} at \Q$0\E line /;
198     } else {
199         skip 'skip: broken utf8 support in die hook', 0;
200     }
201     if ("$]" < '5.007001' || "$]" > '5.008') {
202         ok $die =~ /^\x{100} at \Q$0\E line /;
203     } else {
204         skip 'skip: broken utf8 support in die hook', 0;
205     }
206
207     if ("$]" < '5.007001' || "$]" > '5.008') {
208         undef $warn;
209         Devel::PPPort::warn_sv("\x{100}\n");
210         ok $warn, "\x{100}\n";
211
212         undef $warn;
213         Devel::PPPort::warn_sv("\x{100}");
214         ok (my $tmp = $warn) =~ /^\x{100} at \Q$0\E line /;
215     } else {
216         for (1..2) {
217             skip 'skip: broken utf8 support in warn hook', 0;
218         }
219     }
220
221     ok Devel::PPPort::mess_sv("\x{100}\n", 0), "\x{100}\n";
222     ok Devel::PPPort::mess_sv(do {my $tmp = "\x{100}\n"}, 1), "\x{100}\n";
223
224     ok Devel::PPPort::mess_sv("\x{100}", 0) =~ /^\x{100} at \Q$0\E line /;
225     ok Devel::PPPort::mess_sv(do {my $tmp = "\x{100}"}, 1) =~ /^\x{100} at \Q$0\E line /;
226 } else {
227     for (1..12) {
228         skip 'skip: no utf8 support', 0;
229     }
230 }
231
232 if (ord('A') != 65) {
233     for (1..24) {
234         skip 'skip: no ASCII support', 0;
235     }
236 } elsif (      "$]" >= '5.008'
237          &&    "$]" != '5.013000'     # Broken in these ranges
238          && ! ("$]" >= '5.011005' && "$]" <= '5.012000'))
239 {
240     undef $die;
241     ok !defined eval { Devel::PPPort::croak_sv(eval '"\N{U+E1}\n"') };
242     ok $@, "\xE1\n";
243     ok $die, "\xE1\n";
244
245     undef $die;
246     ok !defined eval { Devel::PPPort::croak_sv(eval '"\N{U+E1}"') };
247     ok $@ =~ /^\xE1 at \Q$0\E line /;
248     ok $die =~ /^\xE1 at \Q$0\E line /;
249
250     {
251         undef $die;
252         my $expect = eval '"\N{U+C3}\N{U+A1}\n"';
253         ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1\n") };
254         ok $@, $expect;
255         ok $die, $expect;
256     }
257
258     {
259         undef $die;
260         my $expect = eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
261         ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1") };
262         ok $@ =~ $expect;
263         ok $die =~ $expect;
264     }
265
266     undef $warn;
267     Devel::PPPort::warn_sv(eval '"\N{U+E1}\n"');
268     ok $warn, "\xE1\n";
269
270     undef $warn;
271     Devel::PPPort::warn_sv(eval '"\N{U+E1}"');
272     ok $warn =~ /^\xE1 at \Q$0\E line /;
273
274     undef $warn;
275     Devel::PPPort::warn_sv("\xC3\xA1\n");
276     ok $warn, eval '"\N{U+C3}\N{U+A1}\n"';
277
278     undef $warn;
279     Devel::PPPort::warn_sv("\xC3\xA1");
280     ok $warn =~ eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
281
282     if ("$]" < '5.004') {
283         for (1..8) {
284             skip 'skip: no support for mess_sv', 0;
285         }
286     }
287     else {
288       ok Devel::PPPort::mess_sv(eval('"\N{U+E1}\n"'), 0), eval '"\N{U+E1}\n"';
289       ok Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}\n"'}, 1), eval '"\N{U+E1}\n"';
290
291       ok Devel::PPPort::mess_sv(eval('"\N{U+E1}"'), 0) =~ eval 'qr/^\N{U+E1} at \Q$0\E line /';
292       ok Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}"'}, 1) =~ eval 'qr/^\N{U+E1} at \Q$0\E line /';
293
294       ok Devel::PPPort::mess_sv("\xC3\xA1\n", 0), eval '"\N{U+C3}\N{U+A1}\n"';
295       ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1\n"}, 1), eval '"\N{U+C3}\N{U+A1}\n"';
296
297       ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
298       ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
299     }
300 } else {
301     for (1..24) {
302         skip 'skip: no support for \N{U+..} syntax', 0;
303     }
304 }
305
306 if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) {
307     undef $die;
308     ok !defined eval { Devel::PPPort::croak_sv($scalar_ref) };
309     ok $@ == $scalar_ref;
310     ok $die == $scalar_ref;
311
312     undef $die;
313     ok !defined eval { Devel::PPPort::croak_sv($array_ref) };
314     ok $@ == $array_ref;
315     ok $die == $array_ref;
316
317     undef $die;
318     ok !defined eval { Devel::PPPort::croak_sv($hash_ref) };
319     ok $@ == $hash_ref;
320     ok $die == $hash_ref;
321
322     undef $die;
323     ok !defined eval { Devel::PPPort::croak_sv($obj) };
324     ok $@ == $obj;
325     ok $die == $obj;
326 } else {
327     for (1..12) {
328         skip 'skip: no support for exceptions', 0;
329     }
330 }
331
332 ok !defined eval { Devel::PPPort::croak_no_modify() };
333 ok $@ =~ /^Modification of a read-only value attempted at \Q$0\E line /;
334
335 ok !defined eval { Devel::PPPort::croak_memory_wrap() };
336 ok $@ =~ /^panic: memory wrap at \Q$0\E line /;
337
338 ok !defined eval { Devel::PPPort::croak_xs_usage("params") };
339 ok $@ =~ /^Usage: Devel::PPPort::croak_xs_usage\(params\) at \Q$0\E line /;
340