In perl.git, the branch maint-5.28 has been updated <https://perl5.git.perl.org/perl.git/commitdiff/a4c8b6b67dc8a5ef3c7c49e84b78c39253e4e8d2?hp=fd79d2dc227f95baade4fe63e9ed57279357d58d>
- Log ----------------------------------------------------------------- commit a4c8b6b67dc8a5ef3c7c49e84b78c39253e4e8d2 Author: Tony Cook <[email protected]> Date: Thu Mar 14 10:19:04 2019 +1100 there is no sv_catpvfn() Replace in various documentation and messages appropriately. (cherry picked from commit 26b0dc0c52fbcb48a1f10935a8dd8f0b0d4c9209) commit 5d99c4d474abd6e1d2252b7c1282babbe8b66b4a Author: Tina Müller <[email protected]> Date: Mon Jul 16 13:10:24 2018 +0200 Fix typo: IS_NUMBER_INFINITE -> IS_NUMBER_INFINITY For: RT # 133380 Committer: Tina Müller is now a Perl AUTHOR. (cherry picked from commit 5962c2f672495234bec14ab5427cba5b2ccb2e33) commit c59e4cda6c9e5492dd087e3ffd5b4879e97aae14 Author: Karl Williamson <[email protected]> Date: Mon Jul 16 18:34:49 2018 -0600 perlapi: AvFILL isn't deprecated See [perl #133278] (cherry picked from commit d29fa84aee8bfff9c27f68ec2d9292e1370e0924) commit 0151407b3fb249b30998f950a9a275259a3f5948 Author: Andy Dougherty <[email protected]> Date: Thu Jan 31 14:05:41 2019 -0500 Define _GNU_SOURCE if using the musl libc on linux. Together with prior commits ba73a4cb8f, f8d82a1010, and 63c1fa6a98, this should close [perl #133760]. (cherry picked from commit 04db542212fdad3a62f13afe741c99028f4bf799) commit d1527667bc3799b51cc18df51b90099d5293f8ad Author: Andy Dougherty <[email protected]> Date: Thu Jan 31 13:04:32 2019 -0500 Improve detection of memrchr, strlcat, and strlcpy. This is continuation of commit f8d82a1010 addressing [perl #133760]. Linux systems using the musl C library have memmem, memrchr, strlcat, and strlcpy, but the prototypes are only visible if _GNU_SOURCE is defined. This patch makes Configure test both whether the prototype is visible and whether the C symbol is visible. Still to be done is automatically adding _GNU_SOURCE if the musl library is being used -- probably in hints/linux.sh. (cherry picked from commit ba73a4cb8f472480a2d630613d1e9e1172d518d3) commit 85defe5657e2c0da227947b371b7139a47236462 Author: Andy Dougherty <[email protected]> Date: Wed Jan 23 21:39:39 2019 -0500 Another attempt to improve Configure detection of memmem() [perl #133760]. This updates commit ca152fd8207cf53816b1407d5f54f6ea160a3ef8. Linux systems have memmem, but the prototype in <string.h> is only visible if __GNU_SOURCE is defined. This version tests for both the prototype in <string.h> and the symbol in libc. (Thanks to Tony C. for the suggestion.) (For BSD systems, no extra define is needed.) (cherry picked from commit f8d82a1010426d0eb49c33cb903413b882c85c3e) commit 9a0402f4d0baa247bba0a5f8ab766b6e0290a5fc Author: Andy Dougherty <[email protected]> Date: Tue Jan 22 14:17:05 2019 -0500 Improve Configure detection of memmem() [perl #133760]. Linux systems have memmem, but the header prototype is only visible if the C library, but didn't check if the correct prototype is available. This patch compiles & runs a test program that will fail if the prototype is needed but not available. This does not completely close [perl #133760]. The tests for strlcat() and strlcpy() may also need to be similarly changed. Also, this patch does not change whether _GNU_SOURCE is defined or not. Presumably that would be done separately in the linux hints file. (cherry picked from commit ca152fd8207cf53816b1407d5f54f6ea160a3ef8) commit f90ab1600d29887c86a7e11c54889a82ad971662 Author: Andy Dougherty <[email protected]> Date: Wed Jan 23 21:12:29 2019 -0500 Add ability to include literal text in the prototype check. This is the same technique as in the metaconfig unit Protochk.U. See that unit for more usage information. It is a bit clunky, but does work. (cherry picked from commit 63c1fa6a98bc60234a21de83dd191cd581a5d073) commit 9d86603b47b701ef1a37be8266694e104445b0c5 Author: David Mitchell <[email protected]> Date: Wed Oct 17 15:10:10 2018 +0100 fix 'for reverse @array' bug on AIX RT #133558 Due to what appears to be a compiler bug on AIX (or perhaps it's undefined behaviour which happens to work on other platforms), this line of code in pp_iter(): inc = 1 - (PL_op->op_private & OPpITER_REVERSED); was setting inc to 4294967295 rather than to the expected -1 (inc was a 64-bit signed long). Fix it with a couple of judicious (IV) casts (which ought to be a NOOP). (cherry picked from commit d6139ec4a9065ae249ab512398326a70dfb2fea2) commit 88efce38149481334db7ddb932f9b74eaaa9765b Author: Tony Cook <[email protected]> Date: Thu Oct 4 14:41:03 2018 +1000 (perl #127606) adjust dependency paths on installation on darwin SIP (System Integrity Protection) on OS X prevents the DYLD_LIBRARY_PATH environment variable from being propagated through /bin/sh, causes many tests to fail (and some more recent build issues) for -Duseshrplib builds. To avoid that, we change the way libperl.dylib is linked to perl, so for the initial build the library's id is at the build location rather than the install location, and the generated executable also expects to find libperl in that location. This obviously won't work once we copy both to the installation directory, so we adjust both the id of the library and the dependency path in the executable to point to the new location of the library. A previous attempt set -rpath and used @rpath in the id, but this made the embedding test fail. (cherry picked from commit 191f8909fa4eca1db16a91ada42dd4a065c04890) commit dd4f2e4b8b5a0802beb673fe4bc6d2609e06e2f5 Author: Tony Cook <[email protected]> Date: Mon Jul 30 21:00:52 2018 +1000 (perl #133411) don't try to load Storable with -Dusecrosscompile (cherry picked from commit edf639fce3e8c8852ee4179ab902b357b1deba98) commit cc4fcc275d00b7ab08f262873d4a2a5660fdfdb5 Author: Steve Hay <[email protected]> Date: Fri Aug 24 14:55:45 2018 +0100 Fix Windows build with CCTYPE=SDK2003SP1 The Platform SDK 2003 SP1 x64 compiler has _MSC_VER 1400 like MSVC80, but doesn't define _configthreadlocale() in the /MD (MSVCRT.DLL) version of the CRT used by perl. (Compare C:\Program Files\Microsoft Platform SDK for Windows Server 2003 R2\src\crt\setlocal.c with C:\Program Files (x86)\ Microsoft Visual Studio 8\VC\crt\src\setlocal.c. The latter always defines _configthreadlocale(), but the former only does so when _MT is defined.) (cherry picked from commit b79cd7dfefcc16674b83ffdeb11687ea693b7845) commit 052b6f40349f3db2931d8b9200987d94160b6ff7 Author: Aaron Crane <[email protected]> Date: Tue Oct 9 14:41:10 2018 +0100 RT#133573: $^X fallback when platform-specific technique fails (cherry picked from commit 03b94aa47e981af3c7b0118bfb11facda2b95251) commit 26109f4bf06e8b9059b1ccd49877e24c70cd2a9f Author: Steve Hay <[email protected]> Date: Tue Apr 2 12:21:04 2019 +0100 $VERSION++ for previous cherry-pick (Version 3.09 was already used elsewhere, hence the need for the _01) commit 8ed979a883c79b465a8d62e72312cba957108ccb Author: Tony Cook <[email protected]> Date: Tue Aug 7 15:34:06 2018 +1000 (perl #133326) fix and clarify handling of recurs_sv. There were a few problems: - the purpose of recur_sv wasn't clear, I believe I understand it now from looking at where recur_sv was actually being used. Frankly the logic of the code itself was hard to follow, apparently only counting a level if the recur_sv was equal to the current SV. Fixed by adding some documentation to recur_sv in the context structure. The logic has been re-worked (see below) to hopefully make it more understandable. - the conditional checks for inc/decrementing recur_depth didn't match between the beginnings and ends of the store_array() and store_hash() handlers didn't match, since recur_sv was both explicitly modified by those functions and implicitly modified in their recursive calls to process elements. Fixing by storing the starting value of cxt->recur_sv locally testing against that instead of against the value that might be modified recursively. - the checks in store_ref(), store_array(), store_l?hash() were over complex, obscuring their purpose. Fixed by: - always count a recursion level in store_ref() and store the RV in recur_sv - only count a recursion level in the array/hash handlers if the SV didn't match. - skip the check against cxt->entry, if we're in this code we could be recursing, so we want to detect it. - (after the other changes) the recursion checks in store_hash()/ store_lhash() only checked the limit if the SV didn't match the recur_sv, which horribly broke things. Fixed by: - Now only make the depth increment conditional, and always check against the limit if one is set. (cherry picked from commit 120060c86e233cb9f588314214137f3ed1b48e2a) commit f6f437abe6ca6dec887099a763a10d5dced15b71 Author: Tony Cook <[email protected]> Date: Wed Aug 8 14:21:33 2018 +1000 (perl #133422) handle Off_t smaller than size_t (cherry picked from commit b9965e1496efe3cb6116e74d50aa83152c70e877) commit 9f6706159c74bc4e54862ad6669ff9fe7f6f4edc Author: Tony Cook <[email protected]> Date: Wed Feb 6 10:37:58 2019 +1100 (perl #133778) adjust MARK if we extend the stack in pp_repeat for a list repeat in scalar/void context (cherry picked from commit d81b77352f66acde60db1b056b8eb3321b7b55fe) commit 068de6b3983d5339e978256cf8476ef3d0add41f Author: Tony Cook <[email protected]> Date: Wed Aug 23 14:18:26 2017 +1000 (perl #131562) correct large line numbers copying eval lines on #line Previously this used I32 for line numbers, which takes half the range of line_t and folds it into negative numbers, leading to trying to store the lines at negative indexes. The while loop was also modified to stop storing if/when the line number no longer fits into cop_line, or no longer fits into SSize_t (as a positive number) since the index parameter to av_store() is a SSize_t. (cherry picked from commit 515c395bcca24c55c85b5aeea239e5e836c36059) commit 99b39506d91c9659ff8a1a995cc7cd769158a296 Author: Tony Cook <[email protected]> Date: Tue Apr 2 12:16:54 2019 +0100 (perl #132158) abort compilation if we see an error compiling a form (cherry picked from commit 817480137a8b1165315f21d14b8968862101c3a2) ----------------------------------------------------------------------- Summary of changes: AUTHORS | 1 + Configure | 85 +++++++++++++++++++++++++++++++++---- Makefile.SH | 34 ++++++++++++++- av.h | 2 +- caretx.c | 28 +++++++------ dist/Storable/Makefile.PL | 9 +++- dist/Storable/Storable.xs | 98 +++++++++++++++++++++++++++---------------- dist/Storable/__Storable__.pm | 2 +- dist/Storable/stacksize | 10 +++-- dist/Storable/t/recurse.t | 16 ++++++- ext/PerlIO-scalar/scalar.pm | 2 +- ext/PerlIO-scalar/scalar.xs | 11 ++++- ext/XS-APItest/t/svcatpvf.t | 2 +- hints/linux.sh | 10 +++++ installperl | 25 +++++++++++ numeric.c | 4 +- pod/perldiag.pod | 4 +- pp.c | 3 +- pp_hot.c | 4 +- sv.c | 12 +++--- t/lib/croak/toke | 9 ++++ t/op/for.t | 16 ++++++- t/op/repeat.t | 84 ++++++++++++++++++++++++++++++++++++- toke.c | 19 ++++++--- win32/GNUmakefile | 9 ++++ win32/Makefile | 9 ++++ win32/makefile.mk | 9 ++++ 27 files changed, 429 insertions(+), 88 deletions(-) diff --git a/AUTHORS b/AUTHORS index 1f6934d4e9..f78e410a09 100644 --- a/AUTHORS +++ b/AUTHORS @@ -1213,6 +1213,7 @@ Tim Sweetman <[email protected]> Tim Witham <[email protected]> Timothe Litt <[email protected]> Timur I. Bakeyev <[email protected]> +Tina Müller <[email protected]> Tkil <[email protected]> Tobias Leich <[email protected]> Toby Inkster <[email protected]> diff --git a/Configure b/Configure index 3be9f05b7d..f99377e9dd 100755 --- a/Configure +++ b/Configure @@ -10737,6 +10737,7 @@ hasproto='varname=$1; func=$2; shift; shift; while $test $# -ge 2; do case "$1" in $define) echo "#include <$2>";; + literal) echo "$2" ;; esac ; shift 2; done > try.c; @@ -16174,12 +16175,46 @@ set mbtowc d_mbtowc eval $inlibc : see if memmem exists -set memmem d_memmem -eval $inlibc +: We need both a prototype in string.h and the symbol in libc. +echo " " +d_memmem_proto='' +xx1="#$d_gnulibc HAS_GNULIBC" +xx2='#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE)' +xx3='# define _GNU_SOURCE' +xx4='#endif' +set d_memmem_proto memmem literal "$xx1" literal "$xx2" literal "$xx3" literal "$xx4" define string.h +eval $hasproto +case "$d_memmem_proto" in + define) # see if memmem exists + set memmem d_memmem + eval $inlibc + ;; + *) val=$undef + set d_memmem + eval $setvar + ;; +esac : see if memrchr exists -set memrchr d_memrchr -eval $inlibc +: We need both a prototype in string.h and the symbol in libc. +echo " " +d_memrchr_proto='' +xx1="#$d_gnulibc HAS_GNULIBC" +xx2='#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE)' +xx3='# define _GNU_SOURCE' +xx4='#endif' +set d_memrchr_proto memrchr literal "$xx1" literal "$xx2" literal "$xx3" literal "$xx4" define string.h +eval $hasproto +case "$d_memrchr_proto" in + define) # see if memrchr exists + set memrchr d_memrchr + eval $inlibc + ;; + *) val=$undef + set d_memrchr + eval $setvar + ;; +esac : see if mkdir exists set mkdir d_mkdir @@ -18788,12 +18823,46 @@ set strftime d_strftime eval $inlibc : see if strlcat exists -set strlcat d_strlcat -eval $inlibc +: We need both a prototype in string.h and the symbol in libc. +echo " " +d_strlcat_proto='' +xx1="#$d_gnulibc HAS_GNULIBC" +xx2='#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE)' +xx3='# define _GNU_SOURCE' +xx4='#endif' +set d_strlcat_proto strlcat literal "$xx1" literal "$xx2" literal "$xx3" literal "$xx4" define string.h +eval $hasproto +case "$d_strlcat_proto" in + define) # see if strlcat exists + set strlcat d_strlcat + eval $inlibc + ;; + *) val=$undef + set d_strlcat + eval $setvar + ;; +esac : see if strlcpy exists -set strlcpy d_strlcpy -eval $inlibc +: We need both a prototype in string.h and the symbol in libc. +echo " " +d_strlcpy_proto='' +xx1="#$d_gnulibc HAS_GNULIBC" +xx2='#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE)' +xx3='# define _GNU_SOURCE' +xx4='#endif' +set d_strlcpy_proto strlcpy literal "$xx1" literal "$xx2" literal "$xx3" literal "$xx4" define string.h +eval $hasproto +case "$d_strlcpy_proto" in + define) # see if strlcpy exists + set strlcpy d_strlcpy + eval $inlibc + ;; + *) val=$undef + set d_strlcpy + eval $setvar + ;; +esac : see if strnlen exists set strnlen d_strnlen diff --git a/Makefile.SH b/Makefile.SH index 9b1e4acce7..47edfe1778 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -67,8 +67,16 @@ true) -compatibility_version \ ${api_revision}.${api_version}.${api_subversion} \ -current_version \ - ${revision}.${patchlevel}.${subversion} \ - -install_name \$(shrpdir)/\$@" + ${revision}.${patchlevel}.${subversion}" + case "$osvers" in + 1[5-9]*|[2-9]*) + shrpldflags="$shrpldflags -install_name `pwd`/\$@ -Xlinker -headerpad_max_install_names" + exeldflags="-Xlinker -headerpad_max_install_names" + ;; + *) + shrpldflags="$shrpldflags -install_name \$(shrpdir)/\$@" + ;; + esac ;; cygwin*) shrpldflags="$shrpldflags -Wl,--out-implib=libperl.dll.a -Wl,--image-base,0x52000000" @@ -339,6 +347,14 @@ MANIFEST_SRT = MANIFEST.srt !GROK!THIS! +case "$useshrplib$osname" in +truedarwin) + $spitshell >>$Makefile <<!GROK!THIS! +PERL_EXE_LDFLAGS=$exeldflags +!GROK!THIS! + ;; +esac + case "$usecrosscompile$perl" in define?*) $spitshell >>$Makefile <<!GROK!THIS! @@ -1050,6 +1066,20 @@ $(PERL_EXE): $& $(perlmain_dep) $(LIBPERL) $(static_ext) ext.libs $(PERLEXPORT) $(SHRPENV) $(CC) -o perl $(CLDFLAGS) $(CCDLFLAGS) $(perlmain_objs) $(LLIBPERL) $(static_ext) `cat ext.libs` $(libs) !NO!SUBS! ;; + + darwin) + case "$useshrplib$osvers" in + true1[5-9]*|true[2-9]*) $spitshell >>$Makefile <<'!NO!SUBS!' + $(SHRPENV) $(CC) -o perl $(PERL_EXE_LDFLAGS) $(CLDFLAGS) $(CCDLFLAGS) $(perlmain_objs) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) +!NO!SUBS! + ;; + *) $spitshell >>$Makefile <<'!NO!SUBS!' + $(SHRPENV) $(CC) -o perl $(CLDFLAGS) $(CCDLFLAGS) $(perlmain_objs) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) +!NO!SUBS! + ;; + esac + ;; + *) $spitshell >>$Makefile <<'!NO!SUBS!' $(SHRPENV) $(CC) -o perl $(CLDFLAGS) $(CCDLFLAGS) $(perlmain_objs) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) !NO!SUBS! diff --git a/av.h b/av.h index 97ce2bc3bb..6b2b14ce8f 100644 --- a/av.h +++ b/av.h @@ -47,7 +47,7 @@ Null AV pointer. =head1 Array Manipulation Functions =for apidoc Am|int|AvFILL|AV* av -Same as C<av_top_index()>. Deprecated, use C<av_top_index()> instead. +Same as C<av_top_index()> or C<av_tindex()>. =for apidoc Am|int|av_tindex|AV* av Same as C<av_top_index()>. diff --git a/caretx.c b/caretx.c index d758f730de..247708de8c 100644 --- a/caretx.c +++ b/caretx.c @@ -56,7 +56,19 @@ Perl_set_caret_X(pTHX) { SV *const caret_x = GvSV(tmpgv); #if defined(OS2) sv_setpv(caret_x, os2_execname(aTHX)); -#elif defined(USE_KERN_PROC_PATHNAME) + return; +#elif defined(WIN32) + char *ansi; + WCHAR widename[MAX_PATH]; + GetModuleFileNameW(NULL, widename, sizeof(widename)/sizeof(WCHAR)); + ansi = win32_ansipath(widename); + sv_setpv(caret_x, ansi); + win32_free(ansi); + return; +#else + /* We can try a platform-specific one if possible; if it fails, or we + * aren't running on a suitable platform, we'll fall back to argv[0]. */ +# ifdef USE_KERN_PROC_PATHNAME size_t size = 0; int mib[4]; mib[0] = CTL_KERN; @@ -76,7 +88,7 @@ Perl_set_caret_X(pTHX) { return; } } -#elif defined(USE_NSGETEXECUTABLEPATH) +# elif defined(USE_NSGETEXECUTABLEPATH) char buf[1]; uint32_t size = sizeof(buf); @@ -95,7 +107,7 @@ Perl_set_caret_X(pTHX) { return; } } -#elif defined(HAS_PROCSELFEXE) +# elif defined(HAS_PROCSELFEXE) char buf[MAXPATHLEN]; SSize_t len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1); /* NOTE: if the length returned by readlink() is sizeof(buf) - 1, @@ -125,15 +137,7 @@ Perl_set_caret_X(pTHX) { sv_setpvn(caret_x, buf, len); return; } -#elif defined(WIN32) - char *ansi; - WCHAR widename[MAX_PATH]; - GetModuleFileNameW(NULL, widename, sizeof(widename)/sizeof(WCHAR)); - ansi = win32_ansipath(widename); - sv_setpv(caret_x, ansi); - win32_free(ansi); - return; -#else +# endif /* Fallback to this: */ sv_setpv(caret_x, PL_origargv[0]); #endif diff --git a/dist/Storable/Makefile.PL b/dist/Storable/Makefile.PL index 697750566d..092bab426a 100644 --- a/dist/Storable/Makefile.PL +++ b/dist/Storable/Makefile.PL @@ -90,12 +90,19 @@ sub depend { # blib.pm needs arch/lib $extra_deps = ' Storable.pm'; } + my $whichperl; + if ($Config::Config{usecrosscompile}) { + $whichperl = '$(PERLRUN)'; + } + else { + $whichperl = '$(FULLPERLRUNINST)'; + } my $linktype = uc($_[0]->{LINKTYPE}); my $limit_pm = File::Spec->catfile('lib', 'Storable', 'Limit.pm'); " $limit_pm : stacksize \$(INST_$linktype)$extra_deps \$(MKPATH) \$(INST_LIB) - \$(FULLPERLRUNINST) stacksize $options + $whichperl stacksize $options release : dist git tag \$(VERSION) diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs index 6a90e24814..f6df32b121 100644 --- a/dist/Storable/Storable.xs +++ b/dist/Storable/Storable.xs @@ -418,6 +418,24 @@ typedef struct stcxt { SV *(**retrieve_vtbl)(pTHX_ struct stcxt *, const char *); /* retrieve dispatch table */ SV *prev; /* contexts chained backwards in real recursion */ SV *my_sv; /* the blessed scalar who's SvPVX() I am */ + + /* recur_sv: + + A hashref of hashrefs or arrayref of arrayrefs is actually a + chain of four SVs, eg for an array ref containing an array ref: + + RV -> AV (element) -> RV -> AV + + To make this depth appear natural from a perl level we only + want to count this as two levels, so store_ref() stores it's RV + into recur_sv and store_array()/store_hash() will only count + that level if the AV/HV *isn't* recur_sv. + + We can't just have store_hash()/store_array() not count that + level, since it's possible for XS code to store an AV or HV + directly as an element (though perl code trying to access such + an object will generally croak.) + */ SV *recur_sv; /* check only one recursive SV */ int in_retrieve_overloaded; /* performance hack for retrieving overloaded objects */ int flags; /* controls whether to bless or tie objects */ @@ -431,8 +449,13 @@ typedef struct stcxt { #define RECURSION_TOO_DEEP() \ (cxt->max_recur_depth != -1 && ++cxt->recur_depth > cxt->max_recur_depth) + +/* There's cases where we need to check whether the hash recursion + limit has been reached without bumping the recursion levels, so the + hash check doesn't bump the depth. +*/ #define RECURSION_TOO_DEEP_HASH() \ - (cxt->max_recur_depth_hash != -1 && ++cxt->recur_depth > cxt->max_recur_depth_hash) + (cxt->max_recur_depth_hash != -1 && cxt->recur_depth > cxt->max_recur_depth_hash) #define MAX_DEPTH_ERROR "Max. recursion depth with nested structures exceeded" static int storable_free(pTHX_ SV *sv, MAGIC* mg); @@ -2360,21 +2383,20 @@ static int store_ref(pTHX_ stcxt_t *cxt, SV *sv) } else PUTMARK(is_weak ? SX_WEAKREF : SX_REF); - TRACEME(("recur_depth %" IVdf ", recur_sv (0x%" UVxf ")", cxt->recur_depth, - PTR2UV(cxt->recur_sv))); - if (cxt->entry && cxt->recur_sv == sv) { - if (RECURSION_TOO_DEEP()) { + cxt->recur_sv = sv; + + TRACEME((">ref recur_depth %" IVdf ", recur_sv (0x%" UVxf ") max %" IVdf, cxt->recur_depth, + PTR2UV(cxt->recur_sv), cxt->max_recur_depth)); + if (RECURSION_TOO_DEEP()) { #if PERL_VERSION < 15 - cleanup_recursive_data(aTHX_ (SV*)sv); + cleanup_recursive_data(aTHX_ (SV*)sv); #endif - CROAK((MAX_DEPTH_ERROR)); - } + CROAK((MAX_DEPTH_ERROR)); } - cxt->recur_sv = sv; retval = store(aTHX_ cxt, sv); - if (cxt->entry && cxt->recur_sv == sv && cxt->recur_depth > 0) { - TRACEME(("recur_depth --%" IVdf, cxt->recur_depth)); + if (cxt->max_recur_depth != -1 && cxt->recur_depth > 0) { + TRACEME(("<ref recur_depth --%" IVdf, cxt->recur_depth)); --cxt->recur_depth; } return retval; @@ -2635,6 +2657,7 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av) UV len = av_len(av) + 1; UV i; int ret; + SV *const recur_sv = cxt->recur_sv; TRACEME(("store_array (0x%" UVxf ")", PTR2UV(av))); @@ -2659,9 +2682,9 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av) TRACEME(("size = %d", (int)l)); } - TRACEME(("recur_depth %" IVdf ", recur_sv (0x%" UVxf ")", cxt->recur_depth, - PTR2UV(cxt->recur_sv))); - if (cxt->entry && cxt->recur_sv == (SV*)av) { + TRACEME((">array recur_depth %" IVdf ", recur_sv (0x%" UVxf ") max %" IVdf, cxt->recur_depth, + PTR2UV(cxt->recur_sv), cxt->max_recur_depth)); + if (recur_sv != (SV*)av) { if (RECURSION_TOO_DEEP()) { /* with <= 5.14 it recurses in the cleanup also, needing 2x stack size */ #if PERL_VERSION < 15 @@ -2670,7 +2693,6 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av) CROAK((MAX_DEPTH_ERROR)); } } - cxt->recur_sv = (SV*)av; /* * Now store each item recursively. @@ -2701,9 +2723,12 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av) return ret; } - if (cxt->entry && cxt->recur_sv == (SV*)av && cxt->recur_depth > 0) { - TRACEME(("recur_depth --%" IVdf, cxt->recur_depth)); - --cxt->recur_depth; + if (recur_sv != (SV*)av) { + assert(cxt->max_recur_depth == -1 || cxt->recur_depth > 0); + if (cxt->max_recur_depth != -1 && cxt->recur_depth > 0) { + TRACEME(("<array recur_depth --%" IVdf, cxt->recur_depth)); + --cxt->recur_depth; + } } TRACEME(("ok (array)")); @@ -2766,6 +2791,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv) #endif ) ? 1 : 0); unsigned char hash_flags = (SvREADONLY(hv) ? SHV_RESTRICTED : 0); + SV * const recur_sv = cxt->recur_sv; /* * Signal hash by emitting SX_HASH, followed by the table length. @@ -2817,17 +2843,17 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv) TRACEME(("size = %d, used = %d", (int)l, (int)HvUSEDKEYS(hv))); } - TRACEME(("recur_depth %" IVdf ", recur_sv (0x%" UVxf ")", cxt->recur_depth, - PTR2UV(cxt->recur_sv))); - if (cxt->entry && cxt->recur_sv == (SV*)hv) { - if (RECURSION_TOO_DEEP_HASH()) { + TRACEME((">hash recur_depth %" IVdf ", recur_sv (0x%" UVxf ") max %" IVdf, cxt->recur_depth, + PTR2UV(cxt->recur_sv), cxt->max_recur_depth_hash)); + if (recur_sv != (SV*)hv && cxt->max_recur_depth_hash != -1) { + ++cxt->recur_depth; + } + if (RECURSION_TOO_DEEP_HASH()) { #if PERL_VERSION < 15 - cleanup_recursive_data(aTHX_ (SV*)hv); + cleanup_recursive_data(aTHX_ (SV*)hv); #endif - CROAK((MAX_DEPTH_ERROR)); - } + CROAK((MAX_DEPTH_ERROR)); } - cxt->recur_sv = (SV*)hv; /* * Save possible iteration state via each() on that table. @@ -3107,8 +3133,9 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv) TRACEME(("ok (hash 0x%" UVxf ")", PTR2UV(hv))); out: - if (cxt->entry && cxt->recur_sv == (SV*)hv && cxt->recur_depth > 0) { - TRACEME(("recur_depth --%" IVdf , cxt->recur_depth)); + assert(cxt->max_recur_depth_hash != -1 && cxt->recur_depth > 0); + TRACEME(("<hash recur_depth --%" IVdf , cxt->recur_depth)); + if (cxt->max_recur_depth_hash != -1 && recur_sv != (SV*)hv && cxt->recur_depth > 0) { --cxt->recur_depth; } HvRITER_set(hv, riter); /* Restore hash iterator state */ @@ -3221,6 +3248,7 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags) #ifdef DEBUGME UV len = (UV)HvTOTALKEYS(hv); #endif + SV * const recur_sv = cxt->recur_sv; if (hash_flags) { TRACEME(("store_lhash (0x%" UVxf ") (flags %x)", PTR2UV(hv), (int) hash_flags)); @@ -3231,15 +3259,15 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags) TRACEME(("recur_depth %" IVdf ", recur_sv (0x%" UVxf ")", cxt->recur_depth, PTR2UV(cxt->recur_sv))); - if (cxt->entry && cxt->recur_sv == (SV*)hv) { - if (RECURSION_TOO_DEEP_HASH()) { + if (recur_sv != (SV*)hv && cxt->max_recur_depth_hash != -1) { + ++cxt->recur_depth; + } + if (RECURSION_TOO_DEEP_HASH()) { #if PERL_VERSION < 15 - cleanup_recursive_data(aTHX_ (SV*)hv); + cleanup_recursive_data(aTHX_ (SV*)hv); #endif - CROAK((MAX_DEPTH_ERROR)); - } + CROAK((MAX_DEPTH_ERROR)); } - cxt->recur_sv = (SV*)hv; array = HvARRAY(hv); for (i = 0; i <= (Size_t)HvMAX(hv); i++) { @@ -3252,7 +3280,7 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags) return ret; } } - if (cxt->entry && cxt->recur_sv == (SV*)hv && cxt->recur_depth > 0) { + if (recur_sv == (SV*)hv && cxt->max_recur_depth_hash != -1 && cxt->recur_depth > 0) { TRACEME(("recur_depth --%" IVdf, cxt->recur_depth)); --cxt->recur_depth; } diff --git a/dist/Storable/__Storable__.pm b/dist/Storable/__Storable__.pm index 71c669daaf..e77b2408a9 100644 --- a/dist/Storable/__Storable__.pm +++ b/dist/Storable/__Storable__.pm @@ -27,7 +27,7 @@ our @EXPORT_OK = qw( our ($canonical, $forgive_me); -our $VERSION = '3.08'; +our $VERSION = '3.08_01'; our $recursion_limit; our $recursion_limit_hash; diff --git a/dist/Storable/stacksize b/dist/Storable/stacksize index 7abd3a84cc..14e0739734 100644 --- a/dist/Storable/stacksize +++ b/dist/Storable/stacksize @@ -7,6 +7,9 @@ use Cwd; use File::Spec; use strict; +-d "lib" or mkdir "lib"; +-d "lib/Storable" or mkdir "lib/Storable"; + my $fn = "lib/Storable/Limit.pm"; my $ptrsize = $Config{ptrsize}; my ($bad1, $bad2) = (65001, 25000); @@ -29,6 +32,10 @@ sub is_miniperl { } if (is_miniperl()) { + if ($Config{usecrosscompile}) { + write_limits(500, 265); + exit; + } die "Should not run during miniperl\n"; } my $prefix = ""; @@ -68,9 +75,6 @@ if ($ENV{PERL_CORE}) { } } --d "lib" or mkdir "lib"; --d "lib/Storable" or mkdir "lib/Storable"; - if ($^O eq "MSWin32") { require Win32; my ($str, $major, $minor) = Win32::GetOSVersion(); diff --git a/dist/Storable/t/recurse.t b/dist/Storable/t/recurse.t index fa8be0b374..63fde90fdf 100644 --- a/dist/Storable/t/recurse.t +++ b/dist/Storable/t/recurse.t @@ -20,7 +20,7 @@ use Storable qw(freeze thaw dclone); $Storable::flags = Storable::FLAGS_COMPAT; -use Test::More tests => 38; +use Test::More tests => 39; package OBJ_REAL; @@ -364,5 +364,17 @@ else { dclone $t; }; like $@, qr/Max\. recursion depth with nested structures exceeded/, - 'Caught href stack overflow '.MAX_DEPTH*2; + 'Caught href stack overflow '.MAX_DEPTH_HASH*2; +} + +{ + # perl #133326 + my @tt; + #$Storable::DEBUGME=1; + for (1..16000) { + my $t = [[[]]]; + push @tt, $t; + } + ok(eval { dclone \@tt; 1 }, + "low depth structure shouldn't be treated as nested"); } diff --git a/ext/PerlIO-scalar/scalar.pm b/ext/PerlIO-scalar/scalar.pm index 61b62ea3a2..6f4fa176be 100644 --- a/ext/PerlIO-scalar/scalar.pm +++ b/ext/PerlIO-scalar/scalar.pm @@ -1,5 +1,5 @@ package PerlIO::scalar; -our $VERSION = '0.29'; +our $VERSION = '0.30'; require XSLoader; XSLoader::load(); 1; diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs index 10a4185899..e717736fab 100644 --- a/ext/PerlIO-scalar/scalar.xs +++ b/ext/PerlIO-scalar/scalar.xs @@ -185,11 +185,20 @@ PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) /* I assume that Off_t is at least as large as len (which * seems safe) and that the size of the buffer in our SV is * always less than half the size of the address space + * + * Which turns out not to be the case on 64-bit Windows, since + * a build with USE_LARGE_FILES=undef defines Off_t as long, + * which is 32-bits on 64-bit Windows. This doesn't appear to + * be the case on other 64-bit platforms. */ - STATIC_ASSERT_STMT(sizeof(Off_t) >= sizeof(len)); +#if Off_t_size >= Size_t_size assert(len < ((~(STRLEN)0) >> 1)); if ((Off_t)len <= s->posn) return 0; +#else + if (len <= (STRLEN)s->posn) + return 0; +#endif got = len - (STRLEN)(s->posn); if ((STRLEN)got > (STRLEN)count) got = (STRLEN)count; diff --git a/ext/XS-APItest/t/svcatpvf.t b/ext/XS-APItest/t/svcatpvf.t index 15348891bf..865020da30 100644 --- a/ext/XS-APItest/t/svcatpvf.t +++ b/ext/XS-APItest/t/svcatpvf.t @@ -16,6 +16,6 @@ for my $case (@cases) { my ($what, $format) = @$case; my $got = eval { test_sv_catpvf($format); 1 }; my $exn = $got ? undef : $@; - like($exn, qr/\b\QCannot yet reorder sv_catpvfn() arguments from va_list\E\b/, + like($exn, qr/\b\QCannot yet reorder sv_vcatpvfn() arguments from va_list\E\b/, "explicit $what index forbidden in va_list arguments"); } diff --git a/hints/linux.sh b/hints/linux.sh index 3f38ea07f1..a985a8ee1b 100644 --- a/hints/linux.sh +++ b/hints/linux.sh @@ -178,6 +178,16 @@ case "$plibpth" in ;; esac +# For the musl libc, perl should #define _GNU_SOURCE. Otherwise, some +# available functions, like memem, won't be used. See the discussion in +# [perl #133760]. musl doesn't offer an easy way to identify it, but, +# at least on alpine linux, the ldd --version output contains the +# string 'musl.' +case `ldd --version 2>&1` in + musl*) ccflags="$ccflags -D_GNU_SOURCE" ;; + *) ;; +esac + # libquadmath is sometimes installed as gcc internal library, # so contrary to our usual policy of *not* looking at gcc internal # directories we now *do* look at them, in case they contain diff --git a/installperl b/installperl index 3bf79d2d6f..6cd65a0923 100755 --- a/installperl +++ b/installperl @@ -304,6 +304,7 @@ elsif ($^O ne 'dos') { safe_unlink("$installbin/$perl_verbase$ver$exe_ext"); copy("perl$exe_ext", "$installbin/$perl_verbase$ver$exe_ext"); strip("$installbin/$perl_verbase$ver$exe_ext"); + fix_dep_names("$installbin/$perl_verbase$ver$exe_ext"); chmod(0755, "$installbin/$perl_verbase$ver$exe_ext"); } else { @@ -388,6 +389,7 @@ foreach my $file (@corefiles) { if (copy_if_diff($file,"$installarchlib/CORE/$file")) { if ($file =~ /\.(\Q$so\E|\Q$dlext\E)$/) { strip("-S", "$installarchlib/CORE/$file") if $^O eq 'darwin'; + fix_dep_names("$installarchlib/CORE/$file"); chmod($SO_MODE, "$installarchlib/CORE/$file"); } else { chmod($NON_SO_MODE, "$installarchlib/CORE/$file"); @@ -791,4 +793,27 @@ sub strip } } +sub fix_dep_names { + my $file = shift; + + $^O eq "darwin" && $Config{osvers} =~ /^(1[5-9]|[2-9])/ + && $Config{useshrplib} + or return; + + my @opts; + my $so = $Config{so}; + my $libperl = "$Config{archlibexp}/CORE/libperl.$Config{so}"; + if ($file =~ /\blibperl.\Q$Config{so}\E$/a) { + push @opts, -id => $libperl; + } + else { + push @opts, -change => getcwd . "/libperl.$so", $libperl; + } + push @opts, $file; + + $opts{verbose} and print " install_name_tool @opts\n"; + system "install_name_tool", @opts + and die "Cannot update $file dependency paths\n"; +} + # ex: set ts=8 sts=4 sw=4 et: diff --git a/numeric.c b/numeric.c index 8754a9f649..7f30e93c90 100644 --- a/numeric.c +++ b/numeric.c @@ -565,9 +565,9 @@ Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send) Helper for C<grok_number()>, accepts various ways of spelling "infinity" or "not a number", and returns one of the following flag combinations: - IS_NUMBER_INFINITE + IS_NUMBER_INFINITY IS_NUMBER_NAN - IS_NUMBER_INFINITE | IS_NUMBER_NEG + IS_NUMBER_INFINITY | IS_NUMBER_NEG IS_NUMBER_NAN | IS_NUMBER_NEG 0 diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 607bfc5469..f3ce90e670 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -733,9 +733,9 @@ keep a reference count on its arguments and cannot be made to do so. Such arrays are not even supposed to be accessible to Perl code, but are only used internally. -=item Cannot yet reorder sv_catpvfn() arguments from va_list +=item Cannot yet reorder sv_vcatpvfn() arguments from va_list -(F) Some XS code tried to use C<sv_catpvfn()> or a related function with a +(F) Some XS code tried to use C<sv_vcatpvfn()> or a related function with a format string that specifies explicit indexes for some of the elements, and using a C-style variable-argument list (a C<va_list>). This is not currently supported. XS authors wanting to do this must instead construct a C array diff --git a/pp.c b/pp.c index 33eac6040d..def1950857 100644 --- a/pp.c +++ b/pp.c @@ -1693,7 +1693,8 @@ PP(pp_repeat) else { dTOPss; ASSUME(MARK + 1 == SP); - XPUSHs(sv); + MEXTEND(SP, 1); + PUSHs(sv); MARK[1] = &PL_sv_undef; } SP = MARK + 2; diff --git a/pp_hot.c b/pp_hot.c index 56e3cbe6e1..dc02612042 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -3932,7 +3932,7 @@ PP(pp_iter) case CXt_LOOP_LIST: /* for (1,2,3) */ assert(OPpITER_REVERSED == 2); /* so inc becomes -1 or 1 */ - inc = 1 - (PL_op->op_private & OPpITER_REVERSED); + inc = (IV)1 - (IV)(PL_op->op_private & OPpITER_REVERSED); ix = (cx->blk_loop.state_u.stack.ix += inc); if (UNLIKELY(inc > 0 ? ix > cx->blk_oldsp @@ -3947,7 +3947,7 @@ PP(pp_iter) case CXt_LOOP_ARY: /* for (@ary) */ av = cx->blk_loop.state_u.ary.ary; - inc = 1 - (PL_op->op_private & OPpITER_REVERSED); + inc = (IV)1 - (IV)(PL_op->op_private & OPpITER_REVERSED); ix = (cx->blk_loop.state_u.ary.ix += inc); if (UNLIKELY(inc > 0 ? ix > AvFILL(av) diff --git a/sv.c b/sv.c index 07865bb2c1..94cb2a74ab 100644 --- a/sv.c +++ b/sv.c @@ -10810,8 +10810,8 @@ Perl_sv_catpvf_mg_nocontext(SV *const sv, const char *const pat, ...) /* =for apidoc sv_catpvf -Processes its arguments like C<sv_catpvfn>, and appends the formatted -output to an SV. As with C<sv_catpvfn> called with a non-null C-style +Processes its arguments like C<sprintf>, and appends the formatted +output to an SV. As with C<sv_vcatpvfn> called with a non-null C-style variable argument list, argument reordering is not supported. If the appended data contains "wide" characters (including, but not limited to, SVs with a UTF-8 PV formatted with C<%s>, @@ -10837,7 +10837,7 @@ Perl_sv_catpvf(pTHX_ SV *const sv, const char *const pat, ...) /* =for apidoc sv_vcatpvf -Processes its arguments like C<sv_catpvfn> called with a non-null C-style +Processes its arguments like C<sv_vcatpvfn> called with a non-null C-style variable argument list, and appends the formatted output to an SV. Does not handle 'set' magic. See C<L</sv_vcatpvf_mg>>. @@ -11985,7 +11985,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p if (*q == '$') { if (args) Perl_croak_nocontext( - "Cannot yet reorder sv_catpvfn() arguments from va_list"); + "Cannot yet reorder sv_vcatpvfn() arguments from va_list"); ++q; efix = (Size_t)width; width = 0; @@ -12053,7 +12053,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p if (*q++ == '$') { if (args) Perl_croak_nocontext( - "Cannot yet reorder sv_catpvfn() arguments from va_list"); + "Cannot yet reorder sv_vcatpvfn() arguments from va_list"); no_redundant_warning = TRUE; } else goto unknown; @@ -12138,7 +12138,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p if (*q++ == '$') { if (args) Perl_croak_nocontext( - "Cannot yet reorder sv_catpvfn() arguments from va_list"); + "Cannot yet reorder sv_vcatpvfn() arguments from va_list"); no_redundant_warning = TRUE; } else goto unknown; diff --git a/t/lib/croak/toke b/t/lib/croak/toke index 1d45a3fdf5..a3852900e5 100644 --- a/t/lib/croak/toke +++ b/t/lib/croak/toke @@ -480,3 +480,12 @@ Bareword found where operator expected at - line 2, near "2p0" (Missing operator before p0?) syntax error at - line 2, near "2p0" Execution of - aborted due to compilation errors. +######## +# NAME [perl #132158] format with syntax errors +format= +@ +=h +=cut +EXPECT +syntax error at - line 4, next token ??? +Execution of - aborted due to compilation errors. diff --git a/t/op/for.t b/t/op/for.t index a114180f0b..f34fbd8b56 100644 --- a/t/op/for.t +++ b/t/op/for.t @@ -5,7 +5,7 @@ BEGIN { require "./test.pl"; } -plan(124); +plan(126); # A lot of tests to check that reversed for works. @@ -664,3 +664,17 @@ is(fscope(), 1, 'return via loop in sub'); } is($foo, "outside", "RT #123994 array outside"); } + +# RT #133558 'reverse' under AIX was causing loop to terminate +# immediately, probably due to compiler bug + +{ + my @a = qw(foo); + my @b; + push @b, $_ for (reverse @a); + is "@b", "foo", " RT #133558 reverse array"; + + @b = (); + push @b, $_ for (reverse 'bar'); + is "@b", "bar", " RT #133558 reverse list"; +} diff --git a/t/op/repeat.t b/t/op/repeat.t index 978916689b..fa7ce06904 100644 --- a/t/op/repeat.t +++ b/t/op/repeat.t @@ -6,7 +6,7 @@ BEGIN { set_up_inc( '../lib' ); } -plan(tests => 49); +plan(tests => 50); # compile time @@ -192,3 +192,85 @@ fresh_perl_like( eval q{() = (() or ((0) x 0)); 1}; is($@, "", "RT #130247"); + +# yes, the newlines matter +fresh_perl_is(<<'PERL', "", { stderr => 1 }, "(perl #133778) MARK mishandling"); +map{s[][];eval;0}<DATA>__END__ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +()x0 + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +PERL diff --git a/toke.c b/toke.c index ee6c698ec6..622873dca3 100644 --- a/toke.c +++ b/toke.c @@ -1829,14 +1829,14 @@ S_incline(pTHX_ const char *s, const char *end) } else if (GvAV(cfgv)) { AV * const av = GvAV(cfgv); - const I32 start = CopLINE(PL_curcop)+1; - I32 items = AvFILLp(av) - start; + const line_t start = CopLINE(PL_curcop)+1; + SSize_t items = AvFILLp(av) - start; if (items > 0) { AV * const av2 = GvAVn(gv2); SV **svp = AvARRAY(av) + start; - I32 l = (I32)line_num+1; - while (items--) - av_store(av2, l++, SvREFCNT_inc(*svp++)); + Size_t l = line_num+1; + while (items-- && l < SSize_t_MAX && l == (line_t)l) + av_store(av2, (SSize_t)l++, SvREFCNT_inc(*svp++)); } } } @@ -5100,6 +5100,14 @@ Perl_yylex(pTHX) return yylex(); case LEX_FORMLINE: + if (PL_parser->sub_error_count != PL_error_count) { + /* There was an error parsing a formline, which tends to + mess up the parser. + Unlike interpolated sub-parsing, we can't treat any of + these as recoverable, so no need to check sub_no_recover. + */ + yyquit(); + } assert(PL_lex_formbrack); s = scan_formline(PL_bufptr); if (!PL_lex_formbrack) @@ -6519,6 +6527,7 @@ Perl_yylex(pTHX) SAVEI32(PL_lex_formbrack); PL_parser->form_lex_state = PL_lex_state; PL_lex_formbrack = PL_lex_brackets + 1; + PL_parser->sub_error_count = PL_error_count; goto leftbracket; } } diff --git a/win32/GNUmakefile b/win32/GNUmakefile index a9202387f3..200d8a5ece 100644 --- a/win32/GNUmakefile +++ b/win32/GNUmakefile @@ -722,6 +722,15 @@ else ifeq ($(CCTYPE),MSVC141) DEFINES += -D_WINSOCK_DEPRECATED_NO_WARNINGS endif +# The Windows Server 2003 SP1 SDK compiler only defines _configthreadlocale() if +# _MT is defined, i.e. when using /MT (the LIBCMT.lib version of the CRT), which +# the perl build doesn't use. We therefore specify NO_THREAD_SAFE_LOCALE so that +# perl.h doesn't set USE_THREAD_SAFE_LOCALE, which it otherwise would do since +# _MSC_VER is 1400 for this compiler (as per MSVC80). +ifeq ($(CCTYPE),SDK2003SP1) +DEFINES += -DNO_THREAD_SAFE_LOCALE +endif + # In VS 2005 (VC++ 8.0) Microsoft changes time_t from 32-bit to # 64-bit, even in 32-bit mode. It also provides the _USE_32BIT_TIME_T # preprocessor option to revert back to the old functionality for diff --git a/win32/Makefile b/win32/Makefile index 2bfc3f53d6..481fcd8eab 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -553,6 +553,15 @@ DEFINES = $(DEFINES) -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE DEFINES = $(DEFINES) -D_WINSOCK_DEPRECATED_NO_WARNINGS !ENDIF +# The Windows Server 2003 SP1 SDK compiler only defines _configthreadlocale() if +# _MT is defined, i.e. when using /MT (the LIBCMT.lib version of the CRT), which +# the perl build doesn't use. We therefore specify NO_THREAD_SAFE_LOCALE so that +# perl.h doesn't set USE_THREAD_SAFE_LOCALE, which it otherwise would do since +# _MSC_VER is 1400 for this compiler (as per MSVC80). +!IF "$(CCTYPE)" == "SDK2003SP1" +DEFINES = $(DEFINES) -DNO_THREAD_SAFE_LOCALE +!ENDIF + # In VS 2005 (VC++ 8.0) Microsoft changes time_t from 32-bit to # 64-bit, even in 32-bit mode. It also provides the _USE_32BIT_TIME_T # preprocessor option to revert back to the old functionality for diff --git a/win32/makefile.mk b/win32/makefile.mk index f6ced83070..7dae7537b4 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -695,6 +695,15 @@ DEFINES += -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE DEFINES += -D_WINSOCK_DEPRECATED_NO_WARNINGS .ENDIF +# The Windows Server 2003 SP1 SDK compiler only defines _configthreadlocale() if +# _MT is defined, i.e. when using /MT (the LIBCMT.lib version of the CRT), which +# the perl build doesn't use. We therefore specify NO_THREAD_SAFE_LOCALE so that +# perl.h doesn't set USE_THREAD_SAFE_LOCALE, which it otherwise would do since +# _MSC_VER is 1400 for this compiler (as per MSVC80). +.IF "$(CCTYPE)" == "SDK2003SP1" +DEFINES += -DNO_THREAD_SAFE_LOCALE +.ENDIF + # In VS 2005 (VC++ 8.0) Microsoft changes time_t from 32-bit to # 64-bit, even in 32-bit mode. It also provides the _USE_32BIT_TIME_T # preprocessor option to revert back to the old functionality for -- Perl5 Master Repository
