This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Update Devel-PPPort to match 3.67
[perl5.git] / dist / Devel-PPPort / parts / inc / warn
CommitLineData
f2ab5a41
MHM		 1################################################################################
2##
b2049988 3## Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
f2ab5a41
MHM		 4## Version 2.x, Copyright (C) 2001, Paul Marquess.
5## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
6##
7## This program is free software; you can redistribute it and/or
8## modify it under the same terms as Perl itself.
9##
10################################################################################
11
12=provides
13
14__UNDEFINED__
15ckWARN
46677718 16ckWARN_d
f2ab5a41 17warner
46677718
N		 18ck_warner
19ck_warner_d
f2ab5a41 20Perl_warner
46677718
N		 21Perl_ck_warner
22Perl_ck_warner_d
f2ab5a41
MHM		 23Perl_warner_nocontext
24
25=implementation
26
b2049988
MHM		 27__UNDEFINED__ WARN_ALL 0
28__UNDEFINED__ WARN_CLOSURE 1
29__UNDEFINED__ WARN_DEPRECATED 2
30__UNDEFINED__ WARN_EXITING 3
31__UNDEFINED__ WARN_GLOB 4
32__UNDEFINED__ WARN_IO 5
33__UNDEFINED__ WARN_CLOSED 6
34__UNDEFINED__ WARN_EXEC 7
35__UNDEFINED__ WARN_LAYER 8
36__UNDEFINED__ WARN_NEWLINE 9
37__UNDEFINED__ WARN_PIPE 10
38__UNDEFINED__ WARN_UNOPENED 11
39__UNDEFINED__ WARN_MISC 12
40__UNDEFINED__ WARN_NUMERIC 13
41__UNDEFINED__ WARN_ONCE 14
42__UNDEFINED__ WARN_OVERFLOW 15
43__UNDEFINED__ WARN_PACK 16
44__UNDEFINED__ WARN_PORTABLE 17
45__UNDEFINED__ WARN_RECURSION 18
46__UNDEFINED__ WARN_REDEFINE 19
47__UNDEFINED__ WARN_REGEXP 20
48__UNDEFINED__ WARN_SEVERE 21
49__UNDEFINED__ WARN_DEBUGGING 22
50__UNDEFINED__ WARN_INPLACE 23
51__UNDEFINED__ WARN_INTERNAL 24
52__UNDEFINED__ WARN_MALLOC 25
53__UNDEFINED__ WARN_SIGNAL 26
54__UNDEFINED__ WARN_SUBSTR 27
55__UNDEFINED__ WARN_SYNTAX 28
56__UNDEFINED__ WARN_AMBIGUOUS 29
57__UNDEFINED__ WARN_BAREWORD 30
58__UNDEFINED__ WARN_DIGIT 31
59__UNDEFINED__ WARN_PARENTHESIS 32
60__UNDEFINED__ WARN_PRECEDENCE 33
61__UNDEFINED__ WARN_PRINTF 34
62__UNDEFINED__ WARN_PROTOTYPE 35
63__UNDEFINED__ WARN_QW 36
64__UNDEFINED__ WARN_RESERVED 37
65__UNDEFINED__ WARN_SEMICOLON 38
66__UNDEFINED__ WARN_TAINT 39
67__UNDEFINED__ WARN_THREADS 40
68__UNDEFINED__ WARN_UNINITIALIZED 41
69__UNDEFINED__ WARN_UNPACK 42
70__UNDEFINED__ WARN_UNTIE 43
71__UNDEFINED__ WARN_UTF8 44
72__UNDEFINED__ WARN_VOID 45
73__UNDEFINED__ WARN_ASSERTIONS 46
f2ab5a41 74
46677718
N		 75__UNDEFINED__ packWARN(a) (a)
76__UNDEFINED__ packWARN2(a,b) (packWARN(a) << 8 | (b))
77__UNDEFINED__ packWARN3(a,b,c) (packWARN2(a,b) << 8 | (c))
78__UNDEFINED__ packWARN4(a,b,c,d) (packWARN3(a,b,c) << 8 | (d))
f2ab5a41
MHM		 79
80#ifndef ckWARN
81# ifdef G_WARN_ON
82# define ckWARN(a) (PL_dowarn & G_WARN_ON)
83# else
84# define ckWARN(a) PL_dowarn
85# endif
86#endif
87
46677718
N		 88__UNDEFINED__ ckWARN2(a,b) (ckWARN(a) || ckWARN(b))
89__UNDEFINED__ ckWARN3(a,b,c) (ckWARN(c) || ckWARN2(a,b))
90__UNDEFINED__ ckWARN4(a,b,c,d) (ckWARN(d) || ckWARN3(a,b,c))
91
92#ifndef ckWARN_d
93# ifdef isLEXWARN_off
94# define ckWARN_d(a) (isLEXWARN_off || ckWARN(a))
95# else
96# define ckWARN_d(a) 1
97# endif
98#endif
99
100__UNDEFINED__ ckWARN2_d(a,b) (ckWARN_d(a) || ckWARN_d(b))
101__UNDEFINED__ ckWARN3_d(a,b,c) (ckWARN_d(c) || ckWARN2_d(a,b))
102__UNDEFINED__ ckWARN4_d(a,b,c,d) (ckWARN_d(d) || ckWARN3_d(a,b,c))
103
104__UNDEFINED__ vwarner(err, pat, argsp) \
105 STMT_START { SV *sv; \
106 PERL_UNUSED_ARG(err); \
107 sv = vnewSVpvf(pat, argsp); \
108 sv_2mortal(sv); \
109 warn("%s", SvPV_nolen(sv)); \
110 } STMT_END
111
112
f2ab5a41 113#if { VERSION >= 5.004 } && !defined(warner)
46677718 114# if { NEED warner }
f2ab5a41
MHM		 115
116void
117warner(U32 err, const char *pat, ...)
118{
f2ab5a41 119 va_list args;
f2ab5a41 120 va_start(args, pat);
46677718 121 vwarner(err, pat, &args);
f2ab5a41 122 va_end(args);
f2ab5a41
MHM		 123}
124
46677718 125# define warner Perl_warner
f2ab5a41 126
46677718 127# define Perl_warner_nocontext Perl_warner
f2ab5a41 128
46677718 129# endif
f2ab5a41 130#endif
46677718
N		 131
132#if { VERSION >= 5.004 } && !defined(ck_warner)
133# if { NEED ck_warner }
134
135void
136ck_warner(pTHX_ U32 err, const char *pat, ...)
137{
138 va_list args;
139
140 if ( ! ckWARN((err ) & 0xFF)
141 && ! ckWARN((err >> 8) & 0xFF)
142 && ! ckWARN((err >> 16) & 0xFF)
143 && ! ckWARN((err >> 24) & 0xFF))
144 {
145 return;
146 }
147
148 va_start(args, pat);
149 vwarner(err, pat, &args);
150 va_end(args);
151}
152
153# define ck_warner Perl_ck_warner
154# endif
155#endif
156
157#if { VERSION >= 5.004 } && !defined(ck_warner_d)
158# if { NEED ck_warner_d }
159
160void
161ck_warner_d(pTHX_ U32 err, const char *pat, ...)
162{
163 va_list args;
164
165 if ( ! ckWARN_d((err ) & 0xFF)
166 && ! ckWARN_d((err >> 8) & 0xFF)
167 && ! ckWARN_d((err >> 16) & 0xFF)
168 && ! ckWARN_d((err >> 24) & 0xFF))
169 {
170 return;
171 }
172
173 va_start(args, pat);
174 vwarner(err, pat, &args);
175 va_end(args);
176}
177
178# define ck_warner_d Perl_ck_warner_d
179
180
181# endif
f2ab5a41
MHM		 182#endif
183
184=xsinit
185
186#define NEED_warner
46677718
N		 187#define NEED_ck_warner
188#define NEED_ck_warner_d
f2ab5a41
MHM		 189
190=xsubs
191
192void
193warner()
b2049988 194 CODE:
f2ab5a41 195#if { VERSION >= 5.004 }
b2049988 196 warner(packWARN(WARN_MISC), "warner %s:%d", "bar", 42);
f2ab5a41
MHM		 197#endif
198
199void
200Perl_warner()
b2049988 201 CODE:
f2ab5a41 202#if { VERSION >= 5.004 }
b2049988 203 Perl_warner(aTHX_ packWARN(WARN_MISC), "Perl_warner %s:%d", "bar", 42);
f2ab5a41
MHM		 204#endif
205
206void
46677718
N		 207Perl_ck_warner()
208 CODE:
209#if { VERSION >= 5.004 }
210 Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Perl_ck_warner %s:%d", "bar", 42);
211#endif
212
213void
214Perl_ck_warner_d()
215 CODE:
216#if { VERSION >= 5.004 }
217 Perl_ck_warner_d(aTHX_ packWARN(WARN_MISC), "Perl_ck_warner_d %s:%d", "bar", 42);
218#endif
219
220void
f2ab5a41 221Perl_warner_nocontext()
b2049988 222 CODE:
f2ab5a41 223#if { VERSION >= 5.004 }
b2049988 224 Perl_warner_nocontext(packWARN(WARN_MISC), "Perl_warner_nocontext %s:%d", "bar", 42);
f2ab5a41
MHM		 225#endif
226
227void
228ckWARN()
b2049988 229 CODE:
f2ab5a41 230#if { VERSION >= 5.004 }
b2049988
MHM		 231 if (ckWARN(WARN_MISC))
232 Perl_warner_nocontext(packWARN(WARN_MISC), "ckWARN %s:%d", "bar", 42);
f2ab5a41
MHM		 233#endif
234
46677718
N		 235void
236ckWARN_d()
237 CODE:
238#if { VERSION >= 5.004 }
239 if (ckWARN_d(WARN_MISC))
240 Perl_warner_nocontext(packWARN(WARN_MISC), "ckWARN_d %s:%d", "bar", 42);
241#endif
242
243=tests plan => 11
f2ab5a41
MHM		 244
245$^W = 0;
246
247my $warning;
248
249$SIG{'__WARN__'} = sub { $warning = $_[0] };
250
251$warning = '';
252Devel::PPPort::warner();
c8799aff 253ok(ivers($]) >= ivers("5.004") ? $warning =~ /^warner bar:42/ : $warning eq '');
f2ab5a41
MHM		 254
255$warning = '';
256Devel::PPPort::Perl_warner();
c8799aff 257ok(ivers($]) >= ivers("5.004") ? $warning =~ /^Perl_warner bar:42/ : $warning eq '');
f2ab5a41
MHM		 258
259$warning = '';
260Devel::PPPort::Perl_warner_nocontext();
c8799aff 261ok(ivers($]) >= ivers("5.004") ? $warning =~ /^Perl_warner_nocontext bar:42/ : $warning eq '');
f2ab5a41
MHM		 262
263$warning = '';
264Devel::PPPort::ckWARN();
8154c0b1 265is($warning, '');
f2ab5a41 266
46677718
N		 267$warning = '';
268Devel::PPPort::ckWARN_d();
269ok(ivers($]) >= ivers("5.004") ? $warning =~ /^ckWARN_d bar:42/ : $warning eq '');
270
271$warning = '';
272Devel::PPPort::Perl_ck_warner();
273ok($warning eq '');
274
275$warning = '';
276Devel::PPPort::Perl_ck_warner_d();
277ok(ivers($]) >= ivers("5.004") ? $warning =~ /^Perl_ck_warner_d bar:42/ : $warning eq '');
278
f2ab5a41
MHM		 279$^W = 1;
280
281$warning = '';
282Devel::PPPort::ckWARN();
c8799aff 283ok(ivers($]) >= ivers("5.004") ? $warning =~ /^ckWARN bar:42/ : $warning eq '');
46677718
N		 284
285$warning = '';
286Devel::PPPort::ckWARN_d();
287ok(ivers($]) >= ivers("5.004") ? $warning =~ /^ckWARN_d bar:42/ : $warning eq '');
288
289$warning = '';
290Devel::PPPort::Perl_ck_warner();
291ok(ivers($]) >= ivers("5.004") ? $warning =~ /^Perl_ck_warner bar:42/ : $warning eq '');
292
293$warning = '';
294Devel::PPPort::Perl_ck_warner_d();
295ok(ivers($]) >= ivers("5.004") ? $warning =~ /^Perl_ck_warner_d bar:42/ : $warning eq '');
Unnamed repository; edit this file 'description' to name the repository.