Skip to content

Commit

Permalink
locale.c: Add DEBUGGING information
Browse files Browse the repository at this point in the history 
These functions are called as expansions of macros.  It may be useful to
know where in the file the macro occurred.
  • Loading branch information
@khwilliamson
khwilliamson committed May 5, 2021
1 parent 75ab944 commit 1f82b1f
Show file tree
Hide file tree
Showing 4 changed files with 52 additions and 43 deletions.
6 changes: 4 additions & 2 deletions embed.fnc
View file
Expand Up @@ -3253,11 +3253,13 @@ S |void |new_LC_ALL |NULLOK const char* unused
# ifdef USE_POSIX_2008_LOCALE
S |const char*|emulate_setlocale_i|const unsigned int index \
|NULLOK const char* new_locale \
|const int recalc_LC_ALL
|const int recalc_LC_ALL \
|const line_t line
S |const char*|my_querylocale_i|const unsigned int index
S |locale_t |use_curlocale_scratch
S |const char *|setlocale_from_aggregate_LC_ALL \
|NN const char * locale
|NN const char * locale \
|const line_t line
S |const char*|update_PL_curlocales_i|const unsigned int index \
|NN const char * new_locale \
|int recalc_LC_ALL
Expand Down
4 changes: 2 additions & 2 deletions embed.h
View file
Expand Up @@ -1710,10 +1710,10 @@
#define stdize_locale(a,b,c,d) S_stdize_locale(aTHX_ a,b,c,d)
#define switch_category_locale_to_template(a,b,c) S_switch_category_locale_to_template(aTHX_ a,b,c)
# if defined(USE_POSIX_2008_LOCALE)
#define emulate_setlocale_i(a,b,c) S_emulate_setlocale_i(aTHX_ a,b,c)
#define emulate_setlocale_i(a,b,c,d) S_emulate_setlocale_i(aTHX_ a,b,c,d)
#define find_locale_from_environment(a) S_find_locale_from_environment(aTHX_ a)
#define my_querylocale_i(a) S_my_querylocale_i(aTHX_ a)
#define setlocale_from_aggregate_LC_ALL(a) S_setlocale_from_aggregate_LC_ALL(aTHX_ a)
#define setlocale_from_aggregate_LC_ALL(a,b) S_setlocale_from_aggregate_LC_ALL(aTHX_ a,b)
#define update_PL_curlocales_i(a,b,c) S_update_PL_curlocales_i(aTHX_ a,b,c)
#define use_curlocale_scratch() S_use_curlocale_scratch(aTHX)
# endif
Expand Down
81 changes: 44 additions & 37 deletions locale.c
View file
Expand Up @@ -516,12 +516,12 @@ S_use_curlocale_scratch(pTHX)
* are equivalents, like LC_NUMERIC_MASK, which we use instead, converting to
* by using get_category_index() followed by table lookup. */

