44
44
45
45
#include "reentr.h"
46
46
47
+ /* If the environment says to, we can output debugging information during
48
+ * initialization. This is done before option parsing, and before any thread
49
+ * creation, so can be a file-level static */
50
+ #ifdef DEBUGGING
51
+ static bool debug_initialization = FALSE;
52
+ #endif
53
+
47
54
#ifdef USE_LOCALE
48
55
49
56
/*
@@ -119,13 +126,17 @@ Perl_set_numeric_radix(pTHX)
119
126
else
120
127
PL_numeric_radix_sv = NULL ;
121
128
122
- DEBUG_L (PerlIO_printf (Perl_debug_log , "Locale radix is '%s', ?UTF-8=%d\n" ,
129
+ #ifdef DEBUGGING
130
+ if (DEBUG_L_TEST || debug_initialization ) {
131
+ PerlIO_printf (Perl_debug_log , "Locale radix is '%s', ?UTF-8=%d\n" ,
123
132
(PL_numeric_radix_sv )
124
133
? SvPVX (PL_numeric_radix_sv )
125
134
: "NULL" ,
126
135
(PL_numeric_radix_sv )
127
136
? cBOOL (SvUTF8 (PL_numeric_radix_sv ))
128
- : 0 ));
137
+ : 0 );
138
+ }
139
+ #endif
129
140
130
141
# endif /* HAS_LOCALECONV */
131
142
#endif /* USE_LOCALE_NUMERIC */
@@ -230,8 +241,12 @@ Perl_set_numeric_standard(pTHX)
230
241
PL_numeric_standard = TRUE;
231
242
PL_numeric_local = isNAME_C_OR_POSIX (PL_numeric_name );
232
243
set_numeric_radix ();
233
- DEBUG_L (PerlIO_printf (Perl_debug_log ,
234
- "Underlying LC_NUMERIC locale now is C\n" ));
244
+ #ifdef DEBUGGING
245
+ if (DEBUG_L_TEST || debug_initialization ) {
246
+ PerlIO_printf (Perl_debug_log ,
247
+ "Underlying LC_NUMERIC locale now is C\n" );
248
+ }
249
+ #endif
235
250
236
251
#endif /* USE_LOCALE_NUMERIC */
237
252
}
@@ -250,9 +265,13 @@ Perl_set_numeric_local(pTHX)
250
265
PL_numeric_standard = isNAME_C_OR_POSIX (PL_numeric_name );
251
266
PL_numeric_local = TRUE;
252
267
set_numeric_radix ();
253
- DEBUG_L (PerlIO_printf (Perl_debug_log ,
268
+ #ifdef DEBUGGING
269
+ if (DEBUG_L_TEST || debug_initialization ) {
270
+ PerlIO_printf (Perl_debug_log ,
254
271
"Underlying LC_NUMERIC locale now is %s\n" ,
255
- PL_numeric_name ));
272
+ PL_numeric_name );
273
+ }
274
+ #endif
256
275
257
276
#endif /* USE_LOCALE_NUMERIC */
258
277
}
@@ -884,24 +903,6 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
884
903
const char * const setlocale_init = (PerlEnv_getenv ("PERL_SKIP_LOCALE_INIT" ))
885
904
? NULL
886
905
: "" ;
887
- #ifdef DEBUGGING
888
- const bool debug = (PerlEnv_getenv ("PERL_DEBUG_LOCALE_INIT" ))
889
- ? TRUE
890
- : FALSE;
891
- # define DEBUG_LOCALE_INIT (category , locale , result ) \
892
- STMT_START { \
893
- if (debug) { \
894
- PerlIO_printf(Perl_debug_log, \
895
- "%s:%d: %s\n", \
896
- __FILE__, __LINE__, \
897
- _setlocale_debug_string(category, \
898
- locale, \
899
- result)); \
900
- } \
901
- } STMT_END
902
- #else
903
- # define DEBUG_LOCALE_INIT (a ,b ,c )
904
- #endif
905
906
const char * trial_locales [5 ]; /* 5 = 1 each for "", LC_ALL, LANG, "", C */
906
907
unsigned int trial_locales_count ;
907
908
const char * const lc_all = savepv (PerlEnv_getenv ("LC_ALL" ));
@@ -932,6 +933,25 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
932
933
const char * system_default_locale = NULL ;
933
934
#endif
934
935
936
+ #ifdef DEBUGGING
937
+ debug_initialization = (PerlEnv_getenv ("PERL_DEBUG_LOCALE_INIT" ))
938
+ ? TRUE
939
+ : FALSE;
940
+ # define DEBUG_LOCALE_INIT (category , locale , result ) \
941
+ STMT_START { \
942
+ if (debug_initialization) { \
943
+ PerlIO_printf(Perl_debug_log, \
944
+ "%s:%d: %s\n", \
945
+ __FILE__, __LINE__, \
946
+ _setlocale_debug_string(category, \
947
+ locale, \
948
+ result)); \
949
+ } \
950
+ } STMT_END
951
+ #else
952
+ # define DEBUG_LOCALE_INIT (a ,b ,c )
953
+ #endif
954
+
935
955
#ifndef LOCALE_ENVIRON_REQUIRED
936
956
PERL_UNUSED_VAR (done );
937
957
PERL_UNUSED_VAR (locale_param );
@@ -1370,6 +1390,11 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
1370
1390
PERL_UNUSED_ARG (printwarn );
1371
1391
#endif /* USE_LOCALE */
1372
1392
1393
+ #ifdef DEBUGGING
1394
+ /* So won't continue to output stuff */
1395
+ debug_initialization = FALSE;
1396
+ #endif
1397
+
1373
1398
return ok ;
1374
1399
}
1375
1400
0 commit comments