XPVMG *any;
if (!PL_dirty)
- return sv_2mortal(newSVpvs(""));
+ return newSVpvs_flags("", SVs_TEMP);
if (PL_mess_sv)
return PL_mess_sv;
PUSHMARK(SP);
EXTEND(SP,2);
PUSHs(SvTIED_obj((SV*)io, mg));
- PUSHs(sv_2mortal(newSVpvn(message, msglen)));
+ mPUSHp(message, msglen);
PUTBACK;
call_method("PRINT", G_SCALAR);
*hook = NULL;
}
if (warn || message) {
- msg = newSVpvn(message, msglen);
- SvFLAGS(msg) |= utf8;
+ msg = newSVpvn_flags(message, msglen, utf8);
SvREADONLY_on(msg);
SAVEFREESV(msg);
}
return PerlIO_fdopen(p[This], mode);
#else
# ifdef OS2 /* Same, without fork()ing and all extra overhead... */
- return my_syspopen4(aTHX_ Nullch, mode, n, args);
+ return my_syspopen4(aTHX_ NULL, mode, n, args);
# else
Perl_croak(aTHX_ "List form of piped open not implemented");
return (PerlIO *) NULL;
SV * const hv = newSVrv(rv, "version"); /* create an SV and upgrade the RV */
(void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
-#ifndef NODEFAULT_SHAREKEYS
- HvSHAREKEYS_on(hv); /* key-sharing on by default */
-#endif
-
while (isSPACE(*s)) /* leading whitespace is OK */
s++;
/* This will get reblessed later if a derived class*/
SV * const hv = newSVrv(rv, "version");
(void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
-#ifndef NODEFAULT_SHAREKEYS
- HvSHAREKEYS_on(hv); /* key-sharing on by default */
-#endif
if ( SvROK(ver) )
ver = SvRV(ver);
PERL_UNUSED_ARG(sv);
}
+/*
+
+=for apidoc sv_destroyable
+
+Dummy routine which reports that object can be destroyed when there is no
+sharing module present. It ignores its single SV argument, and returns
+'true'. Exists to avoid test for a NULL function pointer and because it
+could potentially warn under some level of strict-ness.
+
+=cut
+*/
+
+bool
+Perl_sv_destroyable(pTHX_ SV *sv)
+{
+ PERL_UNUSED_CONTEXT;
+ PERL_UNUSED_ARG(sv);
+ return TRUE;
+}
+
U32
Perl_parse_unicode_opts(pTHX_ const char **popt)
{
REGEXP *
Perl_get_re_arg(pTHX_ SV *sv) {
SV *tmpsv;
- MAGIC *mg;
if (sv) {
if (SvMAGICAL(sv))
mg_get(sv);
if (SvROK(sv) &&
(tmpsv = (SV*)SvRV(sv)) && /* assign deliberate */
- SvTYPE(tmpsv) == SVt_PVMG &&
- (mg = mg_find(tmpsv, PERL_MAGIC_qr))) /* assign deliberate */
+ SvTYPE(tmpsv) == SVt_REGEXP)
{
- return (REGEXP *)mg->mg_obj;
+ return tmpsv;
}
}