dquote_inline.h

   1 /*    dquote_inline.h
   2  *
   3  *    Copyright (C) 2015 by Larry Wall and others
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  */
   8
   9 #ifndef PERL_DQUOTE_INLINE_H_ /* Guard against nested #inclusion */
  10 #define PERL_DQUOTE_INLINE_H_
  11
  12 /*
  13  - regcurly - a little FSA that accepts {\d+,?\d*}
  14     Pulled from reg.c.
  15  */
  16 PERL_STATIC_INLINE I32
  17 S_regcurly(const char *s)
  18 {
  19     PERL_ARGS_ASSERT_REGCURLY;
  20
  21     if (*s++ != '{')
  22         return FALSE;
  23     if (!isDIGIT(*s))
  24         return FALSE;
  25     while (isDIGIT(*s))
  26         s++;
  27     if (*s == ',') {
  28         s++;
  29         while (isDIGIT(*s))
  30             s++;
  31     }
  32
  33     return *s == '}';
  34 }
  35
  36 /* This is inline not for speed, but because it is so tiny */
  37
  38 PERL_STATIC_INLINE char*
  39 S_form_short_octal_warning(pTHX_
  40                            const char * const s, /* Points to first non-octal */
  41                            const STRLEN len      /* Length of octals string, so
  42                                                     (s-len) points to first
  43                                                     octal */
  44 )
  45 {
  46     /* Return a character string consisting of a warning message for when a
  47      * string constant in octal is weird, like "\078".  */
  48
  49     const char * sans_leading_zeros = s - len;
  50
  51     PERL_ARGS_ASSERT_FORM_SHORT_OCTAL_WARNING;
  52
  53     assert(*s == '8' || *s == '9');
  54
  55     /* Remove the leading zeros, retaining one zero so won't be zero length */
  56     while (*sans_leading_zeros == '0') sans_leading_zeros++;
  57     if (sans_leading_zeros == s) {
  58         sans_leading_zeros--;
  59     }
  60
  61     return Perl_form(aTHX_
  62                      "'%.*s' resolved to '\\o{%.*s}%c'",
  63                      (int) (len + 2), s - len - 1,
  64                      (int) (s - sans_leading_zeros), sans_leading_zeros,
  65                      *s);
  66 }
  67 #endif  /* PERL_DQUOTE_INLINE_H_ */