diff options
| -rw-r--r-- | pod/perldelta.pod | 4 | ||||
| -rw-r--r-- | pp.c | 6 | ||||
| -rw-r--r-- | pp_hot.c | 2 | ||||
| -rw-r--r-- | sv.c | 4 | ||||
| -rw-r--r-- | t/op/auto.t | 12 |
5 files changed, 20 insertions, 8 deletions
diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 37a4d5dd7a..8b0950044a 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -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 @@ -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(); @@ -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) @@ -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) diff --git a/t/op/auto.t b/t/op/auto.t index ecfe48bba1..00f7caa077 100644 --- a/t/op/auto.t +++ b/t/op/auto.t @@ -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"; +} |