# define emulate_setlocale_c(cat, locale, recalc_LC_ALL) \
emulate_setlocale_i(cat##_INDEX_, locale, recalc_LC_ALL)
# define emulate_setlocale_c(cat, locale, recalc_LC_ALL, line) \
emulate_setlocale_i(cat##_INDEX_, locale, recalc_LC_ALL, line)

/* A wrapper for the macros below. TRUE => do recalculate LC_ALL */
# define common_emulate_setlocale(i, locale) \
emulate_setlocale_i(i, locale, TRUE)
emulate_setlocale_i(i, locale, TRUE, __LINE__)

# define setlocale_i(i, locale) common_emulate_setlocale(i, locale)
# define setlocale_c(cat, locale) setlocale_i(cat##_INDEX_, locale)
Expand Down Expand Up @@ -649,8 +649,8 @@ S_my_querylocale_i(pTHX_ const unsigned int index)

category = categories[index];

DEBUG_Lv(PerlIO_printf(Perl_debug_log, "%s:%d: my_querylocale_i %p\n",
__FILE__, __LINE__, cur_obj));
DEBUG_Lv(PerlIO_printf(Perl_debug_log, "%s:%d: my_querylocale_i(%s) on %p\n",
__FILE__, __LINE__, category_names[index], cur_obj));
if (cur_obj == LC_GLOBAL_LOCALE) {
retval = porcelain_setlocale(category, NULL);
}
Expand Down Expand Up @@ -736,7 +736,7 @@ S_update_PL_curlocales_i(pTHX_
}

STATIC const char *
S_setlocale_from_aggregate_LC_ALL(pTHX_ const char * locale)
S_setlocale_from_aggregate_LC_ALL(pTHX_ const char * locale, const line_t line)
{
/* This function parses the value of the LC_ALL locale, assuming glibc
* syntax, and sets each individual category on the system to the proper
Expand Down Expand Up @@ -774,9 +774,9 @@ S_setlocale_from_aggregate_LC_ALL(pTHX_ const char * locale)
* all the individual categories to "C", and override the furnished
* ones below. FALSE => No need to recalculate LC_ALL, as this is a
* temporary state */
if (! emulate_setlocale_c(LC_ALL, "C", FALSE)) {
if (! emulate_setlocale_c(LC_ALL, "C", FALSE, line)) {
setlocale_failure_panic_c(LC_ALL, locale_on_entry,
"C", __LINE__, 0);
"C", __LINE__, line);
NOT_REACHED; /* NOTREACHED */
}

Expand Down Expand Up @@ -828,13 +828,14 @@ S_setlocale_from_aggregate_LC_ALL(pTHX_ const char * locale)

/* FALSE => Don't recalculate LC_ALL; we'll do it ourselves after
* the loop */
if (! emulate_setlocale_i(i, individ_locale, FALSE)) {
if (! emulate_setlocale_i(i, individ_locale, FALSE, line)) {

/* But if we have to back out, do fix up LC_ALL */
if (! emulate_setlocale_c(LC_ALL, locale_on_entry, TRUE)) {
if (! emulate_setlocale_c(LC_ALL, locale_on_entry, TRUE, line))
{
Safefree(locale_on_entry);
setlocale_failure_panic_i(i, individ_locale,
locale, __LINE__, 0);
locale, __LINE__, line);
NOT_REACHED; /* NOTREACHED */
}
Safefree(locale_on_entry);
Expand Down Expand Up @@ -942,7 +943,8 @@ STATIC const char *
S_emulate_setlocale_i(pTHX_
const unsigned int index,
const char * new_locale,
const int recalc_LC_ALL)
const int recalc_LC_ALL,
const line_t line)
{
/* This function effectively performs a setlocale() on just the current
* thread; thus it is thread-safe. It does this by using the POSIX 2008
Expand Down Expand Up @@ -993,7 +995,7 @@ S_emulate_setlocale_i(pTHX_
}

if (strchr(new_locale, ';')) {
return setlocale_from_aggregate_LC_ALL(new_locale);
return setlocale_from_aggregate_LC_ALL(new_locale, line);
}

/* Here at the end of having to deal with the absence of querylocale().
Expand Down Expand Up @@ -1028,22 +1030,22 @@ S_emulate_setlocale_i(pTHX_
old_obj = uselocale(PL_C_locale_obj);

DEBUG_Lv(PerlIO_printf(Perl_debug_log,
"%s:%d: emulate_setlocale_i was using %p\n",
__FILE__, __LINE__, old_obj));
"%s:%d:(%d): emulate_setlocale_i was using %p\n",
__FILE__, __LINE__, line, old_obj));

if (! old_obj) {
dSAVE_ERRNO;
DEBUG_L(PerlIO_printf(Perl_debug_log,
"%s:%d: emulate_setlocale_i switching to C"
" failed: %d\n", __FILE__, __LINE__, GET_ERRNO));
"%s:%d:(%d): emulate_setlocale_i switching to C"
" failed: %d\n", __FILE__, __LINE__, line, GET_ERRNO));
RESTORE_ERRNO;

return NULL;
}

DEBUG_Lv(PerlIO_printf(Perl_debug_log,
"%s:%d: emulate_setlocale_i now using %p\n",
__FILE__, __LINE__, PL_C_locale_obj));
"%s:%d:(%d): emulate_setlocale_i now using C object=%p\n",
__FILE__, __LINE__, line, PL_C_locale_obj));

/* If this call is to switch LC_ALL to the 'C' locale, it already exists,
* and in fact, we already have switched to it (in preparation for what
Expand Down Expand Up @@ -1080,8 +1082,8 @@ S_emulate_setlocale_i(pTHX_
dSAVE_ERRNO;

DEBUG_L(PerlIO_printf(Perl_debug_log,
"%s:%d: emulate_setlocale_i creating new object"
" failed: %d\n", __FILE__, __LINE__, GET_ERRNO));
"%s:%d:(%d): emulate_setlocale_i creating new object"
" failed: %d\n", __FILE__, __LINE__, line, GET_ERRNO));

if (! uselocale(old_obj)) {
DEBUG_L(PerlIO_printf(Perl_debug_log,
Expand All @@ -1094,8 +1096,8 @@ S_emulate_setlocale_i(pTHX_

DEBUG_Lv(STMT_START {
PerlIO_printf(Perl_debug_log,
"%s:%d: emulate_setlocale_i created %p",
__FILE__, __LINE__, new_obj);
"%s:%d:(%d): emulate_setlocale_i created %p",
__FILE__, __LINE__, line, new_obj);
if (old_obj) PerlIO_printf(Perl_debug_log,
"; should have freed %p", old_obj);
PerlIO_printf(Perl_debug_log, "\n");
Expand All @@ -1106,8 +1108,8 @@ S_emulate_setlocale_i(pTHX_
dSAVE_ERRNO;

DEBUG_L(PerlIO_printf(Perl_debug_log,
"%s:%d: emulate_setlocale_i switching to new object"
" failed\n", __FILE__, __LINE__));
"%s:%d:(%d): emulate_setlocale_i switching to new object"
" failed\n", __FILE__, __LINE__, line));

if (! uselocale(old_obj)) {

Expand All @@ -1124,8 +1126,8 @@ S_emulate_setlocale_i(pTHX_

/* Here, we are using 'new_obj' which matches the input 'new_locale'. */
DEBUG_Lv(PerlIO_printf(Perl_debug_log,
"%s:%d: emulate_setlocale_i now using %p\n",
__FILE__, __LINE__, new_obj));
"%s:%d:(%d): emulate_setlocale_i now using %p\n",
__FILE__, __LINE__, line, new_obj));

/* We are done, except for updating our records (if the system doesn't keep
* them) and in the case of locale "", we don't actually know what the
Expand Down Expand Up @@ -2478,9 +2480,12 @@ Perl_setlocale(const int category, const char * locale)

const char * retval;
unsigned int cat_index;
dSAVEDERRNO;
dTHX;

DEBUG_L(PerlIO_printf(Perl_debug_log,
"%s:%d: entering Perl_setlocale(%d, %s)\n",
__FILE__, __LINE__, category, locale));

/* A NULL locale means only query what the current one is. */
if (locale == NULL) {

Expand All @@ -2494,6 +2499,9 @@ Perl_setlocale(const int category, const char * locale)
/* We have the LC_NUMERIC name saved, because we are normally switched
* into the C locale (or equivalent) for it. */
if (category == LC_NUMERIC) {
DEBUG_L(PerlIO_printf(Perl_debug_log,
"%s:%d: returning stashed numeric=%s\n",
__FILE__, __LINE__, PL_numeric_name));

/* We don't have to copy this return value, as it is a per-thread
* variable, and won't change until a future setlocale */
Expand Down Expand Up @@ -2527,21 +2535,17 @@ Perl_setlocale(const int category, const char * locale)

# endif

DEBUG_L(PerlIO_printf(Perl_debug_log, "returning '%s'\n", retval));

return retval;
} /* End of querying the current locale */

cat_index = get_category_index(category, NULL);
retval = save_to_buffer(setlocale_i(cat_index, locale),
&PL_setlocale_buf, &PL_setlocale_bufsize, 0);
SAVE_ERRNO;

DEBUG_L(PerlIO_printf(Perl_debug_log,
"%s:%d: %s\n", __FILE__, __LINE__,
setlocale_debug_string_r(category, locale, retval)));

RESTORE_ERRNO;

if (! retval) {
DEBUG_L(PerlIO_printf(Perl_debug_log,
"Perl_setlocale returning (null)\n"));
return NULL;
}

Expand All @@ -2551,6 +2555,9 @@ Perl_setlocale(const int category, const char * locale)
update_functions[cat_index](aTHX_ retval);
}

DEBUG_L(PerlIO_printf(Perl_debug_log, "%s:%d: returning '%s'\n",
__FILE__, __LINE__, retval));

return retval;

#endif
Expand Down Expand Up @@ -3996,7 +4003,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
* them now, calculating LC_ALL only on the final go round, when all have
* been set. */
for (i = 0; i < NOMINAL_LC_ALL_INDEX; i++) {
(void) emulate_setlocale_i(i, curlocales[i], LOOPING);
(void) emulate_setlocale_i(i, curlocales[i], LOOPING, __LINE__);
}

# endif
Expand Down
4 changes: 2 additions & 2 deletions proto.h
View file
Expand Up @@ -5155,13 +5155,13 @@ STATIC const char* S_stdize_locale(pTHX_ const int category, const char* input_l
STATIC const char* S_switch_category_locale_to_template(pTHX_ const int switch_category, const int template_category, const char * template_locale);
#define PERL_ARGS_ASSERT_SWITCH_CATEGORY_LOCALE_TO_TEMPLATE
# if defined(USE_POSIX_2008_LOCALE)
STATIC const char* S_emulate_setlocale_i(pTHX_ const unsigned int index, const char* new_locale, const int recalc_LC_ALL);
STATIC const char* S_emulate_setlocale_i(pTHX_ const unsigned int index, const char* new_locale, const int recalc_LC_ALL, const line_t line);
#define PERL_ARGS_ASSERT_EMULATE_SETLOCALE_I
STATIC const char * S_find_locale_from_environment(pTHX_ const unsigned int index);
#define PERL_ARGS_ASSERT_FIND_LOCALE_FROM_ENVIRONMENT
STATIC const char* S_my_querylocale_i(pTHX_ const unsigned int index);
#define PERL_ARGS_ASSERT_MY_QUERYLOCALE_I
STATIC const char * S_setlocale_from_aggregate_LC_ALL(pTHX_ const char * locale);
STATIC const char * S_setlocale_from_aggregate_LC_ALL(pTHX_ const char * locale, const line_t line);
#define PERL_ARGS_ASSERT_SETLOCALE_FROM_AGGREGATE_LC_ALL \
assert(locale)
STATIC const char* S_update_PL_curlocales_i(pTHX_ const unsigned int index, const char * new_locale, int recalc_LC_ALL);
Expand Down

0 comments on commit 1f82b1f

Please sign in to comment.