warn

source of perl for linux application,

################################################################################
##
##  $Revision: 5 $
##  $Author: mhx $
##  $Date: 2007/08/12 23:57:10 +0200 $
##
################################################################################
##
##  Version 3.x, Copyright (C) 2004-2007, 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 '');