From: Paul Marquess <paul.marquess@btinternet.com>
Date: Fri, 1 Sep 2000 13:43:15 +0000 (+0100)
Subject: RE: [PATCH lib/overload.pm] Sanaty checking of arguments to overload::constant
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4498a7519cc524cb875be9ce1d6a4bda5940beeb;p=p5sagit%2Fp5-mst-13.2.git

RE: [PATCH lib/overload.pm] Sanaty checking of arguments to overload::constant
Message-ID: <001001c01412$32c7dde0$a20a140a@bfs.phone.com>

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

diff --git a/lib/overload.pm b/lib/overload.pm
index cce5df7..b9c9ce7 100644
--- a/lib/overload.pm
+++ b/lib/overload.pm
@@ -132,25 +132,18 @@ sub constant {
   # Arguments: what, sub
   while (@_) {
     if (@_ == 1) {
-        if (warnings::enabled) {
-            require Carp;
-            Carp::carp ("Odd number of arguments for overload::constant");
-        }
+        warnings::warnif ("Odd number of arguments for overload::constant");
         last;
     }
     elsif (!exists $constants {$_ [0]}) {
-        if (warnings::enabled) {
-            require Carp;
-            Carp::carp ("`$_[0]' is not an overloadable type");
-        }
+        warnings::warnif ("`$_[0]' is not an overloadable type");
     }
     elsif (!ref $_ [1] || "$_[1]" !~ /CODE\(0x[\da-f]+\)$/) {
         # Can't use C<ref $_[1] eq "CODE"> above as code references can be
         # blessed, and C<ref> would return the package the ref is blessed into.
         if (warnings::enabled) {
-            require Carp;
             $_ [1] = "undef" unless defined $_ [1];
-            Carp::carp ("`$_[1]' is not a code reference");
+            warnings::warn ("`$_[1]' is not a code reference");
         }
     }
     else {
diff --git a/t/pragma/overload.t b/t/pragma/overload.t
index 42e4006..7221d78 100755
--- a/t/pragma/overload.t
+++ b/t/pragma/overload.t
@@ -935,5 +935,39 @@ unless ($aaa) {
   main::test $x, '0pq1';		# 209
 };
 
+# Test module-specific warning
+{
+    # check the Odd number of arguments for overload::constant warning
+    my $a = "" ;
+    $SIG{__WARN__} = sub {$a = @_[0]} ;
+    $x = eval ' overload::constant "integer" ; ' ;
+    test($a eq "") ; # 210
+    use warnings 'overload' ;
+    $x = eval ' overload::constant "integer" ; ' ;
+    test($a =~ /^Odd number of arguments for overload::constant at/) ; # 211
+}
+
+{
+    # check the `$_[0]' is not an overloadable type warning
+    my $a = "" ;
+    $SIG{__WARN__} = sub {$a = @_[0]} ;
+    $x = eval ' overload::constant "fred" => sub {} ; ' ;
+    test($a eq "") ; # 212
+    use warnings 'overload' ;
+    $x = eval ' overload::constant "fred" => sub {} ; ' ;
+    test($a =~ /^`fred' is not an overloadable type at/); # 213
+}
+
+{
+    # check the `$_[1]' is not a code reference warning
+    my $a = "" ;
+    $SIG{__WARN__} = sub {$a = @_[0]} ;
+    $x = eval ' overload::constant "integer" => 1; ' ;
+    test($a eq "") ; # 214
+    use warnings 'overload' ;
+    $x = eval ' overload::constant "integer" => 1; ' ;
+    test($a =~ /^`1' is not a code reference at/); # 215
+}
+
 # Last test is:
-sub last {209}
+sub last {215}