################################################################################
##
##  Version 3.x, Copyright (C) 2004-2013, 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 '');