diff --git a/cpan/Time-Piece/Piece.xs b/cpan/Time-Piece/Piece.xs index 23bca50e5b67..ceec34fdfebb 100644 --- a/cpan/Time-Piece/Piece.xs +++ b/cpan/Time-Piece/Piece.xs @@ -47,6 +47,8 @@ extern "C" { # define TZSET_UNLOCK ENV_UNLOCK #endif +/* XXX bunch of other locks need, tzset putenv, getenv; haven't looked */ + #ifdef WIN32 /* @@ -119,6 +121,7 @@ extern "C" { #undef malloc #undef free +/* Should call the one in Posix:: */ static void fix_win32_tzenv(void) { @@ -824,6 +827,7 @@ label: return 0; len = (c == 'Y') ? 4 : 2; + /* XXX note this is a bug is isdigit, subtracting '0' because could be another set of 10. */ for (i = 0; len && *buf != 0 && isDIGIT((unsigned char)*buf); buf++) { i *= 10; i += *buf - '0'; @@ -1014,6 +1018,10 @@ _strftime(fmt, epoch, islocal = 1) len = strftime(tmpbuf, TP_BUF_SIZE, fmt, &mytm); STRFTIME_UNLOCK; + /* char * Perl_my_strftime(aTHX_ fmt, int sec, int min, + int hour, int mday, int mon, int year, + int wday, int yday, int isdst) + */ /* ** The following is needed to handle to the situation where ** tmpbuf overflows. Basically we want to allocate a buffer diff --git a/dist/ExtUtils-ParseXS/lib/perlxs.pod b/dist/ExtUtils-ParseXS/lib/perlxs.pod index add3837403c9..0f39e911a09c 100644 --- a/dist/ExtUtils-ParseXS/lib/perlxs.pod +++ b/dist/ExtUtils-ParseXS/lib/perlxs.pod @@ -2807,9 +2807,11 @@ thread using an alien library without a problem; but no more than a single thread can be so-occupied. Bad results likely will happen. In perls without multi-thread locale support, some alien libraries, -such as C change locales. This can cause problems for the Perl -core and other modules. For these, before control is returned to -perl, starting in v5.20.1, calling the function +such as C (including C) change locales. This can cause problems +for the Perl core and other modules. Unless C +has been called as described above, these libraries won't know what the +current locale Perl has set actually is. But also, before control is +returned to perl, starting in v5.20.1, calling the function L from XS should be sufficient to avoid most of these problems. Prior to this, you need a pure Perl statement that does this: diff --git a/handy.h b/handy.h index 27ff00e8e8de..08fae9c3500f 100644 --- a/handy.h +++ b/handy.h @@ -1858,6 +1858,7 @@ END_EXTERN_C #define toUPPER_LATIN1_MOD(c) ((! FITS_IN_8_BITS(c)) \ ? (c) \ : PL_mod_latin1_uc[ (U8) (c) ]) +/* valid XXX */ #define IN_UTF8_CTYPE_LOCALE PL_in_utf8_CTYPE_locale /* Use foo_LC_uvchr() instead of these for beyond the Latin1 range */ diff --git a/iperlsys.h b/iperlsys.h index 5ef7f23542d8..e3d301c18e5e 100644 --- a/iperlsys.h +++ b/iperlsys.h @@ -1387,6 +1387,7 @@ struct IPerlSockInfo #define PerlSock_bind(s, n, l) bind(s, n, l) #define PerlSock_connect(s, n, l) connect(s, n, l) +/* XXX Locks */ #define PerlSock_gethostbyaddr(a, l, t) gethostbyaddr(a, l, t) #define PerlSock_gethostbyname(n) gethostbyname(n) #define PerlSock_gethostent gethostent diff --git a/locale.c b/locale.c index 2b70cddb751b..06492ebf023d 100644 --- a/locale.c +++ b/locale.c @@ -1,5 +1,5 @@ /* locale.c - * + * XXX other workspace has stashes that we need to potentially incorporate, including the NL_LOCALE for setlocale("" no querylocale) * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, * 2002, 2003, 2005, 2006, 2007, 2008 by Larry Wall and others * @@ -27,7 +27,7 @@ * any attention to it except within the scope of a 'use locale'. For most * categories, it accomplishes this by just using different operations if it is * in such scope than if not. However, various libc functions called by Perl - * are affected by the LC_NUMERIC category, so there are macros in perl.h that + * are affected by the XXX LC_NUMERIC category, so there are macros in perl.h that * are used to toggle between the current locale and the C locale depending on * the desired behavior of those functions at the moment. And, LC_MESSAGES is * switched to the C locale for outputting the message unless within the scope @@ -1093,7 +1093,10 @@ S_emulate_setlocale_i(pTHX_ { /* This function effectively performs a setlocale() on just the current * thread; thus it is thread-safe. It does this by using the POSIX 2008 - * locale functions to emulate the behavior of setlocale(). Similar to + * locale functions to emulate the behavior of setlocale(). + * + * XXX + * Similar to * regular setlocale(), the return from this function points to memory that * can be overwritten by other system calls, so needs to be copied * immediately if you need to retain it. The difference here is that @@ -1396,6 +1399,7 @@ S_stdize_locale(pTHX_ const int category, } else { made_changes = TRUE; + } } } @@ -1846,6 +1850,7 @@ Perl_set_numeric_standard(pTHX) DEBUG_L(PerlIO_printf(Perl_debug_log, "Setting LC_NUMERIC locale to standard C\n")); + /* Maybe not in init? assert(PL_locale_mutex_depth > 0);*/ void_setlocale_c(LC_NUMERIC, "C"); PL_numeric_standard = TRUE; @@ -1873,6 +1878,7 @@ 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(LC_NUMERIC, PL_numeric_name); PL_numeric_underlying = TRUE; @@ -2603,6 +2609,7 @@ configurations. C should not be used to change the locale except on systems where the predefined variable C<${^SAFE_LOCALES}> is 1. On some such systems, the system C is ineffective, returning the wrong information, and +XXX failing to actually change the locale. C, however works properly in all circumstances. @@ -4602,6 +4609,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn) #else /* USE_LOCALE */ # ifdef __GLIBC__ + /* This has priority over everything else XXX in "" on Debian, so querylocale really should be used on such boxes */ const char * const language = PerlEnv_getenv("LANGUAGE"); # endif diff --git a/perl.h b/perl.h index b284a65cb167..71cdff2c0b24 100644 --- a/perl.h +++ b/perl.h @@ -6639,7 +6639,8 @@ the plain locale pragma without a parameter (S>) is in effect. #else /* Below: Threaded, and locales are supported */ - /* A locale mutex is required on all such threaded builds. + /* A locale mutex is required on all such threaded builds, if only for + * certain rare cases (which you can grep for). * * This mutex simulates a general (or recursive) semaphore. The current * thread will lock the mutex if the per-thread variable is zero, and then @@ -7069,6 +7070,7 @@ cannot have changed since the precalculation. (! PL_numeric_underlying && PL_numeric_standard < 2) # define DECLARATION_FOR_LC_NUMERIC_MANIPULATION \ + /* XXX note can remove #ifdefs around this */\ void (*_restore_LC_NUMERIC_function)(pTHX) = NULL # define STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in) \ @@ -7108,6 +7110,7 @@ cannot have changed since the precalculation. * this is what is needed */ # define SET_NUMERIC_STANDARD() \ STMT_START { \ + /*assert(PL_locale_mutex_depth > 0);*/ \ DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ "%s: %d: lc_numeric standard=%d\n", \ __FILE__, __LINE__, PL_numeric_standard)); \ diff --git a/pod/perllocale.pod b/pod/perllocale.pod index 8354fe222a11..6874c5edb672 100644 --- a/pod/perllocale.pod +++ b/pod/perllocale.pod @@ -1677,7 +1677,10 @@ more bugs. XS code or C-language libraries called from it that use the system L> function (except on Windows) likely will not work from a multi-threaded application without changes. See -L. +L. Some such have been so changed, but +call C libraries that can't be changed. This will work, but as long as +only a single thread in your application uses such a library. C is +one such library. An XS module that is locale-dependent could have been written under the assumption that it will never be called in a multi-threaded environment, diff --git a/regen/reentr.pl b/regen/reentr.pl index 5742278fe99c..8ee209fb2453 100644 --- a/regen/reentr.pl +++ b/regen/reentr.pl @@ -705,6 +705,7 @@ sub define { } # This needs a special case, see its definition in config.h + # XXX my $setup = ($func eq 'localtime') ? "L_R_TZSET " : ""; my $call = "$setup${func}_r($v$w)"; diff --git a/regexec.c b/regexec.c index 0d881c9aeb19..6eefa76a43a1 100644 --- a/regexec.c +++ b/regexec.c @@ -11205,6 +11205,7 @@ Perl_isSCRIPT_RUN(pTHX_ const U8 * s, const U8 * send, const bool utf8_target) PERL_UINT_FAST8_T intersection_len = 0; bool retval = TRUE; + /* Why isn't this a parameter XXX */ SCX_enum * ret_script = NULL; assert(send >= s); diff --git a/util.c b/util.c index 92b1bdbaab27..ff6170459f19 100644 --- a/util.c +++ b/util.c @@ -2576,6 +2576,7 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val) const Size_t vlen = strlen(val); char * const new_env = S_env_alloc(NULL, nlen, vlen, 2, 1); my_setenv_format(new_env, nam, nlen, val, vlen); + /* Why no mutex XXX */ (void)putenv(new_env); } @@ -2591,6 +2592,7 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val) new_env = S_env_alloc(NULL, nlen, vlen, 2, 1); /* all that work just for this */ my_setenv_format(new_env, nam, nlen, val, vlen); + /* Why no mutex XXX */ (void)putenv(new_env); # endif /* MY_HAS_SETENV */ @@ -4167,6 +4169,7 @@ Perl_my_strftime(pTHX_ const char *fmt, int sec, int min, int hour, int mday, in =for apidoc my_strftime strftime(), but with a different API so that the return value is a pointer to the formatted result (which MUST be arranged to be FREED BY THE +XXX why not a PL_buffer CALLER). This allows this function to increase the buffer size as needed, so that the caller doesn't have to worry about that.