Revert "Lookup overloaded assignment operators when trying to swap the arguments"

[perl5.git] / lib / overload.t

diff --git a/lib/overload.t b/lib/overload.t
index a132492..a90005d 100644 (file)
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -48,7 +48,7 @@ package main;
 
 $| = 1;
 BEGIN { require './test.pl' }
-plan tests => 5184;
+plan tests => 5191;
 
 use Scalar::Util qw(tainted);
 
@@ -202,7 +202,7 @@ is($b, "89");
 is(ref $a, "Oscalar");
 is($copies, 1);
 
-eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*"$_[1]";
+eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*$_[1];
                                                   $_[0] } ) ];
 $c=new Oscalar;                        # Cause rehash
 
@@ -2627,6 +2627,65 @@ is eval {"$a"}, overload::StrVal($a), 'fallback is stored under "()"';
     is($obj->val, 7, "correct result (add incr void)");
 }
 
+# [perl #113010]
+{
+    {
+        package OnlyFallback;
+        use overload fallback => 0;
+    }
+    {
+        my $obj = bless {}, 'OnlyFallback';
+        my $died = !eval { "".$obj; 1 };
+        my $err = $@;
+        ok($died, "fallback of 0 causes error");
+        like($err, qr/"\.": no method found/, "correct error");
+    }
+
+    {
+        package OnlyFallbackUndef;
+        use overload fallback => undef;
+    }
+    {
+        my $obj = bless {}, 'OnlyFallbackUndef';
+        my $died = !eval { "".$obj; 1 };
+        my $err = $@;
+        ok($died, "fallback of undef causes error");
+        # this one tries falling back to stringify before dying
+        like($err, qr/"""": no method found/, "correct error");
+    }
+
+    {
+        package OnlyFallbackTrue;
+        use overload fallback => 1;
+    }
+    {
+        my $obj = bless {}, 'OnlyFallbackTrue';
+        my $val;
+        my $died = !eval { $val = "".$obj; 1 };
+        my $err = $@;
+        ok(!$died, "fallback of 1 doesn't cause error")
+            || diag("got error of $err");
+        like($val, qr/^OnlyFallbackTrue=HASH\(/, "stringified correctly");
+    }
+}
+
+{
+    # Making Regexp class overloaded: avoid infinite recursion.
+    # Do this in a separate process since it, well, overloads Regexp!
+    fresh_perl_is(
+       <<'EOF',
+package Regexp;
+use overload q{""} => sub {$_[0] };
+package main;
+my $r1 = qr/1/;
+my $r2 = qr/ABC$r1/;
+print $r2,"\n";
+EOF
+       '(?^:ABC(?^:1))',
+       { stderr => 1 },
+       'overloaded REGEXP'
+    );
+}
 
 { # undefining the overload stash -- KEEP THIS TEST LAST
     package ant;