From 8787a7475e25239a0fffec22fe068e97240c2a51 Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 20 Jun 2010 16:23:38 +0100
Subject: [PATCH] Move the repeated vec logic into warnings::__chk.

---
 lib/warnings.pm | 44 +++++++++++++++++++++++---------------------
 warnings.pl     | 44 +++++++++++++++++++++++---------------------
 2 files changed, 46 insertions(+), 42 deletions(-)

diff --git a/lib/warnings.pm b/lib/warnings.pm
index 837718c..c86ea68 100644
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -411,11 +411,15 @@ sub unimport
 
 my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
 
+sub FATAL () { 2 };
+sub NORMAL () { 1 };
+
 sub __chk
 {
     my $category ;
     my $offset ;
     my $isobj = 0 ;
+    my $wanted = shift;
 
     if (@_) {
         # check the category supplied.
@@ -453,7 +457,15 @@ sub __chk
 
     # Defaulting this to 0 reduces complexity in code paths below.
     my $callers_bitmask = (caller($i))[9] || 0 ;
-    return ($callers_bitmask, $offset) ;
+
+    my @results;
+    foreach my $type (NORMAL, FATAL) {
+	next unless $wanted & $type;
+
+	push @results, (vec($callers_bitmask, $offset + $type - 1, 1) ||
+			vec($callers_bitmask, $Offsets{'all'} + $type - 1, 1));
+    }
+    return $wanted == (NORMAL | FATAL) ? @results : $results[0];
 }
 
 sub _error_loc {
@@ -466,10 +478,7 @@ sub enabled
     Croaker("Usage: warnings::enabled([category])")
 	unless @_ == 1 || @_ == 0 ;
 
-    my ($callers_bitmask, $offset) = __chk(@_) ;
-
-    return vec($callers_bitmask, $offset, 1) ||
-           vec($callers_bitmask, $Offsets{'all'}, 1) ;
+    return __chk(NORMAL, @_);
 }
 
 sub fatal_enabled
@@ -477,10 +486,7 @@ sub fatal_enabled
     Croaker("Usage: warnings::fatal_enabled([category])")
   unless @_ == 1 || @_ == 0 ;
 
-    my ($callers_bitmask, $offset) = __chk(@_) ;
-
-    return vec($callers_bitmask, $offset + 1, 1) ||
-           vec($callers_bitmask, $Offsets{'all'} + 1, 1) ;
+    return __chk(FATAL, @_);
 }
 
 sub warn
@@ -489,11 +495,8 @@ sub warn
 	unless @_ == 2 || @_ == 1 ;
 
     my $message = pop ;
-    my ($callers_bitmask, $offset) = __chk(@_) ;
     require Carp;
-    Carp::croak($message)
-	if vec($callers_bitmask, $offset+1, 1) ||
-	   vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
+    Carp::croak($message) if __chk(FATAL, @_);
     Carp::carp($message) ;
 }
 
@@ -503,19 +506,18 @@ sub warnif
 	unless @_ == 2 || @_ == 1 ;
 
     my $message = pop ;
-    my ($callers_bitmask, $offset) = __chk(@_) ;
+    my ($warn, $fatal) = __chk(NORMAL | FATAL, @_);
 
-    return
-        unless (vec($callers_bitmask, $offset, 1) ||
-            	vec($callers_bitmask, $Offsets{'all'}, 1)) ;
+    return unless $warn or $fatal;
 
     require Carp;
-    Carp::croak($message)
-	if vec($callers_bitmask, $offset+1, 1) ||
-	   vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
-
+    Carp::croak($message) if $fatal;
     Carp::carp($message) ;
 }
 
+# These are not part of any public interface, so we can delete them to save
+# space.
+delete $warnings::{$_} foreach qw(NORMAL FATAL);
+
 1;
 # ex: set ro:
diff --git a/warnings.pl b/warnings.pl
index 4c2c3bb..a435f89 100644
--- a/warnings.pl
+++ b/warnings.pl
@@ -696,11 +696,15 @@ sub unimport
 
 my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
 
+sub FATAL () { 2 };
+sub NORMAL () { 1 };
+
 sub __chk
 {
     my $category ;
     my $offset ;
     my $isobj = 0 ;
+    my $wanted = shift;
 
     if (@_) {
         # check the category supplied.
@@ -738,7 +742,15 @@ sub __chk
 
     # Defaulting this to 0 reduces complexity in code paths below.
     my $callers_bitmask = (caller($i))[9] || 0 ;
-    return ($callers_bitmask, $offset) ;
+
+    my @results;
+    foreach my $type (NORMAL, FATAL) {
+	next unless $wanted & $type;
+
+	push @results, (vec($callers_bitmask, $offset + $type - 1, 1) ||
+			vec($callers_bitmask, $Offsets{'all'} + $type - 1, 1));
+    }
+    return $wanted == (NORMAL | FATAL) ? @results : $results[0];
 }
 
 sub _error_loc {
@@ -751,10 +763,7 @@ sub enabled
     Croaker("Usage: warnings::enabled([category])")
 	unless @_ == 1 || @_ == 0 ;
 
-    my ($callers_bitmask, $offset) = __chk(@_) ;
-
-    return vec($callers_bitmask, $offset, 1) ||
-           vec($callers_bitmask, $Offsets{'all'}, 1) ;
+    return __chk(NORMAL, @_);
 }
 
 sub fatal_enabled
@@ -762,10 +771,7 @@ sub fatal_enabled
     Croaker("Usage: warnings::fatal_enabled([category])")
   unless @_ == 1 || @_ == 0 ;
 
-    my ($callers_bitmask, $offset) = __chk(@_) ;
-
-    return vec($callers_bitmask, $offset + 1, 1) ||
-           vec($callers_bitmask, $Offsets{'all'} + 1, 1) ;
+    return __chk(FATAL, @_);
 }
 
 sub warn
@@ -774,11 +780,8 @@ sub warn
 	unless @_ == 2 || @_ == 1 ;
 
     my $message = pop ;
-    my ($callers_bitmask, $offset) = __chk(@_) ;
     require Carp;
-    Carp::croak($message)
-	if vec($callers_bitmask, $offset+1, 1) ||
-	   vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
+    Carp::croak($message) if __chk(FATAL, @_);
     Carp::carp($message) ;
 }
 
@@ -788,18 +791,17 @@ sub warnif
 	unless @_ == 2 || @_ == 1 ;
 
     my $message = pop ;
-    my ($callers_bitmask, $offset) = __chk(@_) ;
+    my ($warn, $fatal) = __chk(NORMAL | FATAL, @_);
 
-    return
-        unless (vec($callers_bitmask, $offset, 1) ||
-            	vec($callers_bitmask, $Offsets{'all'}, 1)) ;
+    return unless $warn or $fatal;
 
     require Carp;
-    Carp::croak($message)
-	if vec($callers_bitmask, $offset+1, 1) ||
-	   vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
-
+    Carp::croak($message) if $fatal;
     Carp::carp($message) ;
 }
 
+# These are not part of any public interface, so we can delete them to save
+# space.
+delete $warnings::{$_} foreach qw(NORMAL FATAL);
+
 1;
-- 
1.8.3.1