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