+ while (pat < patend) {
+ char c = *pat++;
+
+ if (isSPACE(c))
+ continue;
+ else if (c == ender)
+ return --pat;
+ else if (c == '#') {
+ while (pat < patend && *pat != '\n')
+ pat++;
+ continue;
+ } else if (c == '(')
+ pat = group_end(pat, patend, ')') + 1;
+ else if (c == '[')
+ pat = group_end(pat, patend, ']') + 1;
+ }
+ Perl_croak(aTHX_ "No group ending character `%c' found", ender);
+ return 0;
+}
+
+#define TYPE_IS_SHRIEKING 0x100
+
+/* Returns the sizeof() struct described by pat */
+STATIC I32
+S_measure_struct(pTHX_ char *pat, register char *patend)
+{
+ I32 datumtype;
+ register I32 len;
+ register I32 total = 0;
+ int commas = 0;
+ int star; /* 1 if count is *, -1 if no count given, -2 for / */
+#ifdef PERL_NATINT_PACK
+ int natint; /* native integer */
+ int unatint; /* unsigned native integer */
+#endif
+ char buf[2];
+ register int size;
+
+ while ((pat = next_symbol(pat, patend)) < patend) {
+ datumtype = *pat++ & 0xFF;
+#ifdef PERL_NATINT_PACK
+ natint = 0;
+#endif
+ if (*pat == '!') {
+ static const char *natstr = "sSiIlLxX";
+
+ if (strchr(natstr, datumtype)) {
+ if (datumtype == 'x' || datumtype == 'X') {
+ datumtype |= TYPE_IS_SHRIEKING;
+ } else { /* XXXX Should be redone similarly! */
+#ifdef PERL_NATINT_PACK
+ natint = 1;
+#endif
+ }
+ pat++;
+ }
+ else
+ Perl_croak(aTHX_ "'!' allowed only after types %s", natstr);
+ }
+ len = find_count(&pat, patend, &star);
+ if (star > 0) /* */
+ Perl_croak(aTHX_ "%s not allowed in length fields", "count *");
+ else if (star < 0) /* No explicit len */
+ len = datumtype != '@';
+
+ switch(datumtype) {
+ default:
+ Perl_croak(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
+ case '@':
+ case '/':
+ case 'U': /* XXXX Is it correct? */
+ case 'w':
+ case 'u':
+ buf[0] = (char)datumtype;
+ buf[1] = 0;
+ 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_ packWARN(WARN_UNPACK),
+ "Invalid type in unpack: '%c'", (int)datumtype);
+ /* FALL THROUGH */
+ case '%':
+ size = 0;
+ break;
+ case '(':
+ {
+ char *beg = pat, *end;
+
+ if (star >= 0)
+ Perl_croak(aTHX_ "()-group starts with a count");
+ end = group_end(beg, patend, ')');
+ pat = end + 1;
+ len = find_count(&pat, patend, &star);
+ if (star < 0) /* No count */
+ len = 1;
+ else if (star > 0) /* Star */
+ Perl_croak(aTHX_ "%s not allowed in length fields", "count *");
+ /* XXXX Theoretically, we need to measure many times at different
+ positions, since the subexpression may contain
+ alignment commands, but be not of aligned length.
+ Need to detect this and croak(). */
+ size = measure_struct(beg, end);
+ break;
+ }
+ case 'X' | TYPE_IS_SHRIEKING:
+ /* XXXX Is this useful? Then need to treat MEASURE_BACKWARDS. */
+ if (!len) /* Avoid division by 0 */
+ len = 1;
+ len = total % len; /* Assumed: the start is aligned. */
+ /* FALL THROUGH */
+ case 'X':
+ size = -1;
+ if (total < len)
+ Perl_croak(aTHX_ "X outside of string");
+ break;
+ case 'x' | TYPE_IS_SHRIEKING:
+ if (!len) /* Avoid division by 0 */
+ len = 1;
+ star = total % len; /* Assumed: the start is aligned. */
+ if (star) /* Other portable ways? */
+ len = len - star;
+ else
+ len = 0;
+ /* FALL THROUGH */
+ case 'x':
+ case 'A':
+ case 'Z':
+ case 'a':
+ case 'c':
+ case 'C':
+ size = 1;
+ break;
+ case 'B':
+ case 'b':
+ len = (len + 7)/8;
+ size = 1;
+ break;
+ case 'H':
+ case 'h':
+ len = (len + 1)/2;
+ size = 1;
+ break;
+ case 's':
+#if SHORTSIZE == SIZE16
+ size = SIZE16;