Perl_croak(aTHX_ "%s not allowed in length fields", buf);
case ',': /* grandfather in commas but with a warning */
if (commas++ == 0 && ckWARN(WARN_UNPACK))
- Perl_warner(aTHX_ WARN_UNPACK,
+ Perl_warner(aTHX_ packWARN(WARN_UNPACK),
"Invalid type in unpack: '%c'", (int)datumtype);
/* FALL THROUGH */
case '%':
Perl_croak(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
if (commas++ == 0 && ckWARN(WARN_UNPACK))
- Perl_warner(aTHX_ WARN_UNPACK,
+ Perl_warner(aTHX_ packWARN(WARN_UNPACK),
"Invalid type in unpack: '%c'", (int)datumtype);
break;
case '%':
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
if (checksum) {
while (len-- > 0 && s < strend) {
STRLEN alen;
- auint = NATIVE_TO_UNI(utf8n_to_uvchr((U8*)s, strend - s, &alen, 0));
+ auint = NATIVE_TO_UNI(utf8n_to_uvchr((U8*)s, strend - s, &alen, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANYUV));
along = alen;
s += along;
if (checksum > bits_in_uv)
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0 && s < strend) {
STRLEN alen;
- auint = NATIVE_TO_UNI(utf8n_to_uvchr((U8*)s, strend - s, &alen, 0));
+ auint = NATIVE_TO_UNI(utf8n_to_uvchr((U8*)s, strend - s, &alen, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANYUV));
along = alen;
s += along;
sv = NEWSV(37, 0);
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
#if SHORTSIZE != SIZE16
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
#if SHORTSIZE != SIZE16
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
#if LONGSIZE != SIZE32
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
#if LONGSIZE != SIZE32
}
break;
case 'w':
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
{
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
}
}
else {
+ if (len && (flags & UNPACK_ONLY_ONE))
+ len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
}
if (*s == '\n')
s++;
- else if (s[1] == '\n') /* possible checksum byte */
- s += 2;
+ else /* possible checksum byte */
+ if (s + 1 < strend && s[1] == '\n')
+ s += 2;
}
XPUSHs(sv_2mortal(sv));
break;
Perl_croak(aTHX_ "Invalid type in pack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
if (commas++ == 0 && ckWARN(WARN_PACK))
- Perl_warner(aTHX_ WARN_PACK,
+ Perl_warner(aTHX_ packWARN(WARN_PACK),
"Invalid type in pack: '%c'", (int)datumtype);
break;
case '%':
aint = SvIV(fromstr);
if ((aint < 0 || aint > 255) &&
ckWARN(WARN_PACK))
- Perl_warner(aTHX_ WARN_PACK,
+ Perl_warner(aTHX_ packWARN(WARN_PACK),
"Character in \"C\" format wrapped");
achar = aint & 255;
sv_catpvn(cat, &achar, sizeof(char));
aint = SvIV(fromstr);
if ((aint < -128 || aint > 127) &&
ckWARN(WARN_PACK))
- Perl_warner(aTHX_ WARN_PACK,
+ Perl_warner(aTHX_ packWARN(WARN_PACK),
"Character in \"c\" format wrapped");
achar = aint & 255;
sv_catpvn(cat, &achar, sizeof(char));
fromstr = NEXTFROM;
auint = UNI_TO_NATIVE(SvUV(fromstr));
SvGROW(cat, SvCUR(cat) + UTF8_MAXLEN + 1);
- SvCUR_set(cat, (char*)uvchr_to_utf8((U8*)SvEND(cat),auint)
- - SvPVX(cat));
+ SvCUR_set(cat,
+ (char*)uvchr_to_utf8_flags((U8*)SvEND(cat),
+ auint,
+ ckWARN(WARN_UTF8) ?
+ 0 : UNICODE_ALLOW_ANY)
+ - SvPVX(cat));
}
*SvEND(cat) = '\0';
break;
case 'f':
while (len-- > 0) {
fromstr = NEXTFROM;
+#ifdef __VOS__
+/* VOS does not automatically map a floating-point overflow
+ during conversion from double to float into infinity, so we
+ do it by hand. This code should either be generalized for
+ any OS that needs it, or removed if and when VOS implements
+ posix-976 (suggestion to support mapping to infinity).
+ Paul.Green@stratus.com 02-04-02. */
+ if (SvNV(fromstr) > FLT_MAX)
+ afloat = _float_constants[0]; /* single prec. inf. */
+ else if (SvNV(fromstr) < -FLT_MAX)
+ afloat = _float_constants[0]; /* single prec. inf. */
+ else afloat = (float)SvNV(fromstr);
+#else
afloat = (float)SvNV(fromstr);
+#endif
sv_catpvn(cat, (char *)&afloat, sizeof (float));
}
break;
case 'd':
while (len-- > 0) {
fromstr = NEXTFROM;
+#ifdef __VOS__
+/* VOS does not automatically map a floating-point overflow
+ during conversion from long double to double into infinity,
+ so we do it by hand. This code should either be generalized
+ for any OS that needs it, or removed if and when VOS
+ implements posix-976 (suggestion to support mapping to
+ infinity). Paul.Green@stratus.com 02-04-02. */
+ if (SvNV(fromstr) > DBL_MAX)
+ adouble = _double_constants[0]; /* double prec. inf. */
+ else if (SvNV(fromstr) < -DBL_MAX)
+ adouble = _double_constants[0]; /* double prec. inf. */
+ else adouble = (double)SvNV(fromstr);
+#else
adouble = (double)SvNV(fromstr);
+#endif
sv_catpvn(cat, (char *)&adouble, sizeof (double));
}
break;
case 'w':
while (len-- > 0) {
fromstr = NEXTFROM;
- adouble = Perl_floor(SvNV(fromstr));
+ adouble = SvNV(fromstr);
if (adouble < 0)
Perl_croak(aTHX_ "Cannot compress negative numbers");
- if (
-#if UVSIZE > 4 && UVSIZE >= NVSIZE
- adouble <= 0xffffffff
-#else
-# ifdef CXUX_BROKEN_CONSTANT_CONVERT
- adouble <= UV_MAX_cxux
-# else
- adouble <= UV_MAX
-# endif
-#endif
- )
+ /* 0xFFFFFFFFFFFFFFFF may cast to 18446744073709551616.0,
+ which is == UV_MAX_P1. IOK is fine (instead of UV_only), as
+ any negative IVs will have already been got by the croak()
+ above. IOK is untrue for fractions, so we test them
+ against UV_MAX_P1. */
+ if (SvIOK(fromstr) || adouble < UV_MAX_P1)
{
- char buf[1 + sizeof(UV)];
+ char buf[(sizeof(UV)*8)/7+1];
char *in = buf + sizeof(buf);
- UV auv = U_V(adouble);
+ UV auv = SvUV(fromstr);
do {
*--in = (auv & 0x7f) | 0x80;
char buf[sizeof(double) * 2]; /* 8/7 <= 2 */
char *in = buf + sizeof(buf);
+ adouble = Perl_floor(adouble);
do {
double next = floor(adouble / 128);
*--in = (unsigned char)(adouble - (next * 128)) | 0x80;
|| (SvPADTMP(fromstr)
&& !SvREADONLY(fromstr))))
{
- Perl_warner(aTHX_ WARN_PACK,
+ Perl_warner(aTHX_ packWARN(WARN_PACK),
"Attempt to pack pointer to temporary value");
}
if (SvPOK(fromstr) || SvNIOK(fromstr))