dSP;
XPUSHs(MUTABLE_SV(PL_last_in_gv));
PUTBACK;
- pp_rv2gv();
+ Perl_pp_rv2gv(aTHX);
PL_last_in_gv = MUTABLE_GV(*PL_stack_sp--);
}
}
Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
++SP;
}
- PUSHMARK(MARK - 1);
- *MARK = SvTIED_obj(MUTABLE_SV(io), mg);
- PUTBACK;
- ENTER_with_name("call_PRINT");
- if( PL_op->op_type == OP_SAY ) {
- /* local $\ = "\n" */
- SAVEGENERICSV(PL_ors_sv);
- PL_ors_sv = newSVpvs("\n");
- }
- call_method("PRINT", G_SCALAR);
- LEAVE_with_name("call_PRINT");
- SPAGAIN;
- MARK = ORIGMARK + 1;
- *MARK = *SP;
- SP = MARK;
- RETURN;
+ return Perl_tied_method(aTHX_ "PRINT", mark - 1, MUTABLE_SV(io),
+ mg,
+ (G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK
+ | (PL_op->op_type == OP_SAY
+ ? TIED_METHOD_SAY : 0)), sp - mark);
}
if (!io) {
if ( gv && GvEGVx(gv) && (io = GvIO(GvEGV(gv)))
if (is_pp_rv2av) {
AV *const av = MUTABLE_AV(sv);
- /* The guts of pp_rv2av, with no intenting change to preserve history
+ /* The guts of pp_rv2av, with no intending change to preserve history
(until such time as we get tools that can do blame annotation across
whitespace changes. */
- if (gimme == G_ARRAY) {
- const I32 maxarg = AvFILL(av) + 1;
- (void)POPs; /* XXXX May be optimized away? */
- EXTEND(SP, maxarg);
- if (SvRMAGICAL(av)) {
- U32 i;
- for (i=0; i < (U32)maxarg; i++) {
- SV ** const svp = av_fetch(av, i, FALSE);
- /* See note in pp_helem, and bug id #27839 */
- SP[i+1] = svp
- ? SvGMAGICAL(*svp) ? (mg_get(*svp), *svp) : *svp
- : &PL_sv_undef;
+ if (gimme == G_ARRAY) {
+ const I32 maxarg = AvFILL(av) + 1;
+ (void)POPs; /* XXXX May be optimized away? */
+ EXTEND(SP, maxarg);
+ if (SvRMAGICAL(av)) {
+ U32 i;
+ for (i=0; i < (U32)maxarg; i++) {
+ SV ** const svp = av_fetch(av, i, FALSE);
+ /* See note in pp_helem, and bug id #27839 */
+ SP[i+1] = svp
+ ? SvGMAGICAL(*svp) ? (mg_get(*svp), *svp) : *svp
+ : &PL_sv_undef;
+ }
+ }
+ else {
+ Copy(AvARRAY(av), SP+1, maxarg, SV*);
}
+ SP += maxarg;
}
- else {
- Copy(AvARRAY(av), SP+1, maxarg, SV*);
+ else if (gimme == G_SCALAR) {
+ dTARGET;
+ const I32 maxarg = AvFILL(av) + 1;
+ SETi(maxarg);
}
- SP += maxarg;
- }
- else if (gimme == G_SCALAR) {
- dTARGET;
- const I32 maxarg = AvFILL(av) + 1;
- SETi(maxarg);
- }
} else {
/* The guts of pp_rv2hv */
- if (gimme == G_ARRAY) { /* array wanted */
- *PL_stack_sp = sv;
- return do_kv();
- }
- else if (gimme == G_SCALAR) {
- dTARGET;
- TARG = Perl_hv_scalar(aTHX_ MUTABLE_HV(sv));
- SPAGAIN;
- SETTARG;
- }
+ if (gimme == G_ARRAY) { /* array wanted */
+ *PL_stack_sp = sv;
+ return Perl_do_kv(aTHX);
+ }
+ else if (gimme == G_SCALAR) {
+ dTARGET;
+ TARG = Perl_hv_scalar(aTHX_ MUTABLE_HV(sv));
+ SPAGAIN;
+ SETTARG;
+ }
}
RETURN;
const I32 gimme = GIMME_V;
if (io) {
- MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+ const MAGIC *const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
if (mg) {
- PUSHMARK(SP);
- XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
- PUTBACK;
- ENTER_with_name("call_READLINE");
- call_method("READLINE", gimme);
- LEAVE_with_name("call_READLINE");
- SPAGAIN;
+ Perl_tied_method(aTHX_ "READLINE", SP, MUTABLE_SV(io), mg, gimme, 0);
if (gimme == G_SCALAR) {
- SV* const result = POPs;
- SvSetSV_nosteal(TARG, result);
- PUSHTARG;
+ SPAGAIN;
+ SvSetSV_nosteal(TARG, TOPs);
+ SETTARG;
}
- RETURN;
+ return NORMAL;
}
}
fp = NULL;
s = CALLREG_INTUIT_START(rx, TARG, s, strend, r_flags, NULL);
if (!s)
- goto nope;
+ goto ret_no;
/* How to do it in subst? */
/* if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
&& !PL_sawampersand
* http://www.nntp.perl.org/group/perl.perl5.porters/2010/04/msg158809.html
*/
if (matched && DO_UTF8(dstr) && ! DO_UTF8(TARG)) {
- const STRLEN new_len = sv_utf8_upgrade(TARG);
+ char * const orig_pvx = SvPVX(TARG);
+ const STRLEN new_len = sv_utf8_upgrade_nomg(TARG);
/* If the lengths are the same, the pattern contains only
* invariants, can keep going; otherwise, various internal markers
* could be off, so redo */
- if (new_len != len) {
+ if (new_len != len || orig_pvx != SvPVX(TARG)) {
goto setup_match;
}
}
doutf8 = FALSE;
}
+ if (!matched) {
+ ret_no:
+ SPAGAIN;
+ PUSHs(rpm->op_pmflags & PMf_NONDESTRUCT ? TARG : &PL_sv_no);
+ LEAVE_SCOPE(oldsave);
+ RETURN;
+ }
+
/* can do inplace substitution? */
if (c
#ifdef PERL_OLD_COPY_ON_WRITE
#endif
&& (I32)clen <= RX_MINLENRET(rx) && (once || !(r_flags & REXEC_COPY_STR))
&& !(RX_EXTFLAGS(rx) & RXf_LOOKBEHIND_SEEN)
- && (!doutf8 || SvUTF8(TARG))) {
- if (!matched)
- {
- SPAGAIN;
- if (rpm->op_pmflags & PMf_NONDESTRUCT)
- PUSHs(TARG);
- else
- PUSHs(&PL_sv_no);
- LEAVE_SCOPE(oldsave);
- RETURN;
- }
+ && (!doutf8 || SvUTF8(TARG)))
+ {
+
#ifdef PERL_OLD_COPY_ON_WRITE
if (SvIsCOW(TARG)) {
assert (!force_on_match);
}
TAINT_IF(rxtainted & 1);
SPAGAIN;
- if (rpm->op_pmflags & PMf_NONDESTRUCT)
- PUSHs(TARG);
- else
- PUSHs(&PL_sv_yes);
+ PUSHs(rpm->op_pmflags & PMf_NONDESTRUCT ? TARG : &PL_sv_yes);
}
else {
do {
else
mPUSHi((I32)iters);
}
- (void)SvPOK_only_UTF8(TARG);
- TAINT_IF(rxtainted);
- if (SvSMAGICAL(TARG)) {
- PUTBACK;
- mg_set(TARG);
- SPAGAIN;
- }
- SvTAINT(TARG);
- if (doutf8)
- SvUTF8_on(TARG);
- LEAVE_SCOPE(oldsave);
- RETURN;
}
-
- if (matched)
- {
+ else {
if (force_on_match) {
force_on_match = 0;
s = SvPV_force(TARG, len);
PUSHs(TARG);
else
mPUSHi((I32)iters);
-
- (void)SvPOK_only(TARG);
- if (doutf8)
- SvUTF8_on(TARG);
- TAINT_IF(rxtainted);
- SvSETMAGIC(TARG);
- SvTAINT(TARG);
- LEAVE_SCOPE(oldsave);
- RETURN;
}
- goto ret_no;
-
-nope:
-ret_no:
- SPAGAIN;
- if (rpm->op_pmflags & PMf_NONDESTRUCT)
- PUSHs(TARG);
- else
- PUSHs(&PL_sv_no);
+ (void)SvPOK_only_UTF8(TARG);
+ if (doutf8)
+ SvUTF8_on(TARG);
+ TAINT_IF(rxtainted);
+ SvSETMAGIC(TARG);
+ SvTAINT(TARG);
LEAVE_SCOPE(oldsave);
RETURN;
}
https://perl5.git.perl.org / perl5.git / blobdiff