locale.c: Create S_get_category_index()

libc locale categories, like LC_NUMERIC, are opaque integers.  This
makes it inconvenient to have table-driven code.  Instead, we have
tables that are indexed by small positive integers, which are a
compile-time mapping from the libc values.

This commit creates a run-time function to also do that mapping.  It
will first be used in the next commit.

The function does a loop through the available categories, looking for a
match.  It could be replaced by some sort of quick hash lookup, but the
largest arrays in the field have a max of 12 elements, with almost all
searches finding their quarry in the first 6.  It doesn't seem
worthwhile to me to replace a linear search of 6 elements by something
more complicated.  The design intent is this search will be used only at
the edges of the locale-handling code; once found the index is used in
future bits of the current operation.

embed.fnc

@@ -3215,6 +3215,7 @@ SG   |bool   |sv_derived_from_svpvn  |NULLOK SV *sv			\
 #if defined(PERL_IN_LOCALE_C)
 #  ifdef USE_LOCALE
 ST	|const char*|category_name |const int category
+ST	|unsigned int|get_category_index|const int category|NULLOK const char * locale
 S	|const char*|switch_category_locale_to_template|const int switch_category|const int template_category|NULLOK const char * template_locale
 S	|void	|restore_switched_locale|const int category|NULLOK const char * const original_locale
 #  endif

embed.h

@@ -1692,6 +1692,7 @@
 #define save_to_buffer		S_save_to_buffer
 #    if defined(USE_LOCALE)
 #define category_name		S_category_name
+#define get_category_index	S_get_category_index
 #define new_collate(a)		S_new_collate(aTHX_ a)
 #define new_ctype(a)		S_new_ctype(aTHX_ a)
 #define new_numeric(a)		S_new_numeric(aTHX_ a)

locale.c

@@ -211,9 +211,10 @@ STATIC const int categories[] = {
 #    ifdef LC_ALL
                              LC_ALL,
 #    endif
-                            -1  /* Placeholder because C doesn't allow a
-                                   trailing comma, and it would get complicated
-                                   with all the #ifdef's */
+
+   /* Placeholder as a precaution if code fails to check the return of
+    * get_category_index(), which returns this element to indicate an error */
+                            -1
 };
 
 /* The top-most real element is LC_ALL */
@@ -262,8 +263,11 @@ STATIC const char * const category_names[] = {
 #    ifdef LC_ALL
                                  "LC_ALL",
 #    endif
-                                 NULL  /* Placeholder */
-                            };
+
+   /* Placeholder as a precaution if code fails to check the return of
+    * get_category_index(), which returns this element to indicate an error */
+                                 NULL
+};
 
 #  ifdef LC_ALL
 
@@ -287,6 +291,48 @@ STATIC const char * const category_names[] = {
  * checked for at compile time by using the #define LC_ALL_INDEX_ which is only
  * defined if we do have LC_ALL. */
 
+STATIC unsigned int
+S_get_category_index(const int category, const char * locale)
+{
+    /* Given a category, return the equivalent internal index we generally use
+     * instead.
+     *
+     * 'locale' is for use in any generated diagnostics, and may be NULL
+     *
+     * Some sort of hash could be used instead of this loop, but the number of
+     * elements is so far at most 12 */
+
+    unsigned int i;
+
+    PERL_ARGS_ASSERT_GET_CATEGORY_INDEX;
+
+#  ifdef LC_ALL
+    for (i = 0; i <=         LC_ALL_INDEX_; i++)
+#  else
+    for (i = 0; i <  NOMINAL_LC_ALL_INDEX;  i++)
+#  endif
+    {
+        if (category == categories[i]) {
+            dTHX_DEBUGGING;
+            DEBUG_Lv(PerlIO_printf(Perl_debug_log,
+                     "%s:%d: index of category %d (%s) is %d\n",
+                     __FILE__, __LINE__, category, category_names[i], i));
+            return i;
+        }
+    }
+
+    /* Here, we don't know about this category, so can't handle it. */
+    if (! locale) {
+        locale = "(unknown)";
+    }
+    Perl_warner_nocontext(packWARN(WARN_LOCALE),
+                            "Unknown locale category %d; can't set it to %s\n",
+                                                     category, locale);
+
+    /* Return an out-of-bounds value */
+    return NOMINAL_LC_ALL_INDEX + 1;
+}
+
 STATIC const char *
 S_category_name(const int category)
 {
@@ -424,7 +470,11 @@ STATIC const int category_masks[] = {
                                  * here, so compile it in unconditionally.
                                  * This could catch some glitches at compile
                                  * time */
-                                LC_ALL_MASK
+                                LC_ALL_MASK,
+
+   /* Placeholder as a precaution if code fails to check the return of
+    * get_category_index(), which returns this element to indicate an error */
+                                0
                             };
 
 STATIC const char *

proto.h

@@ -5121,6 +5121,8 @@ PERL_STATIC_INLINE const char *	S_save_to_buffer(const char * string, char **buf
 #  if defined(USE_LOCALE)
 STATIC const char*	S_category_name(const int category);
 #define PERL_ARGS_ASSERT_CATEGORY_NAME
+STATIC unsigned int	S_get_category_index(const int category, const char * locale);
+#define PERL_ARGS_ASSERT_GET_CATEGORY_INDEX
 STATIC void	S_new_collate(pTHX_ const char* newcoll);
 #define PERL_ARGS_ASSERT_NEW_COLLATE
 STATIC void	S_new_ctype(pTHX_ const char* newctype);