diff options
| -rw-r--r-- | doop.c | 2 | ||||
| -rw-r--r-- | pp_sys.c | 8 | ||||
| -rw-r--r-- | t/lib/warnings/9uninit | 1 | ||||
| -rw-r--r-- | t/op/gmagic.t | 6 |
4 files changed, 11 insertions, 6 deletions
@@ -1011,7 +1011,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) s = SvPV(sv, len); if (len && !SvPOK(sv)) - s = SvPV_force(sv, len); + s = SvPV_force_nomg(sv, len); if (DO_UTF8(sv)) { if (s && len) { char * const send = s + len; @@ -821,7 +821,7 @@ PP(pp_tie) break; } items = SP - MARK++; - if (sv_isobject(*MARK)) { + if (sv_isobject(*MARK)) { /* Calls GET magic. */ ENTER; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); @@ -835,10 +835,12 @@ PP(pp_tie) /* Not clear why we don't call call_method here too. * perhaps to get different error message ? */ - stash = gv_stashsv(*MARK, 0); + STRLEN len; + const char *name = SvPV_nomg_const(*MARK, len); + stash = gv_stashpvn(name, len, 0); if (!stash || !(gv = gv_fetchmethod(stash, methname))) { DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"", - methname, SVfARG(*MARK)); + methname, SVfARG(SvOK(*MARK) ? *MARK : &PL_sv_no)); } ENTER; PUSHSTACKi(PERLSI_MAGIC); diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit index 2d024479b5..e92f62a6a0 100644 --- a/t/lib/warnings/9uninit +++ b/t/lib/warnings/9uninit @@ -1132,7 +1132,6 @@ eval { my $x; sysread $m1, $x, $g1 }; eval { my $x; sysread $m1, $x, $g1, $g2 }; EXPECT Use of uninitialized value $m1 in tie at - line 5. -Use of uninitialized value $m1 in tie at - line 5. Use of uninitialized value $m1 in ref-to-glob cast at - line 7. Use of uninitialized value $g1 in read at - line 7. Use of uninitialized value $m1 in ref-to-glob cast at - line 8. diff --git a/t/op/gmagic.t b/t/op/gmagic.t index ab6d2ee3e6..ce05aff906 100644 --- a/t/op/gmagic.t +++ b/t/op/gmagic.t @@ -6,7 +6,7 @@ BEGIN { @INC = '../lib'; } -print "1..18\n"; +print "1..20\n"; my $t = 1; tie my $c => 'Tie::Monitor'; @@ -50,6 +50,10 @@ ok_string($s, 'x0', 2, 1); $s = $c = $c . $c; ok_string($s, '00', 3, 1); +# multiple magic in core functions +$s = chop($c); +ok_string($s, '0', 1, 1); + # adapted from Tie::Counter by Abigail package Tie::Monitor; |