summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2011-06-05 22:37:54 -0700
committerFather Chrysostomos <sprout@cpan.org>2011-06-05 22:37:54 -0700
commit71edc89419f11505f2cdaba9b13be65582d7f011 (patch)
treecf31dd4ce22fa560605fb40843d1a50e8e77e102
parentc0b72abc47a28e2094e4ffc331df81433920bb63 (diff)
downloadperl-71edc89419f11505f2cdaba9b13be65582d7f011.tar.gz
[perl #92258] <$fh> hangs on a glob copy
Opening a file handle to \$glob causes assertion failures (under debugging) or hangs or other erratic behaviour without debugging. This might even crash in some cases. It never really worked properly, but it didn’t start hanging apparently until 5.12.2 and 5.14.0.
-rw-r--r--ext/PerlIO-scalar/scalar.xs13
-rw-r--r--t/io/perlio.t8
2 files changed, 17 insertions, 4 deletions
diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
index de9873829c..e0f75acf1a 100644
--- a/ext/PerlIO-scalar/scalar.xs
+++ b/ext/PerlIO-scalar/scalar.xs
@@ -240,9 +240,13 @@ PerlIOScalar_get_cnt(pTHX_ PerlIO * f)
{
if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+ STRLEN len;
SvGETMAGIC(s->var);
- if (SvCUR(s->var) > (STRLEN) s->posn)
- return SvCUR(s->var) - (STRLEN)s->posn;
+ if (isGV_with_GP(s->var))
+ (void)SvPV(s->var,len);
+ else len = SvCUR(s->var);
+ if (len > (STRLEN) s->posn)
+ return len - (STRLEN)s->posn;
else
return 0;
}
@@ -264,9 +268,12 @@ void
PerlIOScalar_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt)
{
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+ STRLEN len;
PERL_UNUSED_ARG(ptr);
SvGETMAGIC(s->var);
- s->posn = SvCUR(s->var) - cnt;
+ if (isGV_with_GP(s->var)) (void)SvPV(s->var,len);
+ else len = SvCUR(s->var);
+ s->posn = len - cnt;
}
PerlIO *
diff --git a/t/io/perlio.t b/t/io/perlio.t
index 1a330f4367..a65b0d3eb9 100644
--- a/t/io/perlio.t
+++ b/t/io/perlio.t
@@ -6,7 +6,7 @@ BEGIN {
skip_all_without_perlio();
}
-plan tests => 42;
+plan tests => 44;
use_ok('PerlIO');
@@ -191,6 +191,12 @@ close ($perlio);
close ($no_perlio);
}
+{ # [perl #92258]
+ open my $fh, "<", \(my $f = *f);
+ is join("", <$fh>), '*main::f', 'reading from a glob copy';
+ is ref \$f, 'GLOB', 'the glob copy is unaffected';
+}
+
}