develooper Front page | perl.perl5.porters | Postings from September 2000

[PATCH@blead] Fix some recursion in overload.pm

From:
Daniel Chetlin
Date:
September 18, 2000 05:07
Subject:
[PATCH@blead] Fix some recursion in overload.pm
Message ID:
20000918050540.C652@ilmd
Ref.: http://bugs.perl.org/perlbug.cgi?req=bidmids&bidmids=20000406.012

This patch does not fix this exact bug, but a related one. As far as I
can tell, there are two very closely related recursion bugs with
overload.pm. Here are three test cases:

  [~] $ perl -wle'use overload q/""/=>sub{"$_[0]"};$a=bless{};print"$a"'
  Deep recursion on anonymous subroutine at -e line 1.
  Segmentation fault (core dumped)
  [~] $ perl -wle'use overload q/+/=>sub{(shift)+0};$a=bless{};$a+0'
  Useless use of addition (+) in void context at -e line 1.
  Deep recursion on anonymous subroutine at -e line 1.
  Segmentation fault (core dumped)
  [~] $ perl -wle'use overload q/""/=>sub{shift};$a=bless{};print "$a"'
  Segmentation fault (core dumped)
  [~] $

(Whew, just barely fit into 72 lines :-) )

The first two cases are the same -- we go into amagic_call, put together
our new op, and call it, and repeat ad infinitum, as the new op puts us
right back into amagic_call.

The final case is slightly different, in that it's returning the object
itself, rather than trying to stringify it the way case 1 does. In this
respect, it's very similar to the fix Nick made to overloading
dereference operators. Here the recursion happens when the object is
returned, and we call (Sv([IUNP]|TRUE)V) -- and $1 turns around and runs
the magic again.

The below patch fixes this final case -- it keeps overloaded conversion
operators from returning the same object, by treating the objects as if
they weren't overloaded if they are returned. I would also be perfectly
happy with a fatal exception in that case, since I can't see a reason
for doing such a thing on purpose.

The other case is a little more dodgy; I have a fix for it, but it seems
like an ugly hack to me. Since in this case we never return from
amagic_call, I could think of no way to compare the old value with the
new value, short of a global variable. So my solution, instead of doing
that, uses CvDEPTH, and at the 100th recursion of the subroutine, *turns
off all AMAGIC for the object*. (100 being the marker for the "deep
recursion" warning.) Please advise as to the acceptableness of this
solution (again, I'd be perfectly happy to have a fatal exception here
too, but the CvDEPTH thing is still suspect in my mind). I'm hoping
someone else will have a better solution.

Finally, lest you think that all possibilities of the last case are
fixed by the below patch, try this:

  [~/dev/bleadperl] $ ./perl -wl
  use overload q/""/ => sub { shift->{next} };
  my $a = bless {};
  my $b = bless {};
  $a->{next} = $b;
  $b->{next} = $a;
  print "$a";
  __END__
  Segmentation fault (core dumped)

*sigh* And for this I don't even have an ugly solution.

-dlc

--- sv.c	2000/09/18 09:20:15	1.1
+++ sv.c	2000/09/18 10:51:57
@@ -1488,7 +1488,8 @@
     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 @@
     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 @@
     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 @@
     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 @@
     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;
     }
--- lib/overload.pm	2000/09/18 11:08:11	1.1
+++ lib/overload.pm	2000/09/18 11:12:13
@@ -383,6 +383,11 @@
 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>
 
     "<>"
--- t/pragma/overload.t	2000/09/16 10:11:29	1.1
+++ t/pragma/overload.t	2000/09/18 12:05:07
@@ -969,5 +969,19 @@
     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}



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About