Suppress ‘useless’ warning in overload.pm

[perl5.git] / lib / overload.pm

diff --git a/lib/overload.pm b/lib/overload.pm
index 4e01e45..4892a31 100644 (file)
--- a/lib/overload.pm
+++ b/lib/overload.pm
@@ -1,12 +1,38 @@
 package overload;
 
 package overload;
 

-our $VERSION = '1.17';
+our $VERSION = '1.18';
+
+%ops = (
+    with_assign         => "+ - * / % ** << >> x .",
+    assign              => "+= -= *= /= %= **= <<= >>= x= .=",
+    num_comparison      => "< <= >  >= == !=",
+    '3way_comparison'   => "<=> cmp",
+    str_comparison      => "lt le gt ge eq ne",
+    binary              => '& &= | |= ^ ^=',
+    unary               => "neg ! ~",
+    mutators            => '++ --',
+    func                => "atan2 cos sin exp abs log sqrt int",
+    conversion          => 'bool "" 0+ qr',
+    iterators           => '<>',
+    filetest            => "-X",
+    dereferencing       => '${} @{} %{} &{} *{}',
+    matching            => '~~',
+    special             => 'nomethod fallback =',
+);
+
+my %ops_seen;
+for $category (keys %ops) {
+    $ops_seen{$_}++ for (split /\s+/, $ops{$category});
+}

 
 sub nil {}
 
 sub OVERLOAD {
   $package = shift;
   my %arg = @_;
 
 sub nil {}
 
 sub OVERLOAD {
   $package = shift;
   my %arg = @_;

+  for (keys %arg) {
+    warn "overload arg '$_' is invalid" unless $ops_seen{$_};
+  }

   my ($sub, $fb);
   $ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
   $fb = ${$package . "::()"}; # preserve old fallback value RT#68196
   my ($sub, $fb);
   $ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
   $fb = ${$package . "::()"}; # preserve old fallback value RT#68196


@@ -50,7 +76,7 @@ sub unimport {
 sub Overloaded {
   my $package = shift;
   $package = ref $package if ref $package;
 sub Overloaded {
   my $package = shift;
   $package = ref $package if ref $package;

-  $package->can('()');
+  mycan ($package, '()');

 }
 
 sub ov_method {
 }
 
 sub ov_method {


@@ -128,22 +154,6 @@ sub mycan {                                # Real can would leave stubs.
              'qr'        => 0x10000, # HINT_NEW_RE
             );
 
              'qr'        => 0x10000, # HINT_NEW_RE
             );
 

-%ops = ( with_assign     => "+ - * / % ** << >> x .",
-        assign           => "+= -= *= /= %= **= <<= >>= x= .=",
-        num_comparison   => "< <= >  >= == !=",
-        '3way_comparison'=> "<=> cmp",
-        str_comparison   => "lt le gt ge eq ne",
-        binary           => '& &= | |= ^ ^=',
-        unary            => "neg ! ~",
-        mutators         => '++ --',
-        func             => "atan2 cos sin exp abs log sqrt int",
-        conversion       => 'bool "" 0+ qr',
-        iterators        => '<>',
-         filetest         => "-X",
-        dereferencing    => '${} @{} %{} &{} *{}',
-        matching         => '~~',
-        special          => 'nomethod fallback =');
-

 use warnings::register;
 sub constant {
   # Arguments: what, sub
 use warnings::register;
 sub constant {
   # Arguments: what, sub


@@ -379,6 +389,9 @@ Most of the overloadable operators map one-to-one to these keys.
 Exceptions, including additional overloadable operations not
 apparent from this hash, are included in the notes which follow.
 
 Exceptions, including additional overloadable operations not
 apparent from this hash, are included in the notes which follow.
 

+A warning is issued if an attempt is made to register an operator not found
+above.
+

 =over 5
 
 =item * C<not>
 =over 5
 
 =item * C<not>