dist/Devel-PPPort/parts/inc/warn

   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__
  15 ckWARN
  16 warner
  17 Perl_warner
  18 Perl_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
  83 void
  84 warner(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
 111 void
 112 warner()
 113         CODE:
 114 #if { VERSION >= 5.004 }
 115                 warner(packWARN(WARN_MISC), "warner %s:%d", "bar", 42);
 116 #endif
 117
 118 void
 119 Perl_warner()
 120         CODE:
 121 #if { VERSION >= 5.004 }
 122                 Perl_warner(aTHX_ packWARN(WARN_MISC), "Perl_warner %s:%d", "bar", 42);
 123 #endif
 124
 125 void
 126 Perl_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
 132 void
 133 ckWARN()
 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
 144 my $warning;
 145
 146 $SIG{'__WARN__'} = sub { $warning = $_[0] };
 147
 148 $warning = '';
 149 Devel::PPPort::warner();
 150 ok("$]" >= 5.004 ? $warning =~ /^warner bar:42/ : $warning eq '');
 151
 152 $warning = '';
 153 Devel::PPPort::Perl_warner();
 154 ok("$]" >= 5.004 ? $warning =~ /^Perl_warner bar:42/ : $warning eq '');
 155
 156 $warning = '';
 157 Devel::PPPort::Perl_warner_nocontext();
 158 ok("$]" >= 5.004 ? $warning =~ /^Perl_warner_nocontext bar:42/ : $warning eq '');
 159
 160 $warning = '';
 161 Devel::PPPort::ckWARN();
 162 ok($warning, '');
 163
 164 $^W = 1;
 165
 166 $warning = '';
 167 Devel::PPPort::ckWARN();
 168 ok("$]" >= 5.004 ? $warning =~ /^ckWARN bar:42/ : $warning eq '');