diff options
| author | Robin Houston <robin@cpan.org> | 2005-11-22 14:07:27 +0000 |
|---|---|---|
| committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2005-11-22 15:54:16 +0000 |
| commit | c75ab21a94d99a03945b25b8b1543b7a345f7e80 (patch) | |
| tree | 6d58ca9816d59a91e54e35110557bccdf9da16c6 | |
| parent | 5c6165b15bb6ff9e401a0d7426d3bf14fafaf5e2 (diff) | |
| download | perl-c75ab21a94d99a03945b25b8b1543b7a345f7e80.tar.gz | |
Re: [PATCH] concat interacts badly with magic
Message-ID: <20051122140727.GA29861@rpc142.cs.man.ac.uk>
(new version of patch for bug #37722)
p4raw-id: //depot/perl@26192
| -rw-r--r-- | pp_hot.c | 17 | ||||
| -rw-r--r-- | t/lib/warnings/9uninit | 2 | ||||
| -rw-r--r-- | t/lib/warnings/pp_hot | 2 | ||||
| -rwxr-xr-x | t/op/tie.t | 7 |
4 files changed, 23 insertions, 5 deletions
@@ -148,11 +148,14 @@ PP(pp_concat) dPOPTOPssrl; bool lbyte; STRLEN rlen; - const char *rpv = SvPV_const(right, rlen); /* mg_get(right) happens here */ - const bool rbyte = !DO_UTF8(right); + const char *rpv; + bool rbyte; bool rcopied = FALSE; if (TARG == right && right != left) { + /* mg_get(right) may happen here ... */ + rpv = SvPV_const(right, rlen); + rbyte = !DO_UTF8(right); right = sv_2mortal(newSVpvn(rpv, rlen)); rpv = SvPV_const(right, rlen); /* no point setting UTF-8 here */ rcopied = TRUE; @@ -171,14 +174,22 @@ PP(pp_concat) else { /* TARG == left */ STRLEN llen; SvGETMAGIC(left); /* or mg_get(left) may happen here */ - if (!SvOK(TARG)) + if (!SvOK(TARG)) { + if (left == right && ckWARN(WARN_UNINITIALIZED)) + report_uninit(right); sv_setpvn(left, "", 0); + } (void)SvPV_nomg_const(left, llen); /* Needed to set UTF8 flag */ lbyte = !DO_UTF8(left); if (IN_BYTES) SvUTF8_off(TARG); } + /* or mg_get(right) may happen here */ + if (!rcopied) { + rpv = SvPV_const(right, rlen); + rbyte = !DO_UTF8(right); + } if (lbyte != rbyte) { if (lbyte) sv_utf8_upgrade_nomg(TARG); diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit index 023f85773d..07fffa87eb 100644 --- a/t/lib/warnings/9uninit +++ b/t/lib/warnings/9uninit @@ -625,8 +625,8 @@ Use of uninitialized value $m1 in glob elem at - line 5. Use of uninitialized value $g1 in subroutine prototype at - line 6. Use of uninitialized value $g1 in bless at - line 7. Use of uninitialized value $m1 in quoted execution (``, qx) at - line 8. -Use of uninitialized value $g1 in concatenation (.) or string at - line 10. Use of uninitialized value $m1 in concatenation (.) or string at - line 10. +Use of uninitialized value $g1 in concatenation (.) or string at - line 10. ######## use warnings 'uninitialized'; my ($m1); diff --git a/t/lib/warnings/pp_hot b/t/lib/warnings/pp_hot index 070aaf0aa5..a0b9b10139 100644 --- a/t/lib/warnings/pp_hot +++ b/t/lib/warnings/pp_hot @@ -267,8 +267,8 @@ $x .= $y; # should warn once $y .= $y; # should warn once EXPECT Use of uninitialized value $x in concatenation (.) or string at - line 5. -Use of uninitialized value $y in concatenation (.) or string at - line 6. Use of uninitialized value $x in concatenation (.) or string at - line 6. +Use of uninitialized value $y in concatenation (.) or string at - line 6. Use of uninitialized value $y in concatenation (.) or string at - line 7. Use of uninitialized value $y in concatenation (.) or string at - line 8. ######## diff --git a/t/op/tie.t b/t/op/tie.t index 1fe37e1624..8cb45398ad 100755 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -578,3 +578,10 @@ tie $h, "main"; print $h,"\n"; EXPECT 3.3 +######## +sub TIESCALAR { bless {} } +sub FETCH { shift()->{i} ++ } +tie $h, "main"; +print $h.$h; +EXPECT +01 |