/* pp.c
*
- * Copyright (c) 1991-1999, Larry Wall
+ * Copyright (c) 1991-2000, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
SV *ssv = POPs;
STRLEN len;
char *ptr = SvPV(ssv,len);
- if (ckWARN(WARN_UNSAFE) && len == 0)
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_MISC) && len == 0)
+ Perl_warner(aTHX_ WARN_MISC,
"Explicit blessing to '' (assuming package main)");
stash = gv_stashpvn(ptr, len, TRUE);
}
hv_undef((HV*)sv);
break;
case SVt_PVCV:
- if (ckWARN(WARN_UNSAFE) && cv_const_sv((CV*)sv))
- Perl_warner(aTHX_ WARN_UNSAFE, "Constant subroutine %s undefined",
+ if (ckWARN(WARN_MISC) && cv_const_sv((CV*)sv))
+ Perl_warner(aTHX_ WARN_MISC, "Constant subroutine %s undefined",
CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
/* FALL THROUGH */
case SVt_PVFM:
rem -= pos;
}
if (fail < 0) {
- if (ckWARN(WARN_SUBSTR) || lvalue || repl)
+ if (lvalue || repl)
+ Perl_croak(aTHX_ "substr outside of string");
+ if (ckWARN(WARN_SUBSTR))
Perl_warner(aTHX_ WARN_SUBSTR, "substr outside of string");
RETPUSHUNDEF;
}
char *tmps;
U32 value = POPu;
- SvUTF8_off(TARG); /* decontaminate */
(void)SvUPGRADE(TARG,SVt_PV);
- if (value >= 128 && !IN_BYTE) {
- SvGROW(TARG,8);
+ if (value > 255 && !IN_BYTE) {
+ SvGROW(TARG, UTF8_MAXLEN+1);
tmps = SvPVX(TARG);
tmps = (char*)uv_to_utf8((U8*)tmps, (UV)value);
SvCUR_set(TARG, tmps - SvPVX(TARG));
*tmps = '\0';
- SvUTF8_on(TARG);
(void)SvPOK_only(TARG);
+ SvUTF8_on(TARG);
XPUSHs(TARG);
RETURN;
}
tmps = SvPVX(TARG);
*tmps++ = value;
*tmps = '\0';
+ SvUTF8_off(TARG); /* decontaminate */
(void)SvPOK_only(TARG);
XPUSHs(TARG);
RETURN;
SV *val = NEWSV(46, 0);
if (MARK < SP)
sv_setsv(val, *++MARK);
- else if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Odd number of elements in hash assignment");
+ else if (ckWARN(WARN_MISC))
+ Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in hash assignment");
(void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
default:
DIE(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
- if (commas++ == 0 && ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (commas++ == 0 && ckWARN(WARN_UNPACK))
+ Perl_warner(aTHX_ WARN_UNPACK,
"Invalid type in unpack: '%c'", (int)datumtype);
break;
case '%':
default:
DIE(aTHX_ "Invalid type in pack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
- if (commas++ == 0 && ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (commas++ == 0 && ckWARN(WARN_PACK))
+ Perl_warner(aTHX_ WARN_PACK,
"Invalid type in pack: '%c'", (int)datumtype);
break;
case '%':
* of pack() (and all copies of the result) are
* gone.
*/
- if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr)
+ if (ckWARN(WARN_PACK) && (SvTEMP(fromstr)
|| (SvPADTMP(fromstr)
&& !SvREADONLY(fromstr))))
{
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_PACK,
"Attempt to pack pointer to temporary value");
}
if (SvPOK(fromstr) || SvNIOK(fromstr))