################################################################################

##

##  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 '');