Commit | Line | Data |
f2ab5a41 |
1 | ################################################################################ |
2 | ## |
bfc37ff7 |
3 | ## $Revision: 8 $ |
f2ab5a41 |
4 | ## $Author: mhx $ |
bfc37ff7 |
5 | ## $Date: 2010/03/07 13:15:45 +0100 $ |
f2ab5a41 |
6 | ## |
7 | ################################################################################ |
8 | ## |
bfc37ff7 |
9 | ## Version 3.x, Copyright (C) 2004-2010, Marcus Holland-Moritz. |
f2ab5a41 |
10 | ## Version 2.x, Copyright (C) 2001, Paul Marquess. |
11 | ## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. |
12 | ## |
13 | ## This program is free software; you can redistribute it and/or |
14 | ## modify it under the same terms as Perl itself. |
15 | ## |
16 | ################################################################################ |
17 | |
18 | =provides |
19 | |
20 | __UNDEFINED__ |
21 | ckWARN |
22 | warner |
23 | Perl_warner |
24 | Perl_warner_nocontext |
25 | |
26 | =implementation |
27 | |
28 | __UNDEFINED__ WARN_ALL 0 |
29 | __UNDEFINED__ WARN_CLOSURE 1 |
30 | __UNDEFINED__ WARN_DEPRECATED 2 |
31 | __UNDEFINED__ WARN_EXITING 3 |
32 | __UNDEFINED__ WARN_GLOB 4 |
33 | __UNDEFINED__ WARN_IO 5 |
34 | __UNDEFINED__ WARN_CLOSED 6 |
35 | __UNDEFINED__ WARN_EXEC 7 |
36 | __UNDEFINED__ WARN_LAYER 8 |
37 | __UNDEFINED__ WARN_NEWLINE 9 |
38 | __UNDEFINED__ WARN_PIPE 10 |
39 | __UNDEFINED__ WARN_UNOPENED 11 |
40 | __UNDEFINED__ WARN_MISC 12 |
41 | __UNDEFINED__ WARN_NUMERIC 13 |
42 | __UNDEFINED__ WARN_ONCE 14 |
43 | __UNDEFINED__ WARN_OVERFLOW 15 |
44 | __UNDEFINED__ WARN_PACK 16 |
45 | __UNDEFINED__ WARN_PORTABLE 17 |
46 | __UNDEFINED__ WARN_RECURSION 18 |
47 | __UNDEFINED__ WARN_REDEFINE 19 |
48 | __UNDEFINED__ WARN_REGEXP 20 |
49 | __UNDEFINED__ WARN_SEVERE 21 |
50 | __UNDEFINED__ WARN_DEBUGGING 22 |
51 | __UNDEFINED__ WARN_INPLACE 23 |
52 | __UNDEFINED__ WARN_INTERNAL 24 |
53 | __UNDEFINED__ WARN_MALLOC 25 |
54 | __UNDEFINED__ WARN_SIGNAL 26 |
55 | __UNDEFINED__ WARN_SUBSTR 27 |
56 | __UNDEFINED__ WARN_SYNTAX 28 |
57 | __UNDEFINED__ WARN_AMBIGUOUS 29 |
58 | __UNDEFINED__ WARN_BAREWORD 30 |
59 | __UNDEFINED__ WARN_DIGIT 31 |
60 | __UNDEFINED__ WARN_PARENTHESIS 32 |
61 | __UNDEFINED__ WARN_PRECEDENCE 33 |
62 | __UNDEFINED__ WARN_PRINTF 34 |
63 | __UNDEFINED__ WARN_PROTOTYPE 35 |
64 | __UNDEFINED__ WARN_QW 36 |
65 | __UNDEFINED__ WARN_RESERVED 37 |
66 | __UNDEFINED__ WARN_SEMICOLON 38 |
67 | __UNDEFINED__ WARN_TAINT 39 |
68 | __UNDEFINED__ WARN_THREADS 40 |
69 | __UNDEFINED__ WARN_UNINITIALIZED 41 |
70 | __UNDEFINED__ WARN_UNPACK 42 |
71 | __UNDEFINED__ WARN_UNTIE 43 |
72 | __UNDEFINED__ WARN_UTF8 44 |
73 | __UNDEFINED__ WARN_VOID 45 |
74 | __UNDEFINED__ WARN_ASSERTIONS 46 |
75 | |
76 | __UNDEFINED__ packWARN(a) (a) |
77 | |
78 | #ifndef ckWARN |
79 | # ifdef G_WARN_ON |
80 | # define ckWARN(a) (PL_dowarn & G_WARN_ON) |
81 | # else |
82 | # define ckWARN(a) PL_dowarn |
83 | # endif |
84 | #endif |
85 | |
f2ab5a41 |
86 | #if { VERSION >= 5.004 } && !defined(warner) |
87 | #if { NEED warner } |
88 | |
89 | void |
90 | warner(U32 err, const char *pat, ...) |
91 | { |
92 | SV *sv; |
93 | va_list args; |
94 | |
95 | PERL_UNUSED_ARG(err); |
96 | |
97 | va_start(args, pat); |
98 | sv = vnewSVpvf(pat, &args); |
99 | va_end(args); |
100 | sv_2mortal(sv); |
101 | warn("%s", SvPV_nolen(sv)); |
102 | } |
103 | |
104 | #define warner Perl_warner |
105 | |
f2ab5a41 |
106 | #define Perl_warner_nocontext Perl_warner |
107 | |
108 | #endif |
109 | #endif |
110 | |
111 | =xsinit |
112 | |
113 | #define NEED_warner |
114 | |
115 | =xsubs |
116 | |
117 | void |
118 | warner() |
119 | CODE: |
120 | #if { VERSION >= 5.004 } |
121 | warner(packWARN(WARN_MISC), "warner %s:%d", "bar", 42); |
122 | #endif |
123 | |
124 | void |
125 | Perl_warner() |
126 | CODE: |
127 | #if { VERSION >= 5.004 } |
128 | Perl_warner(aTHX_ packWARN(WARN_MISC), "Perl_warner %s:%d", "bar", 42); |
129 | #endif |
130 | |
131 | void |
132 | Perl_warner_nocontext() |
133 | CODE: |
134 | #if { VERSION >= 5.004 } |
135 | Perl_warner_nocontext(packWARN(WARN_MISC), "Perl_warner_nocontext %s:%d", "bar", 42); |
136 | #endif |
137 | |
138 | void |
139 | ckWARN() |
140 | CODE: |
141 | #if { VERSION >= 5.004 } |
142 | if (ckWARN(WARN_MISC)) |
143 | Perl_warner_nocontext(packWARN(WARN_MISC), "ckWARN %s:%d", "bar", 42); |
144 | #endif |
145 | |
146 | =tests plan => 5 |
147 | |
148 | $^W = 0; |
149 | |
150 | my $warning; |
151 | |
152 | $SIG{'__WARN__'} = sub { $warning = $_[0] }; |
153 | |
154 | $warning = ''; |
155 | Devel::PPPort::warner(); |
156 | ok($] >= 5.004 ? $warning =~ /^warner bar:42/ : $warning eq ''); |
157 | |
158 | $warning = ''; |
159 | Devel::PPPort::Perl_warner(); |
160 | ok($] >= 5.004 ? $warning =~ /^Perl_warner bar:42/ : $warning eq ''); |
161 | |
162 | $warning = ''; |
163 | Devel::PPPort::Perl_warner_nocontext(); |
164 | ok($] >= 5.004 ? $warning =~ /^Perl_warner_nocontext bar:42/ : $warning eq ''); |
165 | |
166 | $warning = ''; |
167 | Devel::PPPort::ckWARN(); |
168 | ok($warning, ''); |
169 | |
170 | $^W = 1; |
171 | |
172 | $warning = ''; |
173 | Devel::PPPort::ckWARN(); |
174 | ok($] >= 5.004 ? $warning =~ /^ckWARN bar:42/ : $warning eq ''); |
175 | |