Skip to content

Commit

Permalink
Add caller location info to e.g. RESTORE_LC_NUMERIC
Browse files Browse the repository at this point in the history 
These help pinpointing the error source when a failure occurs.
  • Loading branch information
@khwilliamson
khwilliamson committed May 12, 2023
1 parent 5d9f8d2 commit a587dcd
Show file tree
Hide file tree
Showing 5 changed files with 37 additions and 24 deletions.
8 changes: 6 additions & 2 deletions embed.fnc
View file
Expand Up @@ -2918,8 +2918,12 @@ p |void |setfd_cloexec_or_inhexec_by_sysfdness \
Tp |void |setfd_inhexec |int fd
p |void |setfd_inhexec_for_sysfd \
|int fd
Xp |void |set_numeric_standard
Xp |void |set_numeric_underlying
Xp |void |set_numeric_standard \
|NN const char *file \
|const line_t caller_line
Xp |void |set_numeric_underlying \
|NN const char *file \
|const line_t caller_line
Cp |HEK * |share_hek |NN const char *str \
|SSize_t len \
|U32 hash
Expand Down
4 changes: 2 additions & 2 deletions embed.h
View file
Expand Up @@ -1062,8 +1062,8 @@
# define scalar(a) Perl_scalar(aTHX_ a)
# define scalarvoid(a) Perl_scalarvoid(aTHX_ a)
# define set_caret_X() Perl_set_caret_X(aTHX)
# define set_numeric_standard() Perl_set_numeric_standard(aTHX)
# define set_numeric_underlying() Perl_set_numeric_underlying(aTHX)
# define set_numeric_standard(a,b) Perl_set_numeric_standard(aTHX_ a,b)
# define set_numeric_underlying(a,b) Perl_set_numeric_underlying(aTHX_ a,b)
# define setfd_cloexec Perl_setfd_cloexec
# define setfd_cloexec_for_nonsysfd(a) Perl_setfd_cloexec_for_nonsysfd(aTHX_ a)
# define setfd_cloexec_or_inhexec_by_sysfdness(a) Perl_setfd_cloexec_or_inhexec_by_sysfdness(aTHX_ a)
Expand Down
22 changes: 14 additions & 8 deletions locale.c
View file
Expand Up @@ -3013,15 +3013,18 @@ S_new_numeric(pTHX_ const char *newnum, bool force)
* the radix being a non-dot. (Core operations that need the underlying
* locale change to it temporarily). */
if (! PL_numeric_standard) {
set_numeric_standard();
set_numeric_standard(__FILE__, __LINE__);
}
}

# endif

void
Perl_set_numeric_standard(pTHX)
Perl_set_numeric_standard(pTHX_ const char * const file, const line_t line)
{
PERL_ARGS_ASSERT_SET_NUMERIC_STANDARD;
PERL_UNUSED_ARG(file); /* Some Configurations ignore these */
PERL_UNUSED_ARG(line);

# ifdef USE_LOCALE_NUMERIC

Expand All @@ -3035,7 +3038,7 @@ Perl_set_numeric_standard(pTHX)
DEBUG_L(PerlIO_printf(Perl_debug_log,
"Setting LC_NUMERIC locale to standard C\n"));

void_setlocale_c_with_caller(LC_NUMERIC, "C", __FILE__, __LINE__);
void_setlocale_c_with_caller(LC_NUMERIC, "C", file, line);
PL_numeric_standard = TRUE;
sv_setpv(PL_numeric_radix_sv, C_decimal_point);

Expand All @@ -3046,8 +3049,11 @@ Perl_set_numeric_standard(pTHX)
}

