Fix some recursion in overload.pm

Message-Id: <20000918050540.C652@ilmd>

p4raw-id: //depot/perl@7104

diff --git a/lib/overload.pm b/lib/overload.pm
index bead929..2b0b99d 100644 (file)
--- a/lib/overload.pm
+++ b/lib/overload.pm
@@ -383,6 +383,11 @@ be used instead.  C<bool> is used in the flow control operators
 return any arbitrary Perl value.  If the corresponding operation for this value
 is overloaded too, that operation will be called again with this value.
 
+As a special case if the overload returns the object itself then it will
+be used directly. An overloaded conversion returning the object is
+probably a bug, because you're likely to get something that looks like
+C<YourPackage=HASH(0x8172b34)>.
+
 =item * I<Iteration>
 
     "<>"

diff --git a/sv.c b/sv.c
index d584c54..e068d0a 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1488,7 +1488,8 @@ Perl_sv_2iv(pTHX_ register SV *sv)
     if (SvTHINKFIRST(sv)) {
        if (SvROK(sv)) {
          SV* tmpstr;
-         if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer)))
+          if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)) &&
+                  (SvRV(tmpstr) != SvRV(sv)))
              return SvIV(tmpstr);
          return PTR2IV(SvRV(sv));
        }
@@ -1618,7 +1619,8 @@ Perl_sv_2uv(pTHX_ register SV *sv)
     if (SvTHINKFIRST(sv)) {
        if (SvROK(sv)) {
          SV* tmpstr;
-         if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer)))
+          if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)) &&
+                  (SvRV(tmpstr) != SvRV(sv)))
              return SvUV(tmpstr);
          return PTR2UV(SvRV(sv));
        }
@@ -1785,7 +1787,8 @@ Perl_sv_2nv(pTHX_ register SV *sv)
     if (SvTHINKFIRST(sv)) {
        if (SvROK(sv)) {
          SV* tmpstr;
-         if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)))
+          if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)) &&
+                  (SvRV(tmpstr) != SvRV(sv)))
              return SvNV(tmpstr);
          return PTR2NV(SvRV(sv));
        }
@@ -2112,7 +2115,8 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
     if (SvTHINKFIRST(sv)) {
        if (SvROK(sv)) {
            SV* tmpstr;
-           if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)))
+            if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)) &&
+                    (SvRV(tmpstr) != SvRV(sv)))
                return SvPV(tmpstr,*lp);
            sv = (SV*)SvRV(sv);
            if (!sv)
@@ -2359,7 +2363,8 @@ Perl_sv_2bool(pTHX_ register SV *sv)
     if (SvROK(sv)) {
        dTHR;
        SV* tmpsv;
-       if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_)))
+        if (SvAMAGIC(sv) && (tmpsv=AMG_CALLun(sv,bool_)) &&
+                (SvRV(tmpsv) != SvRV(sv)))
            return SvTRUE(tmpsv);
       return SvRV(sv) != 0;
     }

diff --git a/t/pragma/overload.t b/t/pragma/overload.t
index c142a64..c57eb11 100755 (executable)
--- a/t/pragma/overload.t
+++ b/t/pragma/overload.t
@@ -969,5 +969,19 @@ unless ($aaa) {
     test($a =~ /^`1' is not a code reference at/); # 215
 }
 
+# make sure that we don't inifinitely recurse
+{
+  my $c = 0;
+  package Recurse;
+  use overload '""'    => sub { shift },
+               '0+'    => sub { shift },
+               'bool'  => sub { shift },
+               fallback => 1;
+  my $x = bless([]);
+  main::test("$x" =~ /Recurse=ARRAY/);         # 216
+  main::test($x);                               # 217
+  main::test($x+0 =~ /Recurse=ARRAY/);         # 218
+};
+
 # Last test is:
-sub last {215}
+sub last {218}