diff options
| author | Daniel Chetlin <daniel@chetlin.com> | 2000-09-17 22:05:40 -0700 |
|---|---|---|
| committer | Nick Ing-Simmons <nik@tiuk.ti.com> | 2000-09-30 13:04:30 +0000 |
| commit | 1554e226caad86d8d9b68656b257a3e2cc55803c (patch) | |
| tree | 47c30405efe1d83b5fbaf20a28b649a0ccb9f503 | |
| parent | e788edffda7d09f6c23d57801a774fbdc00e5bac (diff) | |
| download | perl-1554e226caad86d8d9b68656b257a3e2cc55803c.tar.gz | |
Fix some recursion in overload.pm
Message-Id: <20000918050540.C652@ilmd>
p4raw-id: //depot/perl@7104
| -rw-r--r-- | lib/overload.pm | 5 | ||||
| -rw-r--r-- | sv.c | 15 | ||||
| -rwxr-xr-x | t/pragma/overload.t | 16 |
3 files changed, 30 insertions, 6 deletions
diff --git a/lib/overload.pm b/lib/overload.pm index bead929ddd..2b0b99d3cd 100644 --- 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> "<>" @@ -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 c142a64c0c..c57eb1132c 100755 --- 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} |