if (PL_op->op_flags & OPf_REF ||
PL_op->op_private & HINT_STRICT_REFS)
DIE(no_usym, "a symbol");
- if (PL_dowarn)
- warn(warn_uninit);
+ if (ckWARN(WARN_UNINITIALIZED))
+ warner(WARN_UNINITIALIZED, warn_uninit);
RETSETUNDEF;
}
sym = SvPV(sv, PL_na);
if (PL_op->op_flags & OPf_REF ||
PL_op->op_private & HINT_STRICT_REFS)
DIE(no_usym, "a SCALAR");
- if (PL_dowarn)
- warn(warn_uninit);
+ if (ckWARN(WARN_UNINITIALIZED))
+ warner(WARN_UNINITIALIZED, warn_uninit);
RETSETUNDEF;
}
sym = SvPV(sv, PL_na);
SV *ssv = POPs;
STRLEN len;
char *ptr = SvPV(ssv,len);
- if (PL_dowarn && len == 0)
- warn("Explicit blessing to '' (assuming package main)");
+ if (ckWARN(WARN_UNSAFE) && len == 0)
+ warner(WARN_UNSAFE,
+ "Explicit blessing to '' (assuming package main)");
stash = gv_stashpvn(ptr, len, TRUE);
}
hv_undef((HV*)sv);
break;
case SVt_PVCV:
- if (PL_dowarn && cv_const_sv((CV*)sv))
- warn("Constant subroutine %s undefined",
+ if (ckWARN(WARN_UNSAFE) && cv_const_sv((CV*)sv))
+ warner(WARN_UNSAFE, "Constant subroutine %s undefined",
CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
/* FALL THROUGH */
case SVt_PVFM:
else
curlen = utfcurlen;
}
+ else
+ utfcurlen = 0;
if (pos >= arybase) {
pos -= arybase;
rem -= pos;
}
if (fail < 0) {
- if (PL_dowarn || lvalue || repl)
- warn("substr outside of string");
+ if (ckWARN(WARN_SUBSTR) || lvalue || repl)
+ warner(WARN_SUBSTR, "substr outside of string");
RETPUSHUNDEF;
}
else {
if (!SvGMAGICAL(sv)) {
if (SvROK(sv)) {
SvPV_force(sv,PL_na);
- if (PL_dowarn)
- warn("Attempt to use reference as lvalue in substr");
+ if (ckWARN(WARN_SUBSTR))
+ warner(WARN_SUBSTR,
+ "Attempt to use reference as lvalue in substr");
}
if (SvOK(sv)) /* is it defined ? */
(void)SvPOK_only(sv);
U8 *send;
s = SvPV(sv,len);
- if (!len)
+ if (!len) {
+ sv_setpvn(TARG, "", 0);
+ SETs(TARG);
RETURN;
+ }
(void)SvUPGRADE(TARG, SVt_PV);
SvGROW(TARG, (len * 2) + 1);
U8 *send;
s = SvPV(sv,len);
- if (!len)
+ if (!len) {
+ sv_setpvn(TARG, "", 0);
+ SETs(TARG);
RETURN;
+ }
(void)SvUPGRADE(TARG, SVt_PV);
SvGROW(TARG, (len * 2) + 1);
SV *val = NEWSV(46, 0);
if (MARK < SP)
sv_setsv(val, *++MARK);
- else if (PL_dowarn)
- warn("Odd number of elements in hash assignment");
+ else if (ckWARN(WARN_UNSAFE))
+ warner(WARN_UNSAFE, "Odd number of elements in hash assignment");
(void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
/* Explosives and implosives. */
+static const char uuemap[] =
+ "`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_";
+static char uudmap[256]; /* Initialised on first use */
+#if 'I' == 73 && 'J' == 74
+/* On an ASCII/ISO kind of system */
+#define ISUUCHAR(ch) ((ch) >= ' ' && (ch) < 'a')
+#else
+/*
+ Some other sort of character set - use memchr() so we don't match
+ the null byte.
+ */
+#define ISUUCHAR(ch) (memchr(uuemap, (ch), sizeof(uuemap)-1) || (ch) == ' ')
+#endif
+
PP(pp_unpack)
{
djSP;
default:
croak("Invalid type in unpack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
- if (commas++ == 0 && PL_dowarn)
- warn("Invalid type in unpack: '%c'", (int)datumtype);
+ if (commas++ == 0 && ckWARN(WARN_UNSAFE))
+ warner(WARN_UNSAFE, "Invalid type in unpack: '%c'", (int)datumtype);
break;
case '%':
if (len == 1 && pat[-1] != '1')
}
break;
case 'u':
+ /* MKS:
+ * Initialise the decode mapping. By using a table driven
+ * algorithm, the code will be character-set independent
+ * (and just as fast as doing character arithmetic)
+ */
+ if (uudmap['M'] == 0) {
+ int i;
+
+ for (i = 0; i < sizeof(uuemap); i += 1)
+ uudmap[uuemap[i]] = i;
+ /*
+ * Because ' ' and '`' map to the same value,
+ * we need to decode them both the same.
+ */
+ uudmap[' '] = 0;
+ }
+
along = (strend - s) * 3 / 4;
sv = NEWSV(42, along);
if (along)
SvPOK_on(sv);
- while (s < strend && *s > ' ' && *s < 'a') {
+ while (s < strend && *s > ' ' && ISUUCHAR(*s)) {
I32 a, b, c, d;
char hunk[4];
hunk[3] = '\0';
len = (*s++ - ' ') & 077;
while (len > 0) {
- if (s < strend && *s >= ' ')
- a = (*s++ - ' ') & 077;
- else
- a = 0;
- if (s < strend && *s >= ' ')
- b = (*s++ - ' ') & 077;
- else
- b = 0;
- if (s < strend && *s >= ' ')
- c = (*s++ - ' ') & 077;
- else
- c = 0;
- if (s < strend && *s >= ' ')
- d = (*s++ - ' ') & 077;
+ if (s < strend && ISUUCHAR(*s))
+ a = uudmap[*s++] & 077;
+ else
+ a = 0;
+ if (s < strend && ISUUCHAR(*s))
+ b = uudmap[*s++] & 077;
+ else
+ b = 0;
+ if (s < strend && ISUUCHAR(*s))
+ c = uudmap[*s++] & 077;
+ else
+ c = 0;
+ if (s < strend && ISUUCHAR(*s))
+ d = uudmap[*s++] & 077;
else
d = 0;
hunk[0] = (a << 2) | (b >> 4);
{
char hunk[5];
- *hunk = len + ' ';
+ *hunk = uuemap[len];
sv_catpvn(sv, hunk, 1);
hunk[4] = '\0';
- while (len > 0) {
- hunk[0] = ' ' + (077 & (*s >> 2));
- hunk[1] = ' ' + (077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017)));
- hunk[2] = ' ' + (077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)));
- hunk[3] = ' ' + (077 & (s[2] & 077));
+ while (len > 2) {
+ hunk[0] = uuemap[(077 & (*s >> 2))];
+ hunk[1] = uuemap[(077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017)))];
+ hunk[2] = uuemap[(077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)))];
+ hunk[3] = uuemap[(077 & (s[2] & 077))];
sv_catpvn(sv, hunk, 4);
s += 3;
len -= 3;
}
- for (s = SvPVX(sv); *s; s++) {
- if (*s == ' ')
- *s = '`';
+ if (len > 0) {
+ char r = (len > 1 ? s[1] : '\0');
+ hunk[0] = uuemap[(077 & (*s >> 2))];
+ hunk[1] = uuemap[(077 & (((*s << 4) & 060) | ((r >> 4) & 017)))];
+ hunk[2] = uuemap[(077 & ((r << 2) & 074))];
+ hunk[3] = uuemap[0];
+ sv_catpvn(sv, hunk, 4);
}
sv_catpvn(sv, "\n", 1);
}
default:
croak("Invalid type in pack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
- if (commas++ == 0 && PL_dowarn)
- warn("Invalid type in pack: '%c'", (int)datumtype);
+ if (commas++ == 0 && ckWARN(WARN_UNSAFE))
+ warner(WARN_UNSAFE, "Invalid type in pack: '%c'", (int)datumtype);
break;
case '%':
DIE("%% may only be used in unpack");
* of pack() (and all copies of the result) are
* gone.
*/
- if (PL_dowarn && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
- warn("Attempt to pack pointer to temporary value");
+ if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
+ warner(WARN_UNSAFE,
+ "Attempt to pack pointer to temporary value");
if (SvPOK(fromstr) || SvNIOK(fromstr))
aptr = SvPV(fromstr,PL_na);
else
croak("panic: unlock_condpair unlocking mutex that we don't own");
MgOWNER(mg) = 0;
COND_SIGNAL(MgOWNERCONDP(mg));
- DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n",
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n",
(unsigned long)thr, (unsigned long)svv);)
MUTEX_UNLOCK(MgMUTEXP(mg));
}
while (MgOWNER(mg))
COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
MgOWNER(mg) = thr;
- DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
(unsigned long)thr, (unsigned long)sv);)
MUTEX_UNLOCK(MgMUTEXP(mg));
SvREFCNT_inc(sv); /* keep alive until magic_mutexfree */
projects / p5sagit/p5-mst-13.2.git / blobdiff