switch_locale_context: Add aTHX

This fixes GH #21040

Instead of a dTHX, this passes aTHX automatically, and skips calling
this function if there is no valid context.

It moves that decision into the macro itself, avoiding some #ifdef
directives.

And it adds explanation

diff --git a/dist/threads/lib/threads.pm b/dist/threads/lib/threads.pm
index 2c02ba3..f877517 100644 (file)
--- a/dist/threads/lib/threads.pm
+++ b/dist/threads/lib/threads.pm
@@ -5,7 +5,7 @@ use 5.008;
 use strict;
 use warnings;
 
-our $VERSION = '2.38';      # remember to update version in POD!
+our $VERSION = '2.39';      # remember to update version in POD!
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -134,7 +134,7 @@ threads - Perl interpreter-based threads
 
 =head1 VERSION
 
-This document describes threads version 2.38
+This document describes threads version 2.39
 
 =head1 WARNING
 

diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs
index 82b725a..43818ce 100644 (file)
--- a/dist/threads/threads.xs
+++ b/dist/threads/threads.xs
@@ -193,9 +193,6 @@ S_ithread_set(pTHX_ ithread *thread)
 {
     dMY_CXT;
     MY_CXT.context = thread;
-#ifdef PERL_SET_NON_tTHX_CONTEXT
-    PERL_SET_NON_tTHX_CONTEXT(thread->interp);
-#endif
 }
 
 STATIC ithread *

diff --git a/embed.fnc b/embed.fnc
index b32739c..dd0e9f1 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -6226,7 +6226,7 @@ Adhp      |SSize_t|PerlIO_write   |NULLOK PerlIO *f                       \
                                |Size_t count
 #endif /* defined(USE_PERLIO) */
 #if defined(USE_PERL_SWITCH_LOCALE_CONTEXT)
-CTop   |void   |switch_locale_context
+Cop    |void   |switch_locale_context
 #endif
 #if defined(USE_QUADMATH)
 Tdp    |bool   |quadmath_format_needed                                 \

diff --git a/locale.c b/locale.c
index 617119f..20d4939 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -8538,19 +8538,38 @@ S_my_setlocale_debug_string_i(pTHX_
 #ifdef USE_PERL_SWITCH_LOCALE_CONTEXT
 
 void
-Perl_switch_locale_context()
+Perl_switch_locale_context(pTHX)
 {
     /* libc keeps per-thread locale status information in some configurations.
      * So, we can't just switch out aTHX to switch to a new thread.  libc has
      * to follow along.  This routine does that based on per-interpreter
-     * variables we keep just for this purpose */
-
-    /* Can't use pTHX, because we may be called from a place where that
-     * isn't available */
-    dTHX;
+     * variables we keep just for this purpose.
+     *
+     * There are two implementations where this is an issue.  For the other
+     * implementations, it doesn't matter because libc is using global values
+     * that all threads know about.
+     *
+     * The two implementations are where libc keeps thread-specific information
+     * on its own.  These are
+     *
+     * POSIX 2008:  The current locale is kept by libc as an object.  We save
+     *              a copy of that in the per-thread PL_cur_locale_obj, and so
+     *              this routine uses that copy to tell the thread it should be
+     *              operating with that object
+     * Windows thread-safe locales:  A given thread in Windows can be being run
+     *              with per-thread locales, or not.  When the thread context
+     *              changes, libc doesn't automatically know if the thread is
+     *              using per-thread locales, nor does it know what the new
+     *              thread's locale is.  We keep that information in the
+     *              per-thread variables:
+     *                  PL_controls_locale  indicates if this thread is using
+     *                                      per-thread locales or not
+     *                  PL_cur_LC_ALL       indicates what the the locale
+     *                                      should be if it is a per-thread
+     *                                      locale.
+     */
 
-    if (UNLIKELY(   aTHX == NULL
-                 || PL_veto_switch_non_tTHX_context
+    if (UNLIKELY(   PL_veto_switch_non_tTHX_context
                  || PL_phase == PERL_PHASE_CONSTRUCT))
     {
         return;

diff --git a/perl.h b/perl.h
index 6acabfc..54b3cee 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -6359,21 +6359,21 @@ EXTCONST U8   PL_deBruijn_bitpos_tab64[];
 #ifdef USE_PERL_SWITCH_LOCALE_CONTEXT
 #  define PERL_SET_LOCALE_CONTEXT(i)                                        \
       STMT_START {                                                          \
-          if (UNLIKELY(PL_veto_switch_non_tTHX_context))                    \
-                Perl_switch_locale_context();                               \
+          if (LIKELY(! PL_veto_switch_non_tTHX_context))                    \
+                Perl_switch_locale_context(i);                              \
       } STMT_END
+
+    /* In some Configurations there may be per-thread information that is
+     * carried in a library instead of perl's tTHX structure.  This macro is to
+     * be used to handle those when tTHX is changed.  Only locale handling is
+     * currently known to be affected. */
+#  define PERL_SET_NON_tTHX_CONTEXT(i)                                      \
+            STMT_START { if (i) PERL_SET_LOCALE_CONTEXT(i); } STMT_END
 #else
-#  define PERL_SET_LOCALE_CONTEXT(i)  NOOP
+#  define PERL_SET_LOCALE_CONTEXT(i)   NOOP
+#  define PERL_SET_NON_tTHX_CONTEXT(i) NOOP
 #endif
 
-/* In some Configurations there may be per-thread information that is carried
- * in a library instead of perl's tTHX structure.  This macro is to be used to
- * handle those when tTHX is changed.  Only locale handling is currently known
- * to be affected. */
-#define PERL_SET_NON_tTHX_CONTEXT(i)                                        \
-                        STMT_START { PERL_SET_LOCALE_CONTEXT(i); } STMT_END
-
-
 #ifndef PERL_GET_CONTEXT
 #  define PERL_GET_CONTEXT             PERL_GET_INTERP
 #endif

diff --git a/proto.h b/proto.h
index 23017e4..a3da63c 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -10642,7 +10642,7 @@ Perl_PerlIO_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
 #endif /* defined(USE_PERLIO) */
 #if defined(USE_PERL_SWITCH_LOCALE_CONTEXT)
 PERL_CALLCONV void
-Perl_switch_locale_context(void);
+Perl_switch_locale_context(pTHX);
 # define PERL_ARGS_ASSERT_SWITCH_LOCALE_CONTEXT
 
 #endif

diff --git a/util.c b/util.c
index c7efba0..60929fc 100644 (file)
--- a/util.c
+++ b/util.c
@@ -3587,7 +3587,7 @@ Perl_set_context(void *t)
     }
 #  endif
 
-    PERL_SET_NON_tTHX_CONTEXT(t);
+    PERL_SET_NON_tTHX_CONTEXT((PerlInterpreter *) t);
 
 #else
     PERL_UNUSED_ARG(t);

diff --git a/win32/win32thread.c b/win32/win32thread.c
index 1f327d6..023f3a5 100644 (file)
--- a/win32/win32thread.c
+++ b/win32/win32thread.c
@@ -11,6 +11,7 @@ Perl_set_context(void *t)
 #if defined(USE_ITHREADS)
 #  ifdef USE_DECLSPEC_THREAD
     Perl_current_context = t;
+    PERL_SET_NON_tTHX_CONTEXT(t);
 #  else
     DWORD err = GetLastError();
     TlsSetValue(PL_thr_key,t);