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 (file)
--- 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 (executable)
--- 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}