From: kaminsky@math.huji.ac.il <kaminsky@math.huji.ac.il>
Date: Tue, 5 Oct 2004 09:52:07 +0000 (+0000)
Subject: [perl #31843] warnings::warn($obj,...) fails when $obj overloads ""
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9df0f64f445f30276560fec596914dd510e244e9;p=p5sagit%2Fp5-mst-13.2.git

[perl #31843] warnings::warn($obj,...) fails when $obj overloads ""
From: kaminsky@math.huji.ac.il (via RT) <perlbug-followup@perl.org>
Message-ID: <rt-3.0.11-31843-97358.2.89612012687236@perl.org>
(with tweaks)

p4raw-id: //depot/perl@23361
---

diff --git a/lib/warnings.pm b/lib/warnings.pm
index 656b7ac..32f020e 100644
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -402,6 +402,8 @@ sub unimport
     ${^WARNING_BITS} = $mask ;
 }
 
+my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
+
 sub __chk
 {
     my $category ;
@@ -411,10 +413,10 @@ sub __chk
     if (@_) {
         # check the category supplied.
         $category = shift ;
-        if (ref $category) {
-            Croaker ("not an object")
-                if $category !~ /^([^=]+)=/ ;
-	    $category = $1 ;
+        if (my $type = ref $category) {
+            Croaker("not an object")
+                if exists $builtin_type{$type};
+	    $category = $type;
             $isobj = 1 ;
         }
         $offset = $Offsets{$category};
diff --git a/warnings.pl b/warnings.pl
index df766fe..24246f5 100644
--- a/warnings.pl
+++ b/warnings.pl
@@ -710,6 +710,8 @@ sub unimport
     ${^WARNING_BITS} = $mask ;
 }
 
+my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
+
 sub __chk
 {
     my $category ;
@@ -719,10 +721,10 @@ sub __chk
     if (@_) {
         # check the category supplied.
         $category = shift ;
-        if (ref $category) {
-            Croaker ("not an object")
-                if $category !~ /^([^=]+)=/ ;
-	    $category = $1 ;
+        if (my $type = ref $category) {
+            Croaker("not an object")
+                if exists $builtin_type{$type};
+	    $category = $type;
             $isobj = 1 ;
         }
         $offset = $Offsets{$category};