/* pp_pack.c
*
- * Copyright (c) 1991-2001, Larry Wall
+ * Copyright (c) 1991-2002, 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.
#endif
bool do_utf8 = DO_UTF8(right);
- if (gimme != G_ARRAY) { /* arrange to do first one only */
- /*SUPPRESS 530*/
- /* Skipping spaces will be useful later on. */
- while (isSPACE(*pat))
- pat++;
- /* Give up on optimisation of only doing first if the pattern
- is getting too complex to parse. */
- if (*pat != '#') {
- /* This pre-parser will let through certain invalid patterns
- such as rows of !s, but the nothing that would cause multiple
- conversions to be attempted. */
- char *here = pat;
- bool seen_percent = FALSE;
- if (*here == '%')
- seen_percent = TRUE;
- while (!isALPHA(*here) || *here == 'x')
- here++;
- if (strchr("aAZbBhHP", *here) || seen_percent) {
- here++;
- while (isDIGIT(*here) || *here == '*' || *here == '!')
- here++;
- }
- else
- here++;
- patend = here;
- }
- }
while (pat < patend) {
reparse:
datumtype = *pat++ & 0xFF;
goto uchar_checksum;
sv = NEWSV(35, len);
sv_setpvn(sv, s, len);
- s += len;
if (datumtype == 'A' || datumtype == 'Z') {
aptr = s; /* borrow register */
if (datumtype == 'Z') { /* 'Z' strips stuff after first null */
s = SvPVX(sv);
while (*s)
s++;
+ if (star) /* exact for 'Z*' */
+ len = s - SvPVX(sv) + 1;
}
else { /* 'A' strips both nulls and spaces */
s = SvPVX(sv) + len - 1;
SvCUR_set(sv, s - SvPVX(sv));
s = aptr; /* unborrow register */
}
+ s += len;
XPUSHs(sv_2mortal(sv));
break;
case 'B':
if (checksum) {
while (len-- > 0 && s < strend) {
STRLEN alen;
- auint = utf8n_to_uvchr((U8*)s, strend - s, &alen, 0);
+ auint = NATIVE_TO_UNI(utf8n_to_uvchr((U8*)s, strend - s, &alen, 0));
along = alen;
s += along;
if (checksum > bits_in_uv)
EXTEND_MORTAL(len);
while (len-- > 0 && s < strend) {
STRLEN alen;
- auint = utf8n_to_uvchr((U8*)s, strend - s, &alen, 0);
+ auint = NATIVE_TO_UNI(utf8n_to_uvchr((U8*)s, strend - s, &alen, 0));
along = alen;
s += along;
sv = NEWSV(37, 0);
}
break;
case 'P':
+ if (star)
+ DIE(aTHX_ "P must have an explicit size");
EXTEND(SP, 1);
if (sizeof(char*) > strend - s)
break;
XPUSHs(sv_2mortal(sv));
checksum = 0;
}
+ if (gimme != G_ARRAY &&
+ SP - PL_stack_base == start_sp_offset + 1) {
+ /* do first one only unless in list context
+ / is implmented by unpacking the count, then poping it from the
+ stack, so must check that we're not in the middle of a / */
+ if ((pat >= patend) || *pat != '/')
+ RETURN;
+ }
}
if (SP - PL_stack_base == start_sp_offset && gimme == G_SCALAR)
PUSHs(&PL_sv_undef);
case 'a':
fromstr = NEXTFROM;
aptr = SvPV(fromstr, fromlen);
- if (pat[-1] == '*') {
+ if (pat[lengthcode ? -2 : -1] == '*') { /* -2 after '/' */
len = fromlen;
if (datumtype == 'Z')
++len;
case 'U':
while (len-- > 0) {
fromstr = NEXTFROM;
- auint = SvUV(fromstr);
+ 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));
fromstr = NEXTFROM;
aptr = SvPV(fromstr, fromlen);
SvGROW(cat, fromlen * 4 / 3);
- if (len <= 1)
+ if (len <= 2)
len = 45;
else
len = len / 3 * 3;