From 9d51dcee04c4fd5387333086cac218960f210622 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sun, 15 Jan 2012 09:07:13 -0500 Subject: Emit a warning if an attempt is made to overload an invalid (e.g., misspelled) operator. For RT #74098. --- lib/overload.pm | 47 ++++++++++++++++++++++++++++++----------------- 1 file changed, 30 insertions(+), 17 deletions(-) diff --git a/lib/overload.pm b/lib/overload.pm index 1f9f461da1..8af28e547d 100644 --- a/lib/overload.pm +++ b/lib/overload.pm @@ -1,12 +1,38 @@ 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 =', +); + +%ops_seen; +for $category (keys %ops) { + $ops_seen{$_}++ for (split /\s+/, $ops{$category}); +} 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 @@ -128,22 +154,6 @@ sub mycan { # Real can would leave stubs. '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 @@ -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. +A warning is issued if an attempt is made to register an operator not found +above. + =over 5 =item * C -- cgit v1.2.1