Package: perl
Version: 5.14.2-14
Severity: important
Tags: patch fixed-upstream
Perl 5.14.3 included the attached patch, which fixes incorrect smartmatch
precedence.
$ perl -lwe '{ package A; use overload "~~" => sub { print "in overloaded match
A"; }; } { package B; use overload "~~" => sub { print "in overloaded match B";
}; } my $a=bless({},"A"); my $b=bless({},"B"); print $a ~~ $b'
in overloaded match A
1
According to the documented behaviour, the first line should be
in overloaded match B
There's some background at
http://www.nntp.perl.org/group/perl.perl5.porters/2011/07/msg174260.html
where the upstream consensus is clearly that this is a misfeature that
nobody should be counting on and works against the current documentation.
The patch removes two incorrect test cases; quoting Leon Timmermans in
the thread:
>> It fixes the issue but
>> makes two tests in t/op/smartmatch.t fail. It creates a failure if you
>> match an object with smartmatch overloading with an object that has
>> overloading but not for smartmatching (in case of the test,
>> stringification overloading). I'm not sure that case is sane to begin
>> with though.
>
> IMO, in this case following the left hand (the current behavior) is
> simply insane, for reasons Ricardo already explained. Following the
> right hand if it doesn't overload smartmatching is simply impossible:
> it can't know if it should use the code, hash, regexp, array, string
> or number overloading. Making this obscure use-case die is the only
> possible sane thing we can do.
The issue isn't a regression from squeeze, but we think it should be
fixed rather sooner than later, on the principle of least surprise.
--
Niko Tyni [email protected]
>From 011be0badf32a8d73f13b6565fbd8c398f8ab27e Mon Sep 17 00:00:00 2001
From: Leon Timmermans <[email protected]>
Date: Mon, 23 Jan 2012 02:01:00 +0100
Subject: [PATCH] Enforce Any ~~ Object smartmatch precedence
---
pp_ctl.c | 2 +-
t/op/smartmatch.t | 4 +---
2 files changed, 2 insertions(+), 4 deletions(-)
diff --git a/pp_ctl.c b/pp_ctl.c
index 60bc30d..06d9124 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4374,7 +4374,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Object\n"));
DEBUG_M(Perl_deb(aTHX_ " attempting overload\n"));
- tmpsv = amagic_call(d, e, smart_amg, 0);
+ tmpsv = amagic_call(d, e, smart_amg, AMGf_noleft);
if (tmpsv) {
SPAGAIN;
(void)POPs;
diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t
index da4840e..79c9847 100644
--- a/t/op/smartmatch.t
+++ b/t/op/smartmatch.t
@@ -73,7 +73,7 @@ my %keyandmore = map { $_ => 0 } @keyandmore;
my %fooormore = map { $_ => 0 } @fooormore;
# Load and run the tests
-plan tests => 351;
+plan tests => 349;
while (<DATA>) {
SKIP: {
@@ -223,8 +223,6 @@ __DATA__
@ "object" $str_obj
@ FALSE $str_obj
# Those will treat the $str_obj as a string because of fallback:
-! $ov_obj $str_obj
- $ov_obj_2 $str_obj
# object (overloaded or not) ~~ Any
$obj qr/NoOverload/
--
1.7.10.4
