}
gimme = GIMME_V;
if (gimme == G_ARRAY) {
- RETURNOP(do_kv());
+ RETURNOP(Perl_do_kv(aTHX));
}
else if (gimme == G_SCALAR) {
SV* const sv = Perl_hv_scalar(aTHX_ MUTABLE_HV(TARG));
Perl_die(aTHX_ PL_no_usym, what);
}
if (!SvOK(sv)) {
- if (PL_op->op_flags & OPf_REF)
+ if (
+ PL_op->op_flags & OPf_REF &&
+ PL_op->op_next->op_type != OP_BOOLKEYS
+ )
Perl_die(aTHX_ PL_no_usym, what);
if (ckWARN(WARN_UNINITIALIZED))
report_uninit(sv);
gp_free(MUTABLE_GV(sv));
Newxz(gp, 1, GP);
- GvGP(sv) = gp_ref(gp);
+ GvGP_set(sv, gp_ref(gp));
GvSV(sv) = newSV(0);
GvLINE(sv) = CopLINE(PL_curcop);
GvEGV(sv) = MUTABLE_GV(sv);
warning before dieing, hence this test goes here.
If it were immediately before the second SvIV_please, then
DIE() would be invoked before left was even inspected, so
- no inpsection would give no warning. */
+ no inspection would give no warning. */
if (right == 0)
DIE(aTHX_ "Illegal division by zero");
}
}
SPAGAIN;
- PUSHs(TARG); /* avoid SvSETMAGIC here */
+ SvSETMAGIC(TARG);
+ PUSHs(TARG);
RETURN;
bound_fail:
/* Generally UTF-8 and UTF-EBCDIC are indistinguishable at this level. So
* most comments below say UTF-8, when in fact they mean UTF-EBCDIC as well */
-/* Both the characters below can be stored in two UTF-8 bytes. In UTF-8 the max
- * character that 2 bytes can hold is U+07FF, and in UTF-EBCDIC it is U+03FF.
- * See http://www.unicode.org/unicode/reports/tr16 */
-#define LATIN_CAPITAL_LETTER_Y_WITH_DIAERESIS 0x0178 /* Also is title case */
-#define GREEK_CAPITAL_LETTER_MU 0x039C /* Upper and title case of MICRON */
-
/* Below are several macros that generate code */
/* Generates code to store a unicode codepoint c that is known to occupy
* exactly two UTF-8 and UTF-EBCDIC bytes; it is stored into p and p+1. */
if (AvREAL(ary)) {
EXTEND_MORTAL(length);
for (i = length, dst = MARK; i; i--) {
- sv_2mortal(*dst); /* free them eventualy */
+ sv_2mortal(*dst); /* free them eventually */
dst++;
}
}
if (AvREAL(ary)) {
EXTEND_MORTAL(length);
for (i = length, dst = MARK; i; i--) {
- sv_2mortal(*dst); /* free them eventualy */
+ sv_2mortal(*dst); /* free them eventually */
dst++;
}
}
DIE(aTHX_ "panic: pp_split");
rx = PM_GETRE(pm);
- TAINT_IF((RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) &&
+ TAINT_IF(get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET &&
(RX_EXTFLAGS(rx) & (RXf_WHITE | RXf_SKIPWHITE)));
RX_MATCH_UTF8_set(rx, do_utf8);
while (*s == ' ' || is_utf8_space((U8*)s))
s += UTF8SKIP(s);
}
- else if (RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) {
+ else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
while (isSPACE_LC(*s))
s++;
}
s++;
}
}
- if (RX_EXTFLAGS(rx) & PMf_MULTILINE) {
+ if (RX_EXTFLAGS(rx) & RXf_PMf_MULTILINE) {
multiline = 1;
}
else
m += t;
}
- } else if (RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) {
+ }
+ else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
while (m < strend && !isSPACE_LC(*m))
++m;
} else {
if (do_utf8) {
while (s < strend && ( *s == ' ' || is_utf8_space((U8*)s) ))
s += UTF8SKIP(s);
- } else if (RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) {
+ }
+ else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
while (s < strend && isSPACE_LC(*s))
++s;
} else {
NULL doesn't generate a useful error message. "custom" does. */
const char *const name = op_type >= OP_max
? "[out of range]" : PL_op_name[PL_op->op_type];
+ if(OP_IS_SOCKET(op_type))
+ DIE(aTHX_ PL_no_sock_func, name);
DIE(aTHX_ "panic: unimplemented op %s (#%d) called", name, op_type);
}
dSP;
HV * const hv = (HV*)POPs;
+ if (SvTYPE(hv) != SVt_PVHV) { XPUSHs(&PL_sv_no); RETURN; }
+
if (SvRMAGICAL(hv)) {
MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied);
if (mg) {