New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
LVALUE magic should know how to assign to globs #7939
Comments
From @nwc10Created by @nwc10If you pass a hash element as an argument to a subroutine and assign a glob If the element did not exist: $ perl5.9.3 -MDevel::eeek -le 'sub f { $_[0] = *FOO } f($h{foo}); Dump $h{foo}' If the element exists before the call: $ perl5.9.3 -MDevel::Peek -le 'sub f { $_[0] = *FOO } $h{foo}=1; f($h{foo}); Dump $h{foo}' Presumably now that PVLVs are large enough to hold the full PVGV info, the Nicholas Clark Perl Info
|
From @cpansproutThis doesn’t work: sub{ $_[0] = *_:: }->($a{b}); It 5.8.x and earlier, the $_[0] assignment caused an error. (Can't upgrade....) In 5.10.0 and later, the glob is stringified and assigned to $a{b}. I was poring over sv_setsv_flags, and read it six times trying to understand it, until I realised it didn’t make sense to me because it was buggy. I still don’t understand it well enough to fix this. Take this bit, for instance: Should that SVt_PVGV be changed to SVt_PVLV, or would that have strange side-effects? (This same logic occurs in several other places in the same function.) And this bit, a little lower: Why would an SVt_PVLV require the LHS to be SVt_PVNV and not something else? Near the bottom: /* FAKE globs can get coerced, so need to turn this off When is a glob ever supposed to be stringified when assigned to something? If I’m reading the code correctly, this is only reached when a glob is assigned to an SVt_PVLV (which causes this bug) or an SVt_PVIO (how can that ever happen?). Is this code really supposed to be reached? A note to anyone fixing this: When this is fixed, if the lvalue points to a stash element whose names ends with :: then the assignment may necessitate a call to MRO_INVALIDATE_ISA, mro_package_moved, or whatever it ends up being called. My first patch for bug #75176 (which is unfinished) will add that macro or function. Flags: This perlbug was built using Perl 5.10.1 - Thu Sep 24 18:07:44 PDT 2009 Site configuration information for perl 5.13.2: Configured by sprout at Tue Jun 22 20:22:10 PDT 2010. Summary of my perl5 (revision 5 version 13 subversion 2 patch v5.13.2-3-gd1e2db0) configuration: Locally applied patches: @INC for perl 5.13.2: Environment for perl 5.13.2: |
From @iabynOn Sun, Aug 22, 2010 at 12:24:36PM -0700, Father Chrysostomos wrote:
Answer: yes, it should probably be changed. Try it and see if anything
I think that was a mistake. I think the original intent of the change
Well I put in an assert(dtype == SVt_PVLV) there and no tests failed, so -- |
The RT System itself - Status changed from 'new' to 'open' |
From @cpansproutOn, Wed, 25 Aug 2010 17:27:18 +0100, Dave Mitchell wrote:
One test fails, and dozens of other things break without any tests failing, because so many parts of the perl source code don’t take globs-as-PVLVs into account. So, in trying to fix one little niggling bug, I’ve set off a chain reaction. :-) I’ve fixed all of those I know about. I tried to avoid a megapatch, but the problems turned out to be so intertwined that I couldn’t help it.
But wouldn’t that cause problems if the RHS is an lvalue holding a number and the LHS is undef? After learning this code more throughly than I had intended, I believe this can be left as it is.
Out of paranoia, I’ve left that code unchanged, in case some XS code is assigning a glob to an IO thingy and expecting the latter to morph into a scalar. I think any such code would be buggy, so it probably can be removed; but I leave it to you. Here is some text for perldelta. The various PVLV fixups throughout the source are not deserving of mention, since they fix bugs that couldn’t have occurred before the changes to sv_setsv_flags. (Under Selected Bug Fixes:) =item * Assigning a glob to a PVLV used to convert it to a plain string. Now it sub { $_[0] = *foo }->($hash{key}); It also happened when a glob was assigned to, or returned from, an element |
From @cpansproutFrom: Father Chrysostomos <sprout@cpan.org> [perl #77362] Assigning glob to lvalue causes stringification This test from t/op/gv.t was added by change 22315/4ce457a6: { That change was the one that made glob-to-lvalue assignment work to This patch fixes the test and adds tests to make sure what is assigned It also happens to fix the stringification bug. In doing so, it essen- It turns out that many different parts of the perl source don’t fully • GvIO(gv) to make readline and other I/O ops work. • Autovivification of glob slots. • tie *$pvlv • *$pvlv = undef, *$pvlv = $number, *$pvlv = $ref • Duplicating a filehandle accessed through a PVLV glob when the • Using a PVLV glob as a subroutine reference • Coderef assignment when the glob is no longer in the symbol table • open with a PVLV glob for the filehandle • -t and -T • Unopened file handle warnings Inline Patchdiff -Nup blead-77362-glob2lv0/gv.c blead-77362-glob2lv8/gv.c
--- blead-77362-glob2lv0/gv.c 2010-07-24 08:14:09.000000000 -0700
+++ blead-77362-glob2lv8/gv.c 2010-08-23 22:21:43.000000000 -0700
@@ -45,7 +45,13 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype
{
SV **where;
- if (!gv || SvTYPE((const SV *)gv) != SVt_PVGV) {
+ if (
+ !gv
+ || (
+ SvTYPE((const SV *)gv) != SVt_PVGV
+ && SvTYPE((const SV *)gv) != SVt_PVLV
+ )
+ ) {
const char *what;
if (type == SVt_PVIO) {
/*
diff -Nup blead-77362-glob2lv0/gv.h blead-77362-glob2lv8/gv.h
--- blead-77362-glob2lv0/gv.h 2010-06-04 13:48:10.000000000 -0700
+++ blead-77362-glob2lv8/gv.h 2010-08-23 20:39:17.000000000 -0700
@@ -88,7 +88,17 @@ Return the SV from the GV.
#endif
#define GvREFCNT(gv) (GvGP(gv)->gp_refcnt)
-#define GvIO(gv) ((gv) && SvTYPE((const SV*)gv) == SVt_PVGV && GvGP(gv) ? GvIOp(gv) : NULL)
+#define GvIO(gv) \
+ ( \
+ (gv) \
+ && ( \
+ SvTYPE((const SV*)(gv)) == SVt_PVGV \
+ || SvTYPE((const SV*)(gv)) == SVt_PVLV \
+ ) \
+ && GvGP(gv) \
+ ? GvIOp(gv) \
+ : NULL \
+ )
#define GvIOp(gv) (GvGP(gv)->gp_io)
#define GvIOn(gv) (GvIO(gv) ? GvIOp(gv) : GvIOp(gv_IOadd(gv)))
diff -Nup blead-77362-glob2lv0/pp_hot.c blead-77362-glob2lv8/pp_hot.c
--- blead-77362-glob2lv0/pp_hot.c 2010-08-20 18:55:11.000000000 -0700
+++ blead-77362-glob2lv8/pp_hot.c 2010-08-25 13:25:56.000000000 -0700
@@ -123,7 +123,7 @@ PP(pp_sassign)
if (PL_op->op_private & OPpASSIGN_CV_TO_GV) {
SV * const cv = SvRV(left);
const U32 cv_type = SvTYPE(cv);
- const U32 gv_type = SvTYPE(right);
+ const bool is_gv = isGV_with_GP(right);
const bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM;
if (!got_coderef) {
@@ -133,7 +133,7 @@ PP(pp_sassign)
/* Can do the optimisation if right (LVALUE) is not a typeglob,
left (RVALUE) is a reference to something, and we're in void
context. */
- if (!got_coderef && gv_type != SVt_PVGV && GIMME_V == G_VOID) {
+ if (!got_coderef && !is_gv && GIMME_V == G_VOID) {
/* Is the target symbol table currently empty? */
GV * const gv = gv_fetchsv(right, GV_NOINIT, SVt_PVGV);
if (SvTYPE(gv) != SVt_PVGV && !SvOK(gv)) {
@@ -151,7 +151,7 @@ PP(pp_sassign)
}
/* Need to fix things up. */
- if (gv_type != SVt_PVGV) {
+ if (!is_gv) {
/* Need to fix GV. */
right = MUTABLE_SV(gv_fetchsv(right, GV_ADD, SVt_PVGV));
}
@@ -201,7 +201,7 @@ PP(pp_sassign)
/* Allow glob assignments like *$x = ..., which, when the glob has a
SVf_FAKE flag, cannot be distinguished from $x = ... without looking
at the op tree. */
- if( SvTYPE(right) == SVt_PVGV && cBINOP->op_last->op_type == OP_RV2GV
+ if( isGV_with_GP(right) && cBINOP->op_last->op_type == OP_RV2GV
&& (wasfake = SvFLAGS(right) & SVf_FAKE) )
SvFLAGS(right) &= ~SVf_FAKE;
SvSetMagicSV(right, left);
@@ -2730,6 +2730,7 @@ PP(pp_entersub)
case SVt_PVGV:
if (!isGV_with_GP(sv))
DIE(aTHX_ "Not a CODE reference");
+ we_have_a_glob:
if (!(cv = GvCVu((const GV *)sv))) {
HV *stash;
cv = sv_2cv(sv, &stash, &gv, 0);
@@ -2740,6 +2741,9 @@ PP(pp_entersub)
goto try_autoload;
}
break;
+ case SVt_PVLV:
+ if(isGV_with_GP(sv)) goto we_have_a_glob;
+ /*FALLTHROUGH*/
default:
if (sv == &PL_sv_yes) { /* unfound import, ignore */
if (hasargs)
diff -Nup blead-77362-glob2lv0/pp_sys.c blead-77362-glob2lv8/pp_sys.c
--- blead-77362-glob2lv0/pp_sys.c 2010-08-19 18:47:10.000000000 -0700
+++ blead-77362-glob2lv8/pp_sys.c 2010-08-25 18:03:31.000000000 -0700
@@ -505,7 +505,7 @@ PP(pp_open)
GV * const gv = MUTABLE_GV(*++MARK);
- if (!isGV(gv))
+ if (!isGV(gv) && !(SvTYPE(gv) == SVt_PVLV && isGV_with_GP(gv)))
DIE(aTHX_ PL_no_usym, "filehandle");
if ((io = GvIOp(gv))) {
@@ -825,6 +825,7 @@ PP(pp_tie)
methname = "TIEARRAY";
break;
case SVt_PVGV:
+ case SVt_PVLV:
if (isGV_with_GP(varsv)) {
methname = "TIEHANDLE";
how = PERL_MAGIC_tiedscalar;
@@ -3338,7 +3339,7 @@ PP(pp_fttty)
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
- else if (isGV(TOPs))
+ else if (isGV_with_GP(TOPs))
gv = MUTABLE_GV(POPs);
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
gv = MUTABLE_GV(SvRV(POPs));
@@ -3391,7 +3392,7 @@ PP(pp_fttext)
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
- else if (isGV(TOPs))
+ else if (isGV_with_GP(TOPs))
gv = MUTABLE_GV(POPs);
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
gv = MUTABLE_GV(SvRV(POPs));
diff -Nup blead-77362-glob2lv0/sv.c blead-77362-glob2lv8/sv.c
--- blead-77362-glob2lv0/sv.c 2010-08-20 18:55:11.000000000 -0700
+++ blead-77362-glob2lv8/sv.c 2010-08-25 20:37:26.000000000 -0700
@@ -3774,7 +3774,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
switch (stype) {
case SVt_NULL:
undef_sstr:
- if (dtype != SVt_PVGV) {
+ if (dtype != SVt_PVGV && dtype != SVt_PVLV) {
(void)SvOK_off(dstr);
return;
}
@@ -3790,6 +3790,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
sv_upgrade(dstr, SVt_PVIV);
break;
case SVt_PVGV:
+ case SVt_PVLV:
goto end_of_first_switch;
}
(void)SvIOK_only(dstr);
@@ -3821,6 +3822,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
sv_upgrade(dstr, SVt_PVNV);
break;
case SVt_PVGV:
+ case SVt_PVLV:
goto end_of_first_switch;
}
SvNV_set(dstr, SvNVX(sstr));
@@ -3873,7 +3875,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
/* case SVt_BIND: */
case SVt_PVLV:
case SVt_PVGV:
- if (isGV_with_GP(sstr) && dtype <= SVt_PVGV) {
+ if (isGV_with_GP(sstr) && dtype <= SVt_PVLV) {
glob_assign_glob(dstr, sstr, dtype);
return;
}
@@ -3883,12 +3885,11 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
case SVt_PVMG:
if (SvGMAGICAL(sstr) && (flags & SV_GMAGIC)) {
mg_get(sstr);
- if (SvTYPE(sstr) != stype) {
+ if (SvTYPE(sstr) != stype)
stype = SvTYPE(sstr);
- if (isGV_with_GP(sstr) && stype == SVt_PVGV && dtype <= SVt_PVGV) {
+ if (isGV_with_GP(sstr) && dtype <= SVt_PVLV) {
glob_assign_glob(dstr, sstr, dtype);
return;
- }
}
}
if (stype == SVt_PVLV)
@@ -3923,7 +3924,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
else
Perl_croak(aTHX_ "Cannot copy to %s", type);
} else if (sflags & SVf_ROK) {
- if (isGV_with_GP(dstr) && dtype == SVt_PVGV
+ if (isGV_with_GP(dstr)
&& SvTYPE(SvRV(sstr)) == SVt_PVGV && isGV_with_GP(SvRV(sstr))) {
sstr = SvRV(sstr);
if (sstr == dstr) {
@@ -3940,7 +3941,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
}
if (dtype >= SVt_PV) {
- if (dtype == SVt_PVGV && isGV_with_GP(dstr)) {
+ if (isGV_with_GP(dstr)) {
glob_assign_ref(dstr, sstr);
return;
}
@@ -3958,7 +3959,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
assert(!(sflags & SVf_NOK));
assert(!(sflags & SVf_IOK));
}
- else if (dtype == SVt_PVGV && isGV_with_GP(dstr)) {
+ else if (isGV_with_GP(dstr)) {
if (!(sflags & SVf_OK)) {
Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
"Undefined value assigned to typeglob");
@@ -4559,7 +4560,7 @@ Perl_sv_force_normal_flags(pTHX_ registe
#endif
if (SvROK(sv))
sv_unref_flags(sv, flags);
- else if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
+ else if (SvFAKE(sv) && isGV_with_GP(sv))
sv_unglob(sv);
else if (SvFAKE(sv) && SvTYPE(sv) == SVt_REGEXP) {
/* Need to downgrade the REGEXP to a simple(r) scalar. This is analagous
@@ -8372,6 +8373,7 @@ Perl_sv_2io(pTHX_ SV *const sv)
io = MUTABLE_IO(sv);
break;
case SVt_PVGV:
+ case SVt_PVLV:
if (isGV_with_GP(sv)) {
gv = MUTABLE_GV(sv);
io = GvIO(gv);
@@ -8975,7 +8977,8 @@ Perl_sv_bless(pTHX_ SV *const sv, HV *co
return sv;
}
-/* Downgrades a PVGV to a PVMG.
+/* Downgrades a PVGV to a PVMG. If it’s actually a PVLV, we leave the type
+ * as it is after unglobbing it.
*/
STATIC void
@@ -8988,7 +8991,7 @@ S_sv_unglob(pTHX_ SV *const sv)
PERL_ARGS_ASSERT_SV_UNGLOB;
- assert(SvTYPE(sv) == SVt_PVGV);
+ assert(SvTYPE(sv) == SVt_PVGV || SvTYPE(sv) == SVt_PVLV);
SvFAKE_off(sv);
gv_efullname3(temp, MUTABLE_GV(sv), "*");
@@ -9008,14 +9011,16 @@ S_sv_unglob(pTHX_ SV *const sv)
}
isGV_with_GP_off(sv);
- /* need to keep SvANY(sv) in the right arena */
- xpvmg = new_XPVMG();
- StructCopy(SvANY(sv), xpvmg, XPVMG);
- del_XPVGV(SvANY(sv));
- SvANY(sv) = xpvmg;
+ if(SvTYPE(sv) == SVt_PVGV) {
+ /* need to keep SvANY(sv) in the right arena */
+ xpvmg = new_XPVMG();
+ StructCopy(SvANY(sv), xpvmg, XPVMG);
+ del_XPVGV(SvANY(sv));
+ SvANY(sv) = xpvmg;
- SvFLAGS(sv) &= ~SVTYPEMASK;
- SvFLAGS(sv) |= SVt_PVMG;
+ SvFLAGS(sv) &= ~SVTYPEMASK;
+ SvFLAGS(sv) |= SVt_PVMG;
+ }
/* Intentionally not calling any local SET magic, as this isn't so much a
set operation as merely an internal storage change. */
diff -Nup blead-77362-glob2lv0/util.c blead-77362-glob2lv8/util.c
--- blead-77362-glob2lv0/util.c 2010-07-27 00:51:15.000000000 -0700
+++ blead-77362-glob2lv8/util.c 2010-08-25 22:26:49.000000000 -0700
@@ -3828,7 +3828,8 @@ Perl_my_fflush_all(pTHX)
void
Perl_report_evil_fh(pTHX_ const GV *gv, const IO *io, I32 op)
{
- const char * const name = gv && isGV(gv) ? GvENAME(gv) : NULL;
+ const char * const name
+ = gv && (isGV(gv) || isGV_with_GP(gv)) ? GvENAME(gv) : NULL;
if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) {
if (ckWARN(WARN_IO)) {
diff -Nurp blead-77362-glob2lv0/t/op/gv.t blead-77362-glob2lv8/t/op/gv.t
--- blead-77362-glob2lv0/t/op/gv.t 2010-07-26 01:29:10.000000000 -0700
+++ blead-77362-glob2lv8/t/op/gv.t 2010-08-25 22:25:50.000000000 -0700
@@ -7,12 +7,12 @@
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
+ require './test.pl';
}
use warnings;
-require './test.pl';
-plan( tests => 192 );
+plan( tests => 217 );
# type coersion on assignment
$foo = 'foo';
@@ -253,11 +253,12 @@ is($j[0], 1);
# test the assignment of a GLOB to an LVALUE
my $e = '';
local $SIG{__DIE__} = sub { $e = $_[0] };
- my $v;
+ my %v;
sub f { $_[0] = 0; $_[0] = "a"; $_[0] = *DATA }
- f($v);
- is ($v, '*main::DATA');
- my $x = <$v>;
+ f($v{v});
+ is ($v{v}, '*main::DATA');
+ is (ref\$v{v}, 'GLOB', 'lvalue assignment preserves globs');
+ my $x = readline $v{v};
is ($x, "perl\n");
}
@@ -272,6 +273,10 @@ is($j[0], 1);
tie my @ary => "T";
$ary[0] = *DATA;
is ($ary[0], '*main::DATA');
+ is (
+ ref\tied(@ary)->[0], 'GLOB',
+ 'tied elem assignment preserves globs'
+ );
is ($e, '');
my $x = readline $ary[0];
is($x, "rocks\n");
@@ -634,6 +639,125 @@ is (scalar $::{fake}, "*main::sym",
);
}
+# [perl #77362] various bugs related to globs as PVLVs
+{
+ no warnings 'once';
+ my %h; # We pass a key of this hash to the subroutine to get a PVLV.
+ sub { for(shift) {
+ # Set up our glob-as-PVLV
+ $_ = *hon;
+
+ # Bad symbol for array
+ ok eval{ @$_; 1 }, 'PVLV glob slots can be autovivified' or diag $@;
+
+ # This should call TIEHANDLE, not TIESCALAR
+ *thext::TIEHANDLE = sub{};
+ ok eval{ tie *$_, 'thext'; 1 }, 'PVLV globs can be tied as handles'
+ or diag $@;
+
+ # Assigning undef to the glob should not overwrite it...
+ {
+ my $w;
+ local $SIG{__WARN__} = sub { $w = shift };
+ *$_ = undef;
+ is $_, "*main::hon", 'PVLV: assigning undef to the glob does nothing';
+ like $w, qr\Undefined value assigned to typeglob\,
+ 'PVLV: assigning undef to the glob warns';
+ }
+
+ # Neither should number assignment...
+ *$_ = 1;
+ is $_, "*main::1", "PVLV: integer-to-glob assignment assigns a glob";
+ *$_ = 2.0;
+ is $_, "*main::2", "PVLV: float-to-glob assignment assigns a glob";
+
+ # Nor reference assignment.
+ *$_ = \*thit;
+ is $_, "*main::thit", "PVLV: globref-to-glob assignment assigns a glob";
+ *$_ = [];
+ is $_, "*main::thit", "PVLV: arrayref assignment assigns to the AV slot";
+
+ # Concatenation should still work.
+ ok eval { $_ .= 'thlew' }, 'PVLV concatenation does not die' or diag $@;
+ is $_, '*main::thitthlew', 'PVLV concatenation works';
+
+ # And we should be able to overwrite it with a string, number, or refer-
+ # ence, too, if we omit the *.
+ $_ = *hon; $_ = 'tzor';
+ is $_, 'tzor', 'PVLV: assigning a string over a glob';
+ $_ = *hon; $_ = 23;
+ is $_, 23, 'PVLV: assigning an integer over a glob';
+ $_ = *hon; $_ = 23.23;
+ is $_, 23.23, 'PVLV: assigning a float over a glob';
+ $_ = *hon; $_ = \my $sthat;
+ is $_, \$sthat, 'PVLV: assigning a reference over a glob';
+
+ # This bug was found by code inspection. Could this ever happen in
+ # real life? :-)
+ # This duplicates a file handle, accessing it through a PVLV glob, the
+ # glob having been removed from the symbol table, so a stringified form
+ # of it does not work. This checks that sv_2io does not stringify a PVLV.
+ $_ = *quin;
+ open *quin, "test.pl"; # test.pl is as good a file as any
+ delete $::{quin};
+ ok eval { open my $zow, "<&", $_ }, 'PVLV: sv_2io stringifieth not'
+ or diag $@;
+
+ # Similar tests to make sure sv_2cv etc. do not stringify.
+ *$_ = sub { 1 };
+ ok eval { &$_ }, "PVLV glob can be called as a sub" or diag $@;
+ *flelp = sub { 2 };
+ $_ = 'flelp';
+ is eval { &$_ }, 2, 'PVLV holding a string can be called as a sub'
+ or diag $@;
+
+ # Coderef-to-glob assignment when the glob is no longer accessible
+ # under its name: These tests are to make sure the OPpASSIGN_CV_TO_GV
+ # optimisation takes PVLVs into account, which is why the RHSs have to be
+ # named subs.
+ use constant gheen => 'quare';
+ $_ = *ming;
+ delete $::{ming};
+ *$_ = \&gheen;
+ is eval { &$_ }, 'quare',
+ 'PVLV: constant assignment when the glob is detached from the symtab'
+ or diag $@;
+ $_ = *bength;
+ delete $::{bength};
+ *gheck = sub { 'lon' };
+ *$_ = \&gheck;
+ is eval { &$_ }, 'lon',
+ 'PVLV: coderef assignment when the glob is detached from the symtab'
+ or diag $@;
+
+ # open should accept a PVLV as its first argument
+ $_ = *hon;
+ ok eval { open $_,'<', \my $thlext }, 'PVLV can be the first arg to open'
+ or diag $@;
+
+ # -t should not stringify
+ $_ = *thlit; delete $::{thlit};
+ *$_ = *STDOUT{IO};
+ ok defined -t $_, 'PVLV: -t does not stringify';
+
+ # neither should -T
+ open my $quile, "<", 'test.pl';
+ $_ = *$quile;
+ ok -T $_, "PVLV: -T does not stringify";
+
+ # Unopened file handle
+ {
+ my $w;
+ local $SIG{__WARN__} = sub { $w .= shift };
+ $_ = *vor;
+ close $_;
+ like $w, qr\unopened filehandle vor\,
+ 'PVLV globs get their names reported in unopened error messages';
+ }
+
+ }}->($h{k});
+}
+
__END__
Perl
Rules |
From @cpansproutOn Aug 29, 2010, at 12:49 PM, Father Chrysostomos wrote:
Here is a better patch that avoids a void warning. |
From @cpansproutFrom: Father Chrysostomos <sprout@cpan.org> [perl #77362] Assigning glob to lvalue causes stringification This test from t/op/gv.t was added by change 22315/4ce457a6: { That change was the one that made glob-to-lvalue assignment work to This patch fixes the test and adds tests to make sure what is assigned It also happens to fix the stringification bug. In doing so, it essen- It turns out that many different parts of the perl source don’t fully • GvIO(gv) to make readline and other I/O ops work. • Autovivification of glob slots. • tie *$pvlv • *$pvlv = undef, *$pvlv = $number, *$pvlv = $ref • Duplicating a filehandle accessed through a PVLV glob when the • Using a PVLV glob as a subroutine reference • Coderef assignment when the glob is no longer in the symbol table • open with a PVLV glob for the filehandle • -t and -T • Unopened file handle warnings Inline Patchdiff -Nup blead-77362-glob2lv0/gv.c blead-77362-glob2lv8/gv.c
--- blead-77362-glob2lv0/gv.c 2010-07-24 08:14:09.000000000 -0700
+++ blead-77362-glob2lv8/gv.c 2010-08-23 22:21:43.000000000 -0700
@@ -45,7 +45,13 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype
{
SV **where;
- if (!gv || SvTYPE((const SV *)gv) != SVt_PVGV) {
+ if (
+ !gv
+ || (
+ SvTYPE((const SV *)gv) != SVt_PVGV
+ && SvTYPE((const SV *)gv) != SVt_PVLV
+ )
+ ) {
const char *what;
if (type == SVt_PVIO) {
/*
diff -Nup blead-77362-glob2lv0/gv.h blead-77362-glob2lv8/gv.h
--- blead-77362-glob2lv0/gv.h 2010-06-04 13:48:10.000000000 -0700
+++ blead-77362-glob2lv8/gv.h 2010-08-23 20:39:17.000000000 -0700
@@ -88,7 +88,17 @@ Return the SV from the GV.
#endif
#define GvREFCNT(gv) (GvGP(gv)->gp_refcnt)
-#define GvIO(gv) ((gv) && SvTYPE((const SV*)gv) == SVt_PVGV && GvGP(gv) ? GvIOp(gv) : NULL)
+#define GvIO(gv) \
+ ( \
+ (gv) \
+ && ( \
+ SvTYPE((const SV*)(gv)) == SVt_PVGV \
+ || SvTYPE((const SV*)(gv)) == SVt_PVLV \
+ ) \
+ && GvGP(gv) \
+ ? GvIOp(gv) \
+ : NULL \
+ )
#define GvIOp(gv) (GvGP(gv)->gp_io)
#define GvIOn(gv) (GvIO(gv) ? GvIOp(gv) : GvIOp(gv_IOadd(gv)))
diff -Nup blead-77362-glob2lv0/pp_hot.c blead-77362-glob2lv8/pp_hot.c
--- blead-77362-glob2lv0/pp_hot.c 2010-08-20 18:55:11.000000000 -0700
+++ blead-77362-glob2lv8/pp_hot.c 2010-08-25 13:25:56.000000000 -0700
@@ -123,7 +123,7 @@ PP(pp_sassign)
if (PL_op->op_private & OPpASSIGN_CV_TO_GV) {
SV * const cv = SvRV(left);
const U32 cv_type = SvTYPE(cv);
- const U32 gv_type = SvTYPE(right);
+ const bool is_gv = isGV_with_GP(right);
const bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM;
if (!got_coderef) {
@@ -133,7 +133,7 @@ PP(pp_sassign)
/* Can do the optimisation if right (LVALUE) is not a typeglob,
left (RVALUE) is a reference to something, and we're in void
context. */
- if (!got_coderef && gv_type != SVt_PVGV && GIMME_V == G_VOID) {
+ if (!got_coderef && !is_gv && GIMME_V == G_VOID) {
/* Is the target symbol table currently empty? */
GV * const gv = gv_fetchsv(right, GV_NOINIT, SVt_PVGV);
if (SvTYPE(gv) != SVt_PVGV && !SvOK(gv)) {
@@ -151,7 +151,7 @@ PP(pp_sassign)
}
/* Need to fix things up. */
- if (gv_type != SVt_PVGV) {
+ if (!is_gv) {
/* Need to fix GV. */
right = MUTABLE_SV(gv_fetchsv(right, GV_ADD, SVt_PVGV));
}
@@ -201,7 +201,7 @@ PP(pp_sassign)
/* Allow glob assignments like *$x = ..., which, when the glob has a
SVf_FAKE flag, cannot be distinguished from $x = ... without looking
at the op tree. */
- if( SvTYPE(right) == SVt_PVGV && cBINOP->op_last->op_type == OP_RV2GV
+ if( isGV_with_GP(right) && cBINOP->op_last->op_type == OP_RV2GV
&& (wasfake = SvFLAGS(right) & SVf_FAKE) )
SvFLAGS(right) &= ~SVf_FAKE;
SvSetMagicSV(right, left);
@@ -2730,6 +2730,7 @@ PP(pp_entersub)
case SVt_PVGV:
if (!isGV_with_GP(sv))
DIE(aTHX_ "Not a CODE reference");
+ we_have_a_glob:
if (!(cv = GvCVu((const GV *)sv))) {
HV *stash;
cv = sv_2cv(sv, &stash, &gv, 0);
@@ -2740,6 +2741,9 @@ PP(pp_entersub)
goto try_autoload;
}
break;
+ case SVt_PVLV:
+ if(isGV_with_GP(sv)) goto we_have_a_glob;
+ /*FALLTHROUGH*/
default:
if (sv == &PL_sv_yes) { /* unfound import, ignore */
if (hasargs)
diff -Nup blead-77362-glob2lv0/pp_sys.c blead-77362-glob2lv8/pp_sys.c
--- blead-77362-glob2lv0/pp_sys.c 2010-08-19 18:47:10.000000000 -0700
+++ blead-77362-glob2lv8/pp_sys.c 2010-08-25 18:03:31.000000000 -0700
@@ -505,7 +505,7 @@ PP(pp_open)
GV * const gv = MUTABLE_GV(*++MARK);
- if (!isGV(gv))
+ if (!isGV(gv) && !(SvTYPE(gv) == SVt_PVLV && isGV_with_GP(gv)))
DIE(aTHX_ PL_no_usym, "filehandle");
if ((io = GvIOp(gv))) {
@@ -825,6 +825,7 @@ PP(pp_tie)
methname = "TIEARRAY";
break;
case SVt_PVGV:
+ case SVt_PVLV:
if (isGV_with_GP(varsv)) {
methname = "TIEHANDLE";
how = PERL_MAGIC_tiedscalar;
@@ -3338,7 +3339,7 @@ PP(pp_fttty)
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
- else if (isGV(TOPs))
+ else if (isGV_with_GP(TOPs))
gv = MUTABLE_GV(POPs);
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
gv = MUTABLE_GV(SvRV(POPs));
@@ -3391,7 +3392,7 @@ PP(pp_fttext)
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
- else if (isGV(TOPs))
+ else if (isGV_with_GP(TOPs))
gv = MUTABLE_GV(POPs);
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
gv = MUTABLE_GV(SvRV(POPs));
diff -Nup blead-77362-glob2lv0/sv.c blead-77362-glob2lv8/sv.c
--- blead-77362-glob2lv0/sv.c 2010-08-20 18:55:11.000000000 -0700
+++ blead-77362-glob2lv8/sv.c 2010-08-25 20:37:26.000000000 -0700
@@ -3774,7 +3774,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
switch (stype) {
case SVt_NULL:
undef_sstr:
- if (dtype != SVt_PVGV) {
+ if (dtype != SVt_PVGV && dtype != SVt_PVLV) {
(void)SvOK_off(dstr);
return;
}
@@ -3790,6 +3790,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
sv_upgrade(dstr, SVt_PVIV);
break;
case SVt_PVGV:
+ case SVt_PVLV:
goto end_of_first_switch;
}
(void)SvIOK_only(dstr);
@@ -3821,6 +3822,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
sv_upgrade(dstr, SVt_PVNV);
break;
case SVt_PVGV:
+ case SVt_PVLV:
goto end_of_first_switch;
}
SvNV_set(dstr, SvNVX(sstr));
@@ -3873,7 +3875,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
/* case SVt_BIND: */
case SVt_PVLV:
case SVt_PVGV:
- if (isGV_with_GP(sstr) && dtype <= SVt_PVGV) {
+ if (isGV_with_GP(sstr) && dtype <= SVt_PVLV) {
glob_assign_glob(dstr, sstr, dtype);
return;
}
@@ -3883,12 +3885,11 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
case SVt_PVMG:
if (SvGMAGICAL(sstr) && (flags & SV_GMAGIC)) {
mg_get(sstr);
- if (SvTYPE(sstr) != stype) {
+ if (SvTYPE(sstr) != stype)
stype = SvTYPE(sstr);
- if (isGV_with_GP(sstr) && stype == SVt_PVGV && dtype <= SVt_PVGV) {
+ if (isGV_with_GP(sstr) && dtype <= SVt_PVLV) {
glob_assign_glob(dstr, sstr, dtype);
return;
- }
}
}
if (stype == SVt_PVLV)
@@ -3923,7 +3924,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
else
Perl_croak(aTHX_ "Cannot copy to %s", type);
} else if (sflags & SVf_ROK) {
- if (isGV_with_GP(dstr) && dtype == SVt_PVGV
+ if (isGV_with_GP(dstr)
&& SvTYPE(SvRV(sstr)) == SVt_PVGV && isGV_with_GP(SvRV(sstr))) {
sstr = SvRV(sstr);
if (sstr == dstr) {
@@ -3940,7 +3941,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
}
if (dtype >= SVt_PV) {
- if (dtype == SVt_PVGV && isGV_with_GP(dstr)) {
+ if (isGV_with_GP(dstr)) {
glob_assign_ref(dstr, sstr);
return;
}
@@ -3958,7 +3959,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
assert(!(sflags & SVf_NOK));
assert(!(sflags & SVf_IOK));
}
- else if (dtype == SVt_PVGV && isGV_with_GP(dstr)) {
+ else if (isGV_with_GP(dstr)) {
if (!(sflags & SVf_OK)) {
Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
"Undefined value assigned to typeglob");
@@ -4559,7 +4560,7 @@ Perl_sv_force_normal_flags(pTHX_ registe
#endif
if (SvROK(sv))
sv_unref_flags(sv, flags);
- else if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
+ else if (SvFAKE(sv) && isGV_with_GP(sv))
sv_unglob(sv);
else if (SvFAKE(sv) && SvTYPE(sv) == SVt_REGEXP) {
/* Need to downgrade the REGEXP to a simple(r) scalar. This is analagous
@@ -8372,6 +8373,7 @@ Perl_sv_2io(pTHX_ SV *const sv)
io = MUTABLE_IO(sv);
break;
case SVt_PVGV:
+ case SVt_PVLV:
if (isGV_with_GP(sv)) {
gv = MUTABLE_GV(sv);
io = GvIO(gv);
@@ -8975,7 +8977,8 @@ Perl_sv_bless(pTHX_ SV *const sv, HV *co
return sv;
}
-/* Downgrades a PVGV to a PVMG.
+/* Downgrades a PVGV to a PVMG. If it’s actually a PVLV, we leave the type
+ * as it is after unglobbing it.
*/
STATIC void
@@ -8988,7 +8991,7 @@ S_sv_unglob(pTHX_ SV *const sv)
PERL_ARGS_ASSERT_SV_UNGLOB;
- assert(SvTYPE(sv) == SVt_PVGV);
+ assert(SvTYPE(sv) == SVt_PVGV || SvTYPE(sv) == SVt_PVLV);
SvFAKE_off(sv);
gv_efullname3(temp, MUTABLE_GV(sv), "*");
@@ -9008,14 +9011,16 @@ S_sv_unglob(pTHX_ SV *const sv)
}
isGV_with_GP_off(sv);
- /* need to keep SvANY(sv) in the right arena */
- xpvmg = new_XPVMG();
- StructCopy(SvANY(sv), xpvmg, XPVMG);
- del_XPVGV(SvANY(sv));
- SvANY(sv) = xpvmg;
+ if(SvTYPE(sv) == SVt_PVGV) {
+ /* need to keep SvANY(sv) in the right arena */
+ xpvmg = new_XPVMG();
+ StructCopy(SvANY(sv), xpvmg, XPVMG);
+ del_XPVGV(SvANY(sv));
+ SvANY(sv) = xpvmg;
- SvFLAGS(sv) &= ~SVTYPEMASK;
- SvFLAGS(sv) |= SVt_PVMG;
+ SvFLAGS(sv) &= ~SVTYPEMASK;
+ SvFLAGS(sv) |= SVt_PVMG;
+ }
/* Intentionally not calling any local SET magic, as this isn't so much a
set operation as merely an internal storage change. */
diff -Nup blead-77362-glob2lv0/util.c blead-77362-glob2lv8/util.c
--- blead-77362-glob2lv0/util.c 2010-07-27 00:51:15.000000000 -0700
+++ blead-77362-glob2lv8/util.c 2010-08-25 22:26:49.000000000 -0700
@@ -3828,7 +3828,8 @@ Perl_my_fflush_all(pTHX)
void
Perl_report_evil_fh(pTHX_ const GV *gv, const IO *io, I32 op)
{
- const char * const name = gv && isGV(gv) ? GvENAME(gv) : NULL;
+ const char * const name
+ = gv && (isGV(gv) || isGV_with_GP(gv)) ? GvENAME(gv) : NULL;
if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) {
if (ckWARN(WARN_IO)) {
diff -Nurp blead-77362-glob2lv0/t/op/gv.t blead-77362-glob2lv8/t/op/gv.t
--- blead-77362-glob2lv0/t/op/gv.t 2010-07-26 01:29:10.000000000 -0700
+++ blead-77362-glob2lv8/t/op/gv.t 2010-08-25 22:25:50.000000000 -0700
@@ -7,12 +7,12 @@
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
+ require './test.pl';
}
use warnings;
-require './test.pl';
-plan( tests => 192 );
+plan( tests => 217 );
# type coersion on assignment
$foo = 'foo';
@@ -253,11 +253,12 @@ is($j[0], 1);
# test the assignment of a GLOB to an LVALUE
my $e = '';
local $SIG{__DIE__} = sub { $e = $_[0] };
- my $v;
+ my %v;
sub f { $_[0] = 0; $_[0] = "a"; $_[0] = *DATA }
- f($v);
- is ($v, '*main::DATA');
- my $x = <$v>;
+ f($v{v});
+ is ($v{v}, '*main::DATA');
+ is (ref\$v{v}, 'GLOB', 'lvalue assignment preserves globs');
+ my $x = readline $v{v};
is ($x, "perl\n");
}
@@ -272,6 +273,10 @@ is($j[0], 1);
tie my @ary => "T";
$ary[0] = *DATA;
is ($ary[0], '*main::DATA');
+ is (
+ ref\tied(@ary)->[0], 'GLOB',
+ 'tied elem assignment preserves globs'
+ );
is ($e, '');
my $x = readline $ary[0];
is($x, "rocks\n");
@@ -634,6 +639,125 @@ is (scalar $::{fake}, "*main::sym",
);
}
+# [perl #77362] various bugs related to globs as PVLVs
+{
+ no warnings qw 'once void';
+ my %h; # We pass a key of this hash to the subroutine to get a PVLV.
+ sub { for(shift) {
+ # Set up our glob-as-PVLV
+ $_ = *hon;
+
+ # Bad symbol for array
+ ok eval{ @$_; 1 }, 'PVLV glob slots can be autovivified' or diag $@;
+
+ # This should call TIEHANDLE, not TIESCALAR
+ *thext::TIEHANDLE = sub{};
+ ok eval{ tie *$_, 'thext'; 1 }, 'PVLV globs can be tied as handles'
+ or diag $@;
+
+ # Assigning undef to the glob should not overwrite it...
+ {
+ my $w;
+ local $SIG{__WARN__} = sub { $w = shift };
+ *$_ = undef;
+ is $_, "*main::hon", 'PVLV: assigning undef to the glob does nothing';
+ like $w, qr\Undefined value assigned to typeglob\,
+ 'PVLV: assigning undef to the glob warns';
+ }
+
+ # Neither should number assignment...
+ *$_ = 1;
+ is $_, "*main::1", "PVLV: integer-to-glob assignment assigns a glob";
+ *$_ = 2.0;
+ is $_, "*main::2", "PVLV: float-to-glob assignment assigns a glob";
+
+ # Nor reference assignment.
+ *$_ = \*thit;
+ is $_, "*main::thit", "PVLV: globref-to-glob assignment assigns a glob";
+ *$_ = [];
+ is $_, "*main::thit", "PVLV: arrayref assignment assigns to the AV slot";
+
+ # Concatenation should still work.
+ ok eval { $_ .= 'thlew' }, 'PVLV concatenation does not die' or diag $@;
+ is $_, '*main::thitthlew', 'PVLV concatenation works';
+
+ # And we should be able to overwrite it with a string, number, or refer-
+ # ence, too, if we omit the *.
+ $_ = *hon; $_ = 'tzor';
+ is $_, 'tzor', 'PVLV: assigning a string over a glob';
+ $_ = *hon; $_ = 23;
+ is $_, 23, 'PVLV: assigning an integer over a glob';
+ $_ = *hon; $_ = 23.23;
+ is $_, 23.23, 'PVLV: assigning a float over a glob';
+ $_ = *hon; $_ = \my $sthat;
+ is $_, \$sthat, 'PVLV: assigning a reference over a glob';
+
+ # This bug was found by code inspection. Could this ever happen in
+ # real life? :-)
+ # This duplicates a file handle, accessing it through a PVLV glob, the
+ # glob having been removed from the symbol table, so a stringified form
+ # of it does not work. This checks that sv_2io does not stringify a PVLV.
+ $_ = *quin;
+ open *quin, "test.pl"; # test.pl is as good a file as any
+ delete $::{quin};
+ ok eval { open my $zow, "<&", $_ }, 'PVLV: sv_2io stringifieth not'
+ or diag $@;
+
+ # Similar tests to make sure sv_2cv etc. do not stringify.
+ *$_ = sub { 1 };
+ ok eval { &$_ }, "PVLV glob can be called as a sub" or diag $@;
+ *flelp = sub { 2 };
+ $_ = 'flelp';
+ is eval { &$_ }, 2, 'PVLV holding a string can be called as a sub'
+ or diag $@;
+
+ # Coderef-to-glob assignment when the glob is no longer accessible
+ # under its name: These tests are to make sure the OPpASSIGN_CV_TO_GV
+ # optimisation takes PVLVs into account, which is why the RHSs have to be
+ # named subs.
+ use constant gheen => 'quare';
+ $_ = *ming;
+ delete $::{ming};
+ *$_ = \&gheen;
+ is eval { &$_ }, 'quare',
+ 'PVLV: constant assignment when the glob is detached from the symtab'
+ or diag $@;
+ $_ = *bength;
+ delete $::{bength};
+ *gheck = sub { 'lon' };
+ *$_ = \&gheck;
+ is eval { &$_ }, 'lon',
+ 'PVLV: coderef assignment when the glob is detached from the symtab'
+ or diag $@;
+
+ # open should accept a PVLV as its first argument
+ $_ = *hon;
+ ok eval { open $_,'<', \my $thlext }, 'PVLV can be the first arg to open'
+ or diag $@;
+
+ # -t should not stringify
+ $_ = *thlit; delete $::{thlit};
+ *$_ = *STDOUT{IO};
+ ok defined -t $_, 'PVLV: -t does not stringify';
+
+ # neither should -T
+ open my $quile, "<", 'test.pl';
+ $_ = *$quile;
+ ok -T $_, "PVLV: -T does not stringify";
+
+ # Unopened file handle
+ {
+ my $w;
+ local $SIG{__WARN__} = sub { $w .= shift };
+ $_ = *vor;
+ close $_;
+ like $w, qr\unopened filehandle vor\,
+ 'PVLV globs get their names reported in unopened error messages';
+ }
+
+ }}->($h{k});
+}
+
__END__
Perl
Rules |
From @cpansproutThis turns out to be a duplicate of #36051. |
From @cpansproutOn Sun Sep 05 13:45:54 2010, sprout wrote:
Applied as 13be902. Now the original script in this ticket will work again, the way it did |
@cpansprout - Status changed from 'new' to 'resolved' |
From @cpansproutOn Sun Sep 26 12:21:02 2010, sprout wrote:
I forgot to forward this to p5p. |
From [Unknown Contact. See original ticket]On Sun Sep 26 12:21:02 2010, sprout wrote:
I forgot to forward this to p5p. |
From @tonycozOn Sun, Sep 26, 2010 at 12:22:22PM -0700, Father Chrysostomos via RT wrote:
The tests for this fail for PERLIO=stdio tony@mars:.../perl/t$ PERLIO=stdio ./perl harness -v op/gv.t Test Summary Report op/gv.t (Wstat: 5632 Tests: 217 Failed: 0) |
From @cpansproutOn Sep 26, 2010, at 6:33 PM, Tony Cook via RT wrote:
Does 804401e solve the problem for you? (It doesn’t fail on Mac OS X.) |
From @tonycozOn Sun, Sep 26, 2010 at 10:19:16PM -0700, Father Chrysostomos wrote:
That fixed it. Tony |
From @cpansproutThis turns out to be a duplicate of #36051. |
From @cpansproutOn Tue May 31 07:20:09 2005, nicholas wrote:
I fixed that in 13be902 some time ago, but that is not the whole story. The same thing occurs with regexps. Substitute ${qr||} for *FOO in the I thought perhaps the solution would be to disallow ${qr||} and make But XPVLV and struct regexp conflict. -- Father Chrysostomos |
From @cpansproutOn Fri Oct 26 06:32:19 2012, sprout wrote:
Now fixed in 8d919b0. -- Father Chrysostomos |
From [Unknown Contact. See original ticket]On Fri Oct 26 06:32:19 2012, sprout wrote:
Now fixed in 8d919b0. -- Father Chrysostomos |
From @bulk88I am currently rewriting Perl_gv_add_by_type but I see something strange http://perl5.git.perl.org/perl.git/commitdiff/13be902cef8b01c085a6b8b1b59fa2754a10cdfb So what is the sv_u of a PVLV? Why would a LV have a GP ptr? I thought if (SvREADONLY(buffer)) { |
From @cpansproutOn Mon Dec 29 13:57:37 2014, bulk88 wrote:
If you assign a typeglob to a deferred element or to an element of a tied aggregate, then you get a PVLV that is a typeglob.
The sv_u of a PVLV may differ just as much as the sv_u of a PVMG. It can hold an SV pointer if you assigned a reference to a PVLV. Actually, it can differ more. A PVLV can also be a REGEXP thingy (with sv_u pointing to the regexp struct) even though the internal type is SVt_PVLV, not SVt_REGEXP. This is because PVLV needs to be able to hold any type of scalar.
I am confused as to why that code would be affected by the sv_u field of a PVLV. -- Father Chrysostomos |
From @bulk88On Mon Dec 29 14:41:37 2014, sprout wrote:
Wouldn't that cause a "Bizzare copy of" panic later, since aggregate slices are scalars (you can only place a RV to an aggregate in a aggregate slice)? C:\>perl -MDevel::Peek=Dump -E"my $s = ' '; Dump($s); $s = *ARGV::; Dump($s); $s C:\> This is breaking the rule you can't downgrade an SV. Also this doesnt SEGVs since sv_upgrade leaves the PVX buffer of a PV intact, sv_clear falls through from case SVt_PVGV" to the regular PV type, and there is no SEGV clearing the GP since this half GV fails isGV_with_GP(sv). I know Perl_gv_init_pvn does black magic to make sv_upgrade(sv, SVt_PVGV); safe. void t3() But here I defeated all the logic and made a leak void t4() for(i =0; i < 400000000; i++) { The reason a string doesn't work to make a leak is since S_gv_init_svtype checks the GP struct (which is a PV buffer with invalid pointers) for NULL pointer, and a string isn't going to be interpreted as a NULL pointers unless I did the above, also the type requested must be IO HV or AV. A different variant, I couldn't get it to SEGV. void t4() C:\Documents and Settings\Owner\Desktop\cpan libs\lxs2>perl -MLocal::XS2 -MDevel C:\Documents and Settings\Owner\Desktop\cpan libs\lxs2> SvPV does work correctly on a GV *. else if (isGV_with_GP(sv)) { gv_efullname3(buffer, gv, "*"); assert(SvPOK(buffer));
You said scalar. GV/HV/AV are aggregates. I recently encountered "$v = int(${qr||});" in the test suite so I know regexps are scalars.
Wouldn't sv_setpv_mg(buffer, " ") leak or croak panic if its done on a GV, AV or HV, or my "LvTYPE(buffer) == 'y'" guarantees the PVLV is a scalar type? I already have 1 memleak above. -- |
From @cpansproutOn Mon Dec 29 19:59:35 2014, bulk88 wrote:
I don’t follow. This is what I am talking about: use Devel::Peek;
I have heard of that rule before, but I don’t remember the source. I think it I read it in illguts. But it’s actually not true, and never was. http://perl5.git.perl.org/perl.git/blob/perl-5.000:/sv.c#l3170
This part of the core is a bit confusing. You see, scalars with BM magic used to be of type SVt_PVGV, but were later changed to SVt_PVMG. Some parts of the core still account for the latter, but others expect SVt_PVGV always to be a genuine GV with GP.
Ouch. That should probably croak or fail an assertion.
GV is also a type of scalar. (This goes back at least to perl 5.) You can bind the $ sigil to any typeglob. use Devel::Peek; A typeglob created by assignment ($_ = *foo) is coercible. Yes, this is a design flaw.
That it is an SVt_PVLV guarantees it is a scalar. When a PVLV is a GV, it should always be of the coercible type. Hmmm. use experimental 'refaliasing'; Oh no. I don’t want to think about that. -- Father Chrysostomos |
Migrated from rt.perl.org#36051 (status was 'resolved')
Searchable as RT36051$
The text was updated successfully, but these errors were encountered: