if (sv) {
MAGIC *mg;
- assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
-
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
if (mg->mg_type == type && (!flags || mg->mg_virtual == vtbl)) {
return mg;
* case we should turn on that flag. This didn't use to happen, and to
* avoid as many possible backward compatibility issues as possible, we
* don't turn on the flag unless we have to. So the flag stays off for
- * an entirely ASCII string. We assume that if the string looks like
- * UTF-8, it really is UTF-8: "text in any other encoding that uses
- * bytes with the high bit set is extremely unlikely to pass a UTF-8
- * validity test" (http://en.wikipedia.org/wiki/Charset_detection).
- * There is a potential that we will get it wrong however, especially
- * on short error message text. (If it turns out to be necessary, we
- * could also keep track if the current LC_MESSAGES locale is UTF-8) */
+ * an entirely invariant string. We assume that if the string looks
+ * like UTF-8, it really is UTF-8: "text in any other encoding that
+ * uses bytes with the high bit set is extremely unlikely to pass a
+ * UTF-8 validity test"
+ * (http://en.wikipedia.org/wiki/Charset_detection). There is a
+ * potential that we will get it wrong however, especially on short
+ * error message text. (If it turns out to be necessary, we could also
+ * keep track if the current LC_MESSAGES locale is UTF-8) */
if (! IN_BYTES /* respect 'use bytes' */
- && ! is_ascii_string((U8*) SvPVX_const(sv), SvCUR(sv))
+ && ! is_invariant_string((U8*) SvPVX_const(sv), SvCUR(sv))
&& is_utf8_string((U8*) SvPVX_const(sv), SvCUR(sv)))
{
SvUTF8_on(sv);
* it, so we put the object into the global, and put a simple boolean into
* the hints hash giving whether the global is valid or not */
+ dVAR;
SV *is_encoding;
if (PL_encoding) {
break;
case '\005': /* ^E */
if (nextchar != '\0') {
- /* We shouldn't be trying to retrieve this shadow variable */
- assert(strNE(remaining, "_NCODING"));
-
if (strEQ(remaining, "NCODING"))
sv_setsv(sv, _get_encoding());
+ else if (strEQ(remaining, "_NCODING"))
+ sv_setsv(sv, NULL);
break;
}
sv_setiv(sv, (IV)IoPAGE(GvIOp(PL_defoutgv)));
break;
case ':':
- break;
case '/':
break;
case '[':
#else
dTHX;
#endif
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
#if defined(__cplusplus) && defined(__GNUC__)
/* g++ doesn't support PERL_UNUSED_DECL, so the sip and uap
* parameters would be warned about. */
PERL_UNUSED_ARG(sip);
PERL_UNUSED_ARG(uap);
#endif
+#endif
#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
(void) rsignal(sig, PL_csighandlerp);
if (PL_sig_ignoring[sig]) return;
if (flags & G_WRITING_TO_STDERR) {
SAVETMPS;
+ save_re_context();
SAVESPTR(PL_stderrgv);
PL_stderrgv = NULL;
}
SvREFCNT_inc_simple_NN(SvRV(sv)));
break;
case SVt_PVHV:
- hv_store_ent((HV *)mg->mg_obj, (SV *)mg->mg_ptr,
- SvREFCNT_inc_simple_NN(SvRV(sv)), 0);
+ (void)hv_store_ent((HV *)mg->mg_obj, (SV *)mg->mg_ptr,
+ SvREFCNT_inc_simple_NN(SvRV(sv)), 0);
}
if (mg->mg_flags & MGf_PERSIST)
NOOP; /* This sv is in use as an iterator var and will be reused,
/* It may be the shadow variable ${E_NCODING} which has lexical
* scope. See comments at Perl__get_encoding in this file */
if (*(mg->mg_ptr + 1) == '_') {
+ if (CopSTASH(PL_curcop) != get_hv("encoding::",0))
+ Perl_croak_no_modify();
lex = TRUE;
offset++;
}
}
}
else { /* Use the regular global */
- SvREFCNT_dec(PL_encoding);
- if (SvOK(sv) || SvGMAGICAL(sv)) {
- PL_encoding = newSVsv(sv);
- }
- else {
- PL_encoding = NULL;
- }
- }
+ SvREFCNT_dec(PL_encoding);
+ if (SvOK(sv) || SvGMAGICAL(sv)) {
+ if (PL_localizing != 2) {
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
+ "Setting ${^ENCODING} is deprecated");
+ }
+ PL_encoding = newSVsv(sv);
+ }
+ else {
+ PL_encoding = NULL;
+ }
+ }
}
}
break;
);
}
} else {
+ sv_setsv(sv, PL_rs);
/* diag_listed_as: Setting $/ to %s reference is forbidden */
Perl_croak(aTHX_ "Setting $/ to a%s %s reference is forbidden",
*reftype == 'A' ? "n" : "", reftype);
}
case ')':
{
+/* (hv) best guess: maybe we'll need configure probes to do a better job,
+ * but you can override it if you need to.
+ */
+#ifndef INVALID_GID
+#define INVALID_GID ((Gid_t)-1)
+#endif
/* XXX $) currently silently ignores failures */
Gid_t new_egid;
#ifdef HAS_SETGROUPS
const char *p = SvPV_const(sv, len);
Groups_t *gary = NULL;
const char* endptr;
+ UV uv;
#ifdef _SC_NGROUPS_MAX
int maxgrp = sysconf(_SC_NGROUPS_MAX);
while (isSPACE(*p))
++p;
- new_egid = (Gid_t)grok_atou(p, &endptr);
+ if (grok_atoUV(p, &uv, &endptr))
+ new_egid = (Gid_t)uv;
+ else {
+ new_egid = INVALID_GID;
+ endptr = NULL;
+ }
for (i = 0; i < maxgrp; ++i) {
if (endptr == NULL)
break;
Newx(gary, i + 1, Groups_t);
else
Renew(gary, i + 1, Groups_t);
- gary[i] = (Groups_t)grok_atou(p, &endptr);
+ if (grok_atoUV(p, &uv, &endptr))
+ gary[i] = (Groups_t)uv;
+ else {
+ gary[i] = INVALID_GID;
+ endptr = NULL;
+ }
}
if (i)
PERL_UNUSED_RESULT(setgroups(i, gary));
if (hek)
Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL),
"SIG%s handler \"%"HEKf"\" not defined.\n",
- PL_sig_name[sig], hek);
+ PL_sig_name[sig], HEKfARG(hek));
/* diag_listed_as: SIG%s handler "%s" not defined */
else Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL),
"SIG%s handler \"__ANON__\" not defined.\n",
}
}
-cleanup:
+ cleanup:
/* pop any of SAVEFREESV, SAVEDESTRUCTOR_X and "save in progress" */
PL_savestack_ix = old_ss_ix;
if (flags & 8)
}
/*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
* ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff