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 DQUOTE_INLINE_H /* Guard against nested #inclusion */
  10 #define 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 PERL_STATIC_INLINE bool
  37 S_grok_bslash_x(pTHX_ char **s, UV *uv, const char** error_msg,
  38                       const bool output_warning, const bool strict,
  39                       const bool silence_non_portable,
  40                       const bool UTF)
  41 {
  42
  43 /*  Documentation to be supplied when interface nailed down finally
  44  *  This returns FALSE if there is an error which the caller need not recover
  45  *  from; otherwise TRUE.
  46  *  It guarantees that the returned codepoint, *uv, when expressed as
  47  *  utf8 bytes, would fit within the skipped "\x{...}" bytes.
  48  *
  49  *  On input:
  50  *      s   is the address of a pointer to a NULL terminated string that begins
  51  *          with 'x', and the previous character was a backslash.  At exit, *s
  52  *          will be advanced to the byte just after those absorbed by this
  53  *          function.  Hence the caller can continue parsing from there.  In
  54  *          the case of an error, this routine has generally positioned *s to
  55  *          point just to the right of the first bad spot, so that a message
  56  *          that has a "<--" to mark the spot will be correctly positioned.
  57  *      uv  points to a UV that will hold the output value, valid only if the
  58  *          return from the function is TRUE
  59  *      error_msg is a pointer that will be set to an internal buffer giving an
  60  *          error message upon failure (the return is FALSE).  Untouched if
  61  *          function succeeds
  62  *      output_warning says whether to output any warning messages, or suppress
  63  *          them
  64  *      strict is true if anything out of the ordinary should cause this to
  65  *          fail instead of warn or be silent.  For example, it requires
  66  *          exactly 2 digits following the \x (when there are no braces).
  67  *          3 digits could be a mistake, so is forbidden in this mode.
  68  *      silence_non_portable is true if to suppress warnings about the code
  69  *          point returned being too large to fit on all platforms.
  70  *      UTF is true iff the string *s is encoded in UTF-8.
  71  */
  72     char* e;
  73     STRLEN numbers_len;
  74     I32 flags = PERL_SCAN_DISALLOW_PREFIX;
  75 #ifdef DEBUGGING
  76     char *start = *s - 1;
  77     assert(*start == '\\');
  78 #endif
  79
  80     PERL_ARGS_ASSERT_GROK_BSLASH_X;
  81
  82     assert(**s == 'x');
  83     (*s)++;
  84
  85     if (strict || ! output_warning) {
  86         flags |= PERL_SCAN_SILENT_ILLDIGIT;
  87     }
  88
  89     if (**s != '{') {
  90         STRLEN len = (strict) ? 3 : 2;
  91
  92         *uv = grok_hex(*s, &len, &flags, NULL);
  93         *s += len;
  94         if (strict && len != 2) {
  95             if (len < 2) {
  96                 *s += (UTF) ? UTF8SKIP(*s) : 1;
  97                 *error_msg = "Non-hex character";
  98             }
  99             else {
 100                 *error_msg = "Use \\x{...} for more than two hex characters";
 101             }
 102             return FALSE;
 103         }
 104         return TRUE;
 105     }
 106
 107     e = strchr(*s, '}');
 108     if (!e) {
 109         (*s)++;  /* Move past the '{' */
 110         while (isXDIGIT(**s)) { /* Position beyond the legal digits */
 111             (*s)++;
 112         }
 113         /* XXX The corresponding message above for \o is just '\\o{'; other
 114          * messages for other constructs include the '}', so are inconsistent.
 115          */
 116         *error_msg = "Missing right brace on \\x{}";
 117         return FALSE;
 118     }
 119
 120     (*s)++;    /* Point to expected first digit (could be first byte of utf8
 121                   sequence if not a digit) */
 122     numbers_len = e - *s;
 123     if (numbers_len == 0) {
 124         if (strict) {
 125             (*s)++;    /* Move past the } */
 126             *error_msg = "Number with no digits";
 127             return FALSE;
 128         }
 129         *s = e + 1;
 130         *uv = 0;
 131         return TRUE;
 132     }
 133
 134     flags |= PERL_SCAN_ALLOW_UNDERSCORES;
 135     if (silence_non_portable) {
 136         flags |= PERL_SCAN_SILENT_NON_PORTABLE;
 137     }
 138
 139     *uv = grok_hex(*s, &numbers_len, &flags, NULL);
 140     /* Note that if has non-hex, will ignore everything starting with that up
 141      * to the '}' */
 142
 143     if (strict && numbers_len != (STRLEN) (e - *s)) {
 144         *s += numbers_len;
 145         *s += (UTF) ? UTF8SKIP(*s) : 1;
 146         *error_msg = "Non-hex character";
 147         return FALSE;
 148     }
 149
 150     /* Return past the '}' */
 151     *s = e + 1;
 152
 153     return TRUE;
 154 }
 155
 156 #endif  /* DQUOTE_INLINE_H */