__UNDEFINED__ Perl_setlocale LOCK_NUMERIC_STANDARD UNLOCK_NUMERIC_STANDARD

#if PERL_VERSION_LT(5,27,9) __UNDEFINED__ LC_NUMERIC_LOCK __UNDEFINED__ LC_NUMERIC_UNLOCK # if PERL_VERSION_LT(5,19,0) # undef STORE_LC_NUMERIC_SET_STANDARD # undef RESTORE_LC_NUMERIC # undef DECLARATION_FOR_LC_NUMERIC_MANIPULATION # ifdef USE_LOCALE __UNDEFINED__ DECLARATION_FOR_LC_NUMERIC_MANIPULATION char *LoC_ __UNDEFINED__ STORE_NUMERIC_SET_STANDARD() \ LoC_ = savepv(setlocale(LC_NUMERIC, NULL)); \ SAVEFREEPV(LoC_); \ setlocale(LC_NUMERIC, "C"); __UNDEFINED__ RESTORE_LC_NUMERIC() \ setlocale(LC_NUMERIC, LoC_); # else __UNDEFINED__ DECLARATION_FOR_LC_NUMERIC_MANIPULATION __UNDEFINED__ STORE_LC_NUMERIC_SET_STANDARD() __UNDEFINED__ RESTORE_LC_NUMERIC() # endif # endif #endif

#ifndef LOCK_NUMERIC_STANDARD # define LOCK_NUMERIC_STANDARD() #endif

#ifndef UNLOCK_NUMERIC_STANDARD # define UNLOCK_NUMERIC_STANDARD() #endif

/* The names of these changed in 5.28 */ __UNDEFINED__ LOCK_LC_NUMERIC_STANDARD LOCK_NUMERIC_STANDARD __UNDEFINED__ UNLOCK_LC_NUMERIC_STANDARD UNLOCK_NUMERIC_STANDARD

/* If this doesn't exist, it's not needed, so is void noop */ __UNDEFINED__ switch_to_global_locale()

/* Originally, this didn't return a value, but in perls like that, the value * should always be TRUE. Add a return to Perl_sync_locale() when it's * available. And actually do a sync when its not, if locales are available on * this system. */ #ifdef sync_locale # if { VERSION < 5.27.9 } # if { VERSION >= 5.21.3 } # undef sync_locale # define sync_locale() (Perl_sync_locale(aTHX), 1) # elif defined(sync_locale) /* These should only be the 5.20 maints*/ # undef sync_locale /* Just copy their defn and return 1 */ # define sync_locale() (new_ctype(setlocale(LC_CTYPE, NULL)), \ new_collate(setlocale(LC_COLLATE, NULL)), \ set_numeric_local(), \ new_numeric(setlocale(LC_NUMERIC, NULL)), \ 1) # elif defined(new_ctype) && defined(LC_CTYPE) # define sync_locale() (new_ctype(setlocale(LC_CTYPE, NULL)), 1) # endif # endif #endif

__UNDEFINED__ sync_locale() 1

/* Warning: Perl_setlocale * This function will compile and run in even the earliest perls supported by * PPPort, but there were significant locale-related bugs that may prevent its * proper operation until v5.22. The final bugs to be fixed in the releases * leading up to that one involved setting and querying the locale for * LC_NUMERIC. */

#if { VERSION < 5.27.2 } # if { NEED Perl_setlocale }

const char * Perl_setlocale(const int category, const char * locale) { CV * setlocale; dTHX;

# ifdef D_PPP_usechar

char * locale_afterwards;
dSP;

# else

SV * locale_afterwards;
dXSARGS;

# endif

load_module(PERL_LOADMOD_NOIMPORT, newSVpvs("POSIX"), NULL);
setlocale = get_cv("POSIX::setlocale", 0);
assert(setlocale);

# if defined(PUSHSTACKi) && defined(PERLSI_REQUIRE) && defined(POPSTACK)

PUSHSTACKi(PERLSI_REQUIRE);

# endif

ENTER ;
SAVETMPS;

PUSHMARK(SP) ;
mXPUSHi(category);
mXPUSHp(locale, strlen(locale));
PUTBACK;
call_sv(MUTABLE_SV(setlocale), G_SCALAR);

SPAGAIN ;

# ifdef D_PPP_usechar

locale_afterwards = POPp;

# else

locale_afterwards = POPs;
SvREFCNT_inc_simple_void_NN(locale_afterwards);

# endif

PUTBACK ;
FREETMPS ;
LEAVE ;

# if defined(PUSHSTACKi) && defined(PERLSI_REQUIRE) && defined(POPSTACK)

POPSTACK;

# endif # ifdef D_PPP_usechar

return(locale_afterwards);

# else

if (! SvPOK(locale_afterwards)) {
    XSRETURN_UNDEF;
}

return(savepv(SvPVX_const(locale_afterwards)));

# endif

}

# endif #endif

#define NEED_Perl_setlocale

bool sync_locale() CODE: RETVAL = sync_locale(); OUTPUT: RETVAL

char * Perl_setlocale(locale = 0) char * locale PREINIT: char * retval; CODE: /*const in input not valid in 5.7.0 */ retval = (char *) Perl_setlocale(LC_ALL, locale); if (! retval) { XSRETURN_UNDEF; } RETVAL = retval; OUTPUT: RETVAL

use Config;

# We don't know for sure that we are in the global locale for testing. But # if this is unthreaded, it almost certainly is. But Configure can be called # to force POSIX locales on unthreaded systems. If this becomes a problem # this check could be beefed up. if ($Config{usethreads}) { ok(1, "ironically we have to skip testing sync_locale under threads"); } else { ok(&Devel::PPPort::sync_locale(), "sync_locale returns TRUE"); }

is(&Devel::PPPort::Perl_setlocale("C"), "C", "setlocale returns 'C' when setting to 'C'");

cpanm ATOOMIC/Devel-PPPort-3.60_01.tar.gz

perl -MCPAN -e shell
install ATOOMIC/Devel-PPPort-3.60_01.tar.gz