[perl.git] branch blead, updated. v5.11.2-69-g789c461
Rafael Garcia-Suarez
- Log -----------------------------------------------------------------
commit 789c461534f3eb0346447f8127786b7da3017f6c
Author: Rafael Garcia-Suarez <r...@consttype.org>
Date: Tue Nov 24 13:51:21 2009 +0100
Bump version and regenerate warnings.pm
M lib/warnings.pm
M warnings.pl
commit 68a00014b571d4710c4547f0636aeb35e307c012
Author: Andrew Rodland <and...@hbslabs.com>
Date: Sat Nov 14 03:08:46 2009 -0600
Add tests.
M t/lib/warnings/9enabled
commit ec983580254c32fd44889fde43973ac5dd74257b
Author: Andrew Rodland <and...@hbslabs.com>
Date: Sat Nov 14 01:26:09 2009 -0600
Add code and starting perldoc for warnings::fatal_enabled.
This is an analog for warnings::enabled, except it tests whether the
given category has been set fatal using "use warnings FATAL => foo".
This is mostly for symmetry.
Assumes that the fatal bit for a category will have an offset one higher
than the regular bit for the category, because otherwise much rewriting
of __chk would be required.
M warnings.pl
-----------------------------------------------------------------------
Summary of changes:
lib/warnings.pm | 34 +++++++++++++++++++++++++++-
t/lib/warnings/9enabled | 57 +++++++++++++++++++++++++++++++++++++++++++++++
warnings.pl | 34 +++++++++++++++++++++++++++-
3 files changed, 123 insertions(+), 2 deletions(-)
diff --git a/lib/warnings.pm b/lib/warnings.pm
index 6049437..771c98c 100644
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -6,7 +6,7 @@
package warnings;
-our $VERSION = '1.07';
+our $VERSION = '1.08';
# Verify that we're called correctly so that warnings will work.
# see also strict.pm.
@@ -84,6 +84,27 @@ Return TRUE if that warnings category is enabled in the first scope
where the object is used.
Otherwise returns FALSE.
+=item warnings::fatal_enabled()
+
+Return TRUE if the warnings category with the same name as the current
+package has been set to FATAL in the calling module.
+Otherwise returns FALSE.
+
+=item warnings::fatal_enabled($category)
+
+Return TRUE if the warnings category C<$category> has been set to FATAL in
+the calling module.
+Otherwise returns FALSE.
+
+=item warnings::fatal_enabled($object)
+
+Use the name of the class for the object reference, C<$object>, as the
+warnings category.
+
+Return TRUE if that warnings category has been set to FATAL in the first
+scope where the object is used.
+Otherwise returns FALSE.
+
=item warnings::warn($message)
Print C<$message> to STDERR.
@@ -469,6 +490,17 @@ sub enabled
vec($callers_bitmask, $Offsets{'all'}, 1) ;
}
+sub fatal_enabled
+{
+ Croaker("Usage: warnings::fatal_enabled([category])")
+ unless @_ == 1 || @_ == 0 ;
+
+ my ($callers_bitmask, $offset, $i) = __chk(@_) ;
+
+ return 0 unless defined $callers_bitmask;
+ return vec($callers_bitmask, $offset + 1, 1) ||
+ vec($callers_bitmask, $Offsets{'all'} + 1, 1) ;
+}
sub warn
{
diff --git a/t/lib/warnings/9enabled b/t/lib/warnings/9enabled
index a6ad931..a535689 100644
--- a/t/lib/warnings/9enabled
+++ b/t/lib/warnings/9enabled
@@ -1227,3 +1227,60 @@ print "ok2\n" if $@ =~ /line $warn_line/;
EXPECT
ok1
ok2
+########
+
+--FILE-- fatal1.pm
+package fatal1 ;
+no warnings ;
+print "ok1\n" if !warnings::fatal_enabled('all') ;
+print "ok2\n" if !warnings::fatal_enabled("syntax") ;
+1;
+--FILE--
+use fatal1 ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- fatal2.pm
+package fatal2;
+no warnings ;
+print "ok1\n" if !warnings::fatal_enabled('all') ;
+print "ok2\n" if warnings::fatal_enabled("syntax") ;
+1;
+--FILE--
+use warnings FATAL => 'syntax' ;
+use fatal2 ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- fatal3.pm
+package fatal3 ;
+no warnings ;
+print "ok1\n" if warnings::fatal_enabled('all') ;
+print "ok2\n" if warnings::fatal_enabled("syntax") ;
+1;
+--FILE--
+use warnings FATAL => 'all' ;
+use fatal3 ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- fatal4.pm
+package fatal4 ;
+no warnings ;
+print "ok1\n" if !warnings::fatal_enabled('all') ;
+print "ok2\n" if warnings::fatal_enabled("void") ;
+print "ok3\n" if !warnings::fatal_enabled("syntax") ;
+1;
+--FILE--
+use warnings FATAL => 'all', NONFATAL => 'syntax' ;
+use fatal4 ;
+EXPECT
+ok1
+ok2
+ok3
diff --git a/warnings.pl b/warnings.pl
index dabc97d..835fd7c 100644
--- a/warnings.pl
+++ b/warnings.pl
@@ -451,7 +451,7 @@ __END__
package warnings;
-our $VERSION = '1.07';
+our $VERSION = '1.08';
# Verify that we're called correctly so that warnings will work.
# see also strict.pm.
@@ -529,6 +529,27 @@ Return TRUE if that warnings category is enabled in the first scope
where the object is used.
Otherwise returns FALSE.
+=item warnings::fatal_enabled()
+
+Return TRUE if the warnings category with the same name as the current
+package has been set to FATAL in the calling module.
+Otherwise returns FALSE.
+
+=item warnings::fatal_enabled($category)
+
+Return TRUE if the warnings category C<$category> has been set to FATAL in
+the calling module.
+Otherwise returns FALSE.
+
+=item warnings::fatal_enabled($object)
+
+Use the name of the class for the object reference, C<$object>, as the
+warnings category.
+
+Return TRUE if that warnings category has been set to FATAL in the first
+scope where the object is used.
+Otherwise returns FALSE.
+
=item warnings::warn($message)
Print C<$message> to STDERR.
@@ -756,6 +777,17 @@ sub enabled
vec($callers_bitmask, $Offsets{'all'}, 1) ;
}
+sub fatal_enabled
+{
+ Croaker("Usage: warnings::fatal_enabled([category])")
+ unless @_ == 1 || @_ == 0 ;
+
+ my ($callers_bitmask, $offset, $i) = __chk(@_) ;
+
+ return 0 unless defined $callers_bitmask;
+ return vec($callers_bitmask, $offset + 1, 1) ||
+ vec($callers_bitmask, $Offsets{'all'} + 1, 1) ;
+}
sub warn
{
--
Perl5 Master Repository