fix 386a548 for fallback => undef
authorJesse Luehrs <doy@tozt.net>
Fri, 29 Jun 2012 06:56:27 +0000 (01:56 -0500)
committerJesse Luehrs <doy@tozt.net>
Fri, 29 Jun 2012 06:57:44 +0000 (01:57 -0500)
The default case for non-overloaded classes is fallback => 1, so saying
fallback => 1 on its own shouldn't enable overloading, but saying
fallback => undef on its own should (even though undef is the default
for overloaded classes).

gv.c
lib/overload.t

diff --git a/gv.c b/gv.c
index 8251c29..ba8e85e 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -2274,13 +2274,16 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
        NOOP;   /* Equivalent to !SvTRUE and !SvOK  */
     }
 #endif
        NOOP;   /* Equivalent to !SvTRUE and !SvOK  */
     }
 #endif
-    else if (SvTRUE(sv)) {
+    else if (SvTRUE(sv))
+        /* don't need to set overloading here because fallback => 1
+         * is the default setting for classes without overloading */
        amt.fallback=AMGfallYES;
        amt.fallback=AMGfallYES;
+    else if (SvOK(sv)) {
+       amt.fallback=AMGfallNEVER;
         filled = 1;
         have_ovl = 1;
     }
         filled = 1;
         have_ovl = 1;
     }
-    else if (SvOK(sv)) {
-       amt.fallback=AMGfallNEVER;
+    else {
         filled = 1;
         have_ovl = 1;
     }
         filled = 1;
         have_ovl = 1;
     }
index 5212083..597c1f7 100644 (file)
@@ -48,7 +48,7 @@ package main;
 
 $| = 1;
 BEGIN { require './test.pl' }
 
 $| = 1;
 BEGIN { require './test.pl' }
-plan tests => 5186;
+plan tests => 5190;
 
 use Scalar::Util qw(tainted);
 
 
 use Scalar::Util qw(tainted);
 
@@ -2633,11 +2633,40 @@ is eval {"$a"}, overload::StrVal($a), 'fallback is stored under "()"';
         package OnlyFallback;
         use overload fallback => 0;
     }
         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");
+    {
+        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");
+    }
 }
 
 { # undefining the overload stash -- KEEP THIS TEST LAST
 }
 
 { # undefining the overload stash -- KEEP THIS TEST LAST