Permalink
Browse files

Make ++ and -- work on glob copies

These ops considered typeglobs read-only, even if they weren’t.
  • Loading branch information...
Father Chrysostomos
Father Chrysostomos committed Sep 16, 2011
1 parent a3342be commit 60092ce4854ea5801a4711d82d0e2c57a7edcaca
Showing with 20 additions and 8 deletions.
  1. +4 −0 pod/perldelta.pod
  2. +3 −3 pp.c
  3. +1 −1 pp_hot.c
  4. +2 −2 sv.c
  5. +10 −2 t/op/auto.t
View
@@ -805,6 +805,10 @@ C<glob> now clears %ENV before calling csh, since the latter croaks on some
systems if it does not like the contents of the LS_COLORS enviroment
variable [perl #98662].
+=item *
+
+C<++> and C<--> now work on copies of globs, instead of dying.
+
=back
=head1 Known Problems
View
6 pp.c
@@ -1054,7 +1054,7 @@ PP(pp_undef)
PP(pp_predec)
{
dVAR; dSP;
- if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
+ if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
Perl_croak_no_modify(aTHX);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MIN)
@@ -1071,7 +1071,7 @@ PP(pp_predec)
PP(pp_postinc)
{
dVAR; dSP; dTARGET;
- if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
+ if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
Perl_croak_no_modify(aTHX);
if (SvROK(TOPs))
TARG = sv_newmortal();
@@ -1095,7 +1095,7 @@ PP(pp_postinc)
PP(pp_postdec)
{
dVAR; dSP; dTARGET;
- if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
+ if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
Perl_croak_no_modify(aTHX);
if (SvROK(TOPs))
TARG = sv_newmortal();
View
@@ -362,7 +362,7 @@ PP(pp_eq)
PP(pp_preinc)
{
dVAR; dSP;
- if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
+ if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
Perl_croak_no_modify(aTHX);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MAX)
View
4 sv.c
@@ -7848,7 +7848,7 @@ Perl_sv_inc_nomg(pTHX_ register SV *const sv)
if (!sv)
return;
if (SvTHINKFIRST(sv)) {
- if (SvIsCOW(sv))
+ if (SvIsCOW(sv) || isGV_with_GP(sv))
sv_force_normal_flags(sv, 0);
if (SvREADONLY(sv)) {
if (IN_PERL_RUNTIME)
@@ -8029,7 +8029,7 @@ Perl_sv_dec_nomg(pTHX_ register SV *const sv)
if (!sv)
return;
if (SvTHINKFIRST(sv)) {
- if (SvIsCOW(sv))
+ if (SvIsCOW(sv) || isGV_with_GP(sv))
sv_force_normal_flags(sv, 0);
if (SvREADONLY(sv)) {
if (IN_PERL_RUNTIME)
View
@@ -3,10 +3,10 @@
BEGIN {
chdir 't' if -d 't';
@INC = qw(. ../lib);
+ require "test.pl";
}
-require "test.pl";
-plan( tests => 39 );
+plan( tests => 47 );
$x = 10000;
cmp_ok(0 + ++$x - 1,'==',10000,'scalar ++x - 1');
@@ -55,3 +55,11 @@ cmp_ok(++($foo = 'zz'), 'eq','aaa','zzz incr aaa');
cmp_ok(++($foo = 'A99'),'eq','B00','A99 incr B00');
cmp_ok(++($foo = 'zi'), 'eq','zj','zi incr zj (EBCDIC i,j non-contiguous check)');
cmp_ok(++($foo = 'zr'), 'eq','zs','zr incr zs (EBCDIC r,s non-contiguous check)');
+
+# test with glob copies
+
+for(qw '$x++ ++$x $x-- --$x') {
+ my $x = *foo;
+ ok eval "$_; 1", "$_ does not die on a glob copy";
+ is $x, /-/ ? -1 : 1, "result of $_ on a glob copy";
+}

0 comments on commit 60092ce

Please sign in to comment.