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