+ PERL_ARGS_ASSERT_GROK_NUMBER;
+
+ return grok_number_flags(pv, len, valuep, 0);
+}
+
+/*
+=for apidoc grok_infnan
+
+Helper for grok_number(), accepts various ways of spelling "infinity"
+or "not a number", and returns one of the following flag combinations:
+
+ IS_NUMBER_INFINITE
+ IS_NUMBER_NAN
+ IS_NUMBER_INFINITE | IS_NUMBER_NEG
+ IS_NUMBER_NAN | IS_NUMBER_NEG
+ 0
+
+If an infinity or not-a-number is recognized, the *sp will point to
+one past the end of the recognized string. If the recognition fails,
+zero is returned, and the *sp will not move.
+
+=cut
+*/
+
+int
+Perl_grok_infnan(const char** sp, const char* send)
+{
+ const char* s = *sp;
+ int flags = 0;
+
+ PERL_ARGS_ASSERT_GROK_INFNAN;
+
+ if (*s == '+') {
+ s++; if (s == send) return 0;
+ }
+ else if (*s == '-') {
+ flags |= IS_NUMBER_NEG; /* Yes, -NaN happens. Incorrect but happens. */
+ s++; if (s == send) return 0;
+ }
+
+ if (*s == '1') {
+ /* Visual C: 1.#SNAN, -1.#QNAN, 1#INF, 1#.IND (maybe also 1.#NAN) */
+ s++; if (s == send) return 0;
+ if (*s == '.') {
+ s++; if (s == send) return 0;
+ }
+ if (*s == '#') {
+ s++; if (s == send) return 0;
+ } else
+ return 0;
+ }
+
+ if (isALPHA_FOLD_EQ(*s, 'I')) {
+ /* INF or IND (1.#IND is indeterminate, a certain type of NAN) */
+ s++; if (s == send || isALPHA_FOLD_NE(*s, 'N')) return 0;
+ s++; if (s == send) return 0;
+ if (isALPHA_FOLD_EQ(*s, 'F')) {
+ s++;
+ if (s < send && (isALPHA_FOLD_EQ(*s, 'I'))) {
+ s++; if (s == send || isALPHA_FOLD_NE(*s, 'N')) return 0;
+ s++; if (s == send || isALPHA_FOLD_NE(*s, 'I')) return 0;
+ s++; if (s == send || isALPHA_FOLD_NE(*s, 'T')) return 0;
+ s++; if (s == send ||
+ /* allow either Infinity or Infinite */
+ (isALPHA_FOLD_NE(*s, 'Y') &&
+ isALPHA_FOLD_NE(*s, 'E')))
+ return 0;
+ s++;
+ } else if (*s)
+ return 0;
+ flags |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
+ }
+ else if (isALPHA_FOLD_EQ(*s, 'D')) {
+ s++;
+ flags |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
+ } else
+ return 0;
+
+ *sp = s;
+ return flags;
+ }
+ else {
+ /* NAN */
+ if (isALPHA_FOLD_EQ(*s, 'S') || isALPHA_FOLD_EQ(*s, 'Q')) {
+ /* snan, qNaN */
+ /* XXX do something with the snan/qnan difference */
+ s++; if (s == send) return 0;
+ }
+
+ if (isALPHA_FOLD_EQ(*s, 'N')) {
+ s++; if (s == send || isALPHA_FOLD_NE(*s, 'A')) return 0;
+ s++; if (s == send || isALPHA_FOLD_NE(*s, 'N')) return 0;
+ s++;
+
+ flags |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
+
+ /* NaN can be followed by various stuff (NaNQ, NaNS), but
+ * there are also multiple different NaN values, and some
+ * implementations output the "payload" values,
+ * e.g. NaN123, NAN(abc), while some implementations just
+ * have weird stuff like NaN%. */
+ s = send;
+ }
+ else
+ return 0;
+
+ *sp = s;
+ return flags;
+ }
+
+ return 0;
+}
+
+static const UV uv_max_div_10 = UV_MAX / 10;
+static const U8 uv_max_mod_10 = UV_MAX % 10;
+
+int
+Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags)
+{
https://perl5.git.perl.org / perl5.git / blobdiff