[perl5.git] / ext / Devel-PPPort / parts / inc / warn

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