PUTBACK;
{
- const int mode = mode_from_discipline(discp);
- const char *const d = (discp ? SvPV_nolen_const(discp) : NULL);
+ STRLEN len = 0;
+ const char *d = NULL;
+ int mode;
+ if (discp)
+ d = SvPV_const(discp, len);
+ mode = mode_from_discipline(d, len);
if (PerlIO_binmode(aTHX_ fp, IoTYPE(io), mode, d)) {
if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
if (!PerlIO_binmode(aTHX_ IoOFP(io), IoTYPE(io), mode, d)) {
break;
}
items = SP - MARK++;
- if (sv_isobject(*MARK)) {
+ if (sv_isobject(*MARK)) { /* Calls GET magic. */
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
/* 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);
PUTBACK;
require_pv("AnyDBM_File.pm");
SPAGAIN;
- if (!(gv = gv_fetchmethod(stash, "TIEHASH")))
+ if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")))
DIE(aTHX_ "No dbm on this machine");
}
register PERL_CONTEXT *cx;
const I32 gimme = GIMME_V;
+ PERL_ARGS_ASSERT_DOFORM;
+
ENTER;
SAVETMPS;
PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
- PUSHFORMAT(cx);
- cx->blk_sub.retop = retop;
+ PUSHFORMAT(cx, retop);
SAVECOMPPAD();
PAD_SET_CUR_NOSAVE(CvPADLIST(cv), 1);
PP(pp_leavewrite)
{
dVAR; dSP;
- GV * const gv = cxstack[cxstack_ix].blk_sub.gv;
+ GV * const gv = cxstack[cxstack_ix].blk_format.gv;
register IO * const io = GvIOp(gv);
PerlIO *ofp;
PerlIO *fp;
effective = TRUE;
break;
-
case OP_FTEEXEC:
#ifdef PERL_EFF_ACCESS
- access_mode = W_OK;
+ access_mode = X_OK;
#else
use_access = 0;
#endif
int anum = 1;
Size_t size = strlen(cmd) + (strlen(filename) * 2) + 10;
+ PERL_ARGS_ASSERT_DOONELINER;
+
Newx(cmdline, size, char);
my_strlcpy(cmdline, cmd, size);
my_strlcat(cmdline, " ", size);
result = 0;
if (PL_op->op_flags & OPf_STACKED) {
SV * const really = *++MARK;
-# if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__)
+# if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__) || defined(__VMS)
value = (I32)do_aspawn(really, MARK, SP);
# else
value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
# endif
}
else if (SP - MARK != 1) {
-# if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__)
+# if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__) || defined(__VMS)
value = (I32)do_aspawn(NULL, MARK, SP);
# else
value = (I32)do_aspawn(NULL, (void **)MARK, (void **)SP);
{
SV *target;
+ PERL_ARGS_ASSERT_SPACE_JOIN_NAMES_MORTAL;
+
if (array && *array) {
target = newSVpvs_flags("", SVs_TEMP);
while (1) {
}
#else
if (hent->h_addr)
- PUSHs(newSVpvn(hent->h_addr, len));
+ mPUSHp(hent->h_addr, len);
else
PUSHs(sv_mortalcopy(&PL_sv_no));
#endif /* h_addr */
{
#ifdef HAS_SETNETENT
dVAR; dSP;
- PerlSock_setnetent(TOPi);
+ (void)PerlSock_setnetent(TOPi);
RETSETYES;
#else
DIE(aTHX_ PL_no_sock_func, "setnetent");
{
#ifdef HAS_SETPROTOENT
dVAR; dSP;
- PerlSock_setprotoent(TOPi);
+ (void)PerlSock_setprotoent(TOPi);
RETSETYES;
#else
DIE(aTHX_ PL_no_sock_func, "setprotoent");
{
#ifdef HAS_SETSERVENT
dVAR; dSP;
- PerlSock_setservent(TOPi);
+ (void)PerlSock_setservent(TOPi);
RETSETYES;
#else
DIE(aTHX_ PL_no_sock_func, "setservent");