void
Perl_set_numeric_underlying(pTHX)
Perl_set_numeric_underlying(pTHX_ const char * const file, const line_t line)
{
PERL_ARGS_ASSERT_SET_NUMERIC_UNDERLYING;
PERL_UNUSED_ARG(file); /* Some Configurations ignore these */
PERL_UNUSED_ARG(line);

# ifdef USE_LOCALE_NUMERIC

Expand All @@ -3061,9 +3067,9 @@ Perl_set_numeric_underlying(pTHX)

DEBUG_L(PerlIO_printf(Perl_debug_log, "Setting LC_NUMERIC locale to %s\n",
PL_numeric_name));
/* Maybe not in init? assert(PL_locale_mutex_depth > 0);*/

void_setlocale_c_with_caller(LC_NUMERIC, PL_numeric_name,
__FILE__, __LINE__);
void_setlocale_c_with_caller(LC_NUMERIC, PL_numeric_name, file, line);
PL_numeric_underlying = TRUE;
sv_setsv_nomg(PL_numeric_radix_sv, PL_underlying_radix_sv);

Expand Down Expand Up @@ -3862,14 +3868,14 @@ Perl_setlocale(const int category, const char * locale)
* (if we aren't there already) so as to get the correct results. Our
* records for all the other categories are valid without switching */
if (! PL_numeric_underlying) {
set_numeric_underlying();
set_numeric_underlying(__FILE__, __LINE__);
toggled = TRUE;
}

retval = querylocale_c(LC_ALL);

if (toggled) {
set_numeric_standard();
set_numeric_standard(__FILE__, __LINE__);
}

DEBUG_L(PerlIO_printf(Perl_debug_log, "%s\n",
Expand Down
17 changes: 9 additions & 8 deletions perl.h
View file
Expand Up @@ -7520,7 +7520,8 @@ cannot have changed since the precalculation.
(! PL_numeric_underlying && PL_numeric_standard < 2)

# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION \
void (*_restore_LC_NUMERIC_function)(pTHX) = NULL
void (*_restore_LC_NUMERIC_function)(pTHX_ const char * const file, \
const line_t line) = NULL

# define STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in) \
STMT_START { \
Expand All @@ -7530,14 +7531,14 @@ cannot have changed since the precalculation.
|| (! _in_lc_numeric && NOT_IN_NUMERIC_STANDARD_))); \
if (_in_lc_numeric) { \
if (NOT_IN_NUMERIC_UNDERLYING_) { \
Perl_set_numeric_underlying(aTHX); \
Perl_set_numeric_underlying(aTHX_ __FILE__, __LINE__); \
_restore_LC_NUMERIC_function \
= &Perl_set_numeric_standard; \
} \
} \
else { \
if (NOT_IN_NUMERIC_STANDARD_) { \
Perl_set_numeric_standard(aTHX); \
Perl_set_numeric_standard(aTHX_ __FILE__, __LINE__); \
_restore_LC_NUMERIC_function \
= &Perl_set_numeric_underlying; \
} \
Expand All @@ -7550,7 +7551,7 @@ cannot have changed since the precalculation.
# define RESTORE_LC_NUMERIC() \
STMT_START { \
if (_restore_LC_NUMERIC_function) { \
_restore_LC_NUMERIC_function(aTHX); \
_restore_LC_NUMERIC_function(aTHX_ __FILE__, __LINE__); \
} \
LC_NUMERIC_UNLOCK; \
} STMT_END
Expand All @@ -7564,7 +7565,7 @@ cannot have changed since the precalculation.
"%s: %d: lc_numeric standard=%d\n", \
__FILE__, __LINE__, PL_numeric_standard)); \
if (UNLIKELY(NOT_IN_NUMERIC_STANDARD_)) { \
Perl_set_numeric_standard(aTHX); \
Perl_set_numeric_standard(aTHX_ __FILE__, __LINE__); \
} \
DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
"%s: %d: lc_numeric standard=%d\n", \
Expand All @@ -7575,7 +7576,7 @@ cannot have changed since the precalculation.
STMT_START { \
/*assert(PL_locale_mutex_depth > 0);*/ \
if (NOT_IN_NUMERIC_UNDERLYING_) { \
Perl_set_numeric_underlying(aTHX); \
Perl_set_numeric_underlying(aTHX_ __FILE__, __LINE__); \
} \
} STMT_END

Expand All @@ -7586,7 +7587,7 @@ cannot have changed since the precalculation.
LC_NUMERIC_LOCK(NOT_IN_NUMERIC_STANDARD_); \
if (NOT_IN_NUMERIC_STANDARD_) { \
_restore_LC_NUMERIC_function = &Perl_set_numeric_underlying;\
Perl_set_numeric_standard(aTHX); \
Perl_set_numeric_standard(aTHX_ __FILE__, __LINE__); \
} \
} STMT_END

Expand All @@ -7596,7 +7597,7 @@ cannot have changed since the precalculation.
STMT_START { \
LC_NUMERIC_LOCK(NOT_IN_NUMERIC_UNDERLYING_); \
if (NOT_IN_NUMERIC_UNDERLYING_) { \
Perl_set_numeric_underlying(aTHX); \
Perl_set_numeric_underlying(aTHX_ __FILE__, __LINE__); \
_restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \
} \
} STMT_END
Expand Down
10 changes: 6 additions & 4 deletions proto.h
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit a587dcd

Please sign in to comment.