__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