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