From 46677718f1dda8eb87afe477260f86bc49a07ce0 Mon Sep 17 00:00:00 2001 From: Nicolas R Date: Mon, 19 Oct 2020 10:13:24 -0600 Subject: [PATCH] Update Devel-PPPort to release 3.62 --- Porting/Maintainers.pl | 1 - dist/Devel-PPPort/Changes | 111 ++++++++++++----------- dist/Devel-PPPort/PPPort_pm.PL | 2 +- dist/Devel-PPPort/devel/mkppport_fnc.pl | 2 + dist/Devel-PPPort/devel/scanprov | 2 +- dist/Devel-PPPort/parts/inc/SvPV | 7 +- dist/Devel-PPPort/parts/inc/Sv_set | 6 +- dist/Devel-PPPort/parts/inc/call | 6 +- dist/Devel-PPPort/parts/inc/cop | 8 +- dist/Devel-PPPort/parts/inc/locale | 37 ++++++++ dist/Devel-PPPort/parts/inc/magic | 2 +- dist/Devel-PPPort/parts/inc/mess | 9 +- dist/Devel-PPPort/parts/inc/misc | 9 +- dist/Devel-PPPort/parts/inc/newCONSTSUB | 12 ++- dist/Devel-PPPort/parts/inc/newRV | 2 +- dist/Devel-PPPort/parts/inc/newSV_type | 2 +- dist/Devel-PPPort/parts/inc/newSVpv | 2 +- dist/Devel-PPPort/parts/inc/ppphtest | 5 +- dist/Devel-PPPort/parts/inc/sv_xpvf | 2 +- dist/Devel-PPPort/parts/inc/utf8 | 4 +- dist/Devel-PPPort/parts/inc/uv | 4 +- dist/Devel-PPPort/parts/inc/version | 2 +- dist/Devel-PPPort/parts/inc/warn | 151 +++++++++++++++++++++++++++++--- 23 files changed, 284 insertions(+), 104 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 88bc300..a21b21e 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -345,7 +345,6 @@ use File::Glob qw(:case); 'EXCLUDED' => [ 'PPPort.pm', # we use PPPort_pm.PL instead ], - 'CUSTOMIZED' => [ qw(Makefile.PL) ], }, 'Devel::SelfStubber' => { diff --git a/dist/Devel-PPPort/Changes b/dist/Devel-PPPort/Changes index 112469c..3740455 100644 --- a/dist/Devel-PPPort/Changes +++ b/dist/Devel-PPPort/Changes @@ -1,53 +1,65 @@ Revision history for Devel-PPPort - 3.60 - 2020-08-11 - * Restore PERL_BCDVERSION helper which is used on CPAN - * A few API elements were not properly found, like IVTYPE - - 3.59 - 2020-08-10 - - * Add PERL_VERSION_* compare macros - * Rename PERL_BCDVERSION to internal name to discourage future use - * Stop versioning generated test files - * Enforce strict & warnings - * Avoid indirect calls - * scanprov: multiple improvements - * Use ivers() in tests - * Update POD documentation and HACKERS file - * Change ppport.h --api-info to not output non-API info unless that is the - only match - * Find more elements to be listed in the --api-info option (and similar) to - ppport.h - - 3.58 - 2020-03-09 - - * Safer definition of UVCHR_SKIP - * Make sure WIDEST_UTYPE is unsigned - * Avoid Pax Header in tarballs - - 3.57 - 2020-01-31 - - * Fix eval_sv for Perl versions prior to 5.6.0 (Pali) - * Fix t/ppphtest.t for Perl versions prior to 5.6.0 (Pali) - * Fix compilation of sv_setsv_flags when GCC extensions are not present (Pali) - * Fix SV_NOSTEAL on 5.7.2 (Karl Williamson) - * Fix multiple unit test issues (Craig A. Berry, Karl Williamson, Pali) - * Avoid generating warnings on early Perls (Karl Williamson) - * Backport memCHRs (Karl Williamson) - * Implement sv_setsv_flags() with SV_NOSTEAL and SV_GMAGIC flags for Perl versions < 5.7.3 (Pali) - * Implement UTF8f format and its UTF8fARG macro (Pali) - - 3.56 - 2019-11-25 - - * mktests.PL: use FindBin for INC setup - * devel/regenerate: Adjust POD line length - * Fix compilation with Visual C++ bugs introduced in 3.55 (Tomasz Konojacki) - * Fix mess.t failures when on VC++ when $0 contains backslashes (Tomasz Konojacki) - * Fix failing builds on 5.20.[1-3] introduced in 3.55 (Karl Williamson) - * Change tests to accept and use Test::More-like functions (Karl Williamson) - - 3.55 - 2019-11-07 - +3.62 - 2020-10-16 + * Restore missing PPPort.pm + * Fix metaCPAN indexing + +3.61 - 2020-10-12 + * Fix scanprov + * Define PERL_ARGS_ASSERT_CROAK_XS_USAGE when setting croak_xs_usage + * Backport ck_warner, ck_warner_d, ckWARN_d, ckWARN_2, ckWARN_3, ckWARN_4, ckWARN2_d, ckWARN3_d, ckWARN4_d + * Backport packWARN, packWARN2, packWARN3, packWARN4 + * Backport LC_NUMERIC locale handling + * Backport SvPVx_nolen_const + * Backport MUTABLE_AV, MUTABLE_CV, MUTABLE_GV, MUTABLE_HV, MUTABLE_IO + * Backport vwarner + * Use PERL_USE_GCC_BRACE_GROUPS + * Remove C `register` declaration + * Implement return value for newCONSTSUB() + +3.60 - 2020-08-11 + * Restore PERL_BCDVERSION helper which is used on CPAN + * A few API elements were not properly found, like IVTYPE + +3.59 - 2020-08-10 + * Add PERL_VERSION_* compare macros + * Rename PERL_BCDVERSION to internal name to discourage future use + * Stop versioning generated test files + * Enforce strict & warnings + * Avoid indirect calls + * scanprov: multiple improvements + * Use ivers() in tests + * Update POD documentation and HACKERS file + * Change ppport.h --api-info to not output non-API info unless that is the + only match + * Find more elements to be listed in the --api-info option (and similar) to + ppport.h + +3.58 - 2020-03-09 + * Safer definition of UVCHR_SKIP + * Make sure WIDEST_UTYPE is unsigned + * Avoid Pax Header in tarballs + +3.57 - 2020-01-31 + * Fix eval_sv for Perl versions prior to 5.6.0 (Pali) + * Fix t/ppphtest.t for Perl versions prior to 5.6.0 (Pali) + * Fix compilation of sv_setsv_flags when GCC extensions are not present (Pali) + * Fix SV_NOSTEAL on 5.7.2 (Karl Williamson) + * Fix multiple unit test issues (Craig A. Berry, Karl Williamson, Pali) + * Avoid generating warnings on early Perls (Karl Williamson) + * Backport memCHRs (Karl Williamson) + * Implement sv_setsv_flags() with SV_NOSTEAL and SV_GMAGIC flags for Perl versions < 5.7.3 (Pali) + * Implement UTF8f format and its UTF8fARG macro (Pali) + +3.56 - 2019-11-25 + * mktests.PL: use FindBin for INC setup + * devel/regenerate: Adjust POD line length + * Fix compilation with Visual C++ bugs introduced in 3.55 (Tomasz Konojacki) + * Fix mess.t failures when on VC++ when $0 contains backslashes (Tomasz Konojacki) + * Fix failing builds on 5.20.[1-3] introduced in 3.55 (Karl Williamson) + * Change tests to accept and use Test::More-like functions (Karl Williamson) + +3.55 - 2019-11-07 * Fix p5-Text-Xslate on Perl 5.8.5 (Nicolas R) * Fix EBCDIC build problem (Karl Williamson) * Fix isGRAPH_L1() bug (Karl Williamson) @@ -68,8 +80,7 @@ Revision history for Devel-PPPort * Backport UTF8_SKIP (Karl Williamson) * Backport UNI to/from NATIVE (Karl Williamson) - 3.54 - 2019-09-27 - +3.54 - 2019-09-27 * Fix Unix-format path in Devel::PPPort's Makefile.PL * Fix utf8_to_uvchr_buf for 5.7.0 * Add hint for utf8_to_uvchr() diff --git a/dist/Devel-PPPort/PPPort_pm.PL b/dist/Devel-PPPort/PPPort_pm.PL index 4d8f9f1..f2929ef 100644 --- a/dist/Devel-PPPort/PPPort_pm.PL +++ b/dist/Devel-PPPort/PPPort_pm.PL @@ -756,7 +756,7 @@ package Devel::PPPort; use strict; use vars qw($VERSION $data); -$VERSION = '3.60'; +$VERSION = '3.62'; sub _init_data { diff --git a/dist/Devel-PPPort/devel/mkppport_fnc.pl b/dist/Devel-PPPort/devel/mkppport_fnc.pl index f01853f..c82f71b 100644 --- a/dist/Devel-PPPort/devel/mkppport_fnc.pl +++ b/dist/Devel-PPPort/devel/mkppport_fnc.pl @@ -107,6 +107,8 @@ foreach my $element (@embeds) { my $PPPort = "$main_dir/PPPort_pm.PL"; open F, "<", $PPPort or die "Can't open $PPPort: $!"; +# Now find all the elements furnished by us whose signatures we don't know +# (hence not in embed.fnc nor apidoc.fnc) and have no parameters. my @no_parameters; while () { next unless/^%include (\w+)/; diff --git a/dist/Devel-PPPort/devel/scanprov b/dist/Devel-PPPort/devel/scanprov index 52c6672..4d42065 100755 --- a/dist/Devel-PPPort/devel/scanprov +++ b/dist/Devel-PPPort/devel/scanprov @@ -347,7 +347,7 @@ sub find_first_mentions else { foreach my $define (keys %defines) { # Don't override input 'M' symbols. - $remaining{$define} = $new_code + $remaining{$define} = 'Z' unless defined $remaining{$define}; } } diff --git a/dist/Devel-PPPort/parts/inc/SvPV b/dist/Devel-PPPort/parts/inc/SvPV index c20cb85..2848ca9 100644 --- a/dist/Devel-PPPort/parts/inc/SvPV +++ b/dist/Devel-PPPort/parts/inc/SvPV @@ -82,7 +82,7 @@ __UNDEFINED__ SV_SMAGIC 0 __UNDEFINED__ SV_HAS_TRAILING_NUL 0 __UNDEFINED__ SV_COW_SHARED_HASH_KEYS 0 -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +#if defined(PERL_USE_GCC_BRACE_GROUPS) __UNDEFINED__ sv_2pv_flags(sv, lp, flags) ({ SV *_sv = (sv); const I32 _flags = (flags); STRLEN *_lp = lp; _lp = _lp ? : &PL_na; (!(_flags & SV_GMAGIC) && SvGMAGICAL(_sv)) ? ({ char *_pv; SvGMAGICAL_off(_sv); _pv = sv_2pv(_sv, _lp); SvGMAGICAL_on(_sv); _pv; }) : sv_2pv(_sv, _lp); }) __UNDEFINED__ sv_pvn_force_flags(sv, lp, flags) ({ SV *_sv = (sv); const I32 _flags = (flags); STRLEN *_lp = lp; _lp = _lp ? : &PL_na; (!(_flags & SV_GMAGIC) && SvGMAGICAL(_sv)) ? ({ char *_pv; SvGMAGICAL_off(_sv); _pv = sv_pvn_force(_sv, _lp); SvGMAGICAL_on(_sv); _pv; }) : sv_pvn_force(_sv, _lp); }) #else @@ -144,6 +144,11 @@ __UNDEFINED__ SvPV_nolen(sv) \ __UNDEFINED__ SvPV_nolen_const(sv) \ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ ? SvPVX_const(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN)) +# if defined(PERL_USE_GCC_BRACE_GROUPS) +__UNDEFINED__ SvPVx_nolen_const(sv) ({SV *sV_ = (sv); SvPV_nolen_const(sV_); }) +# else +__UNDEFINED__ SvPVx_nolen_const(sv) (PL_Sv = sv, SvPV_nolen_const(PL_Sv)) +# endif __UNDEFINED__ SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0) __UNDEFINED__ SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0) diff --git a/dist/Devel-PPPort/parts/inc/Sv_set b/dist/Devel-PPPort/parts/inc/Sv_set index 8c3f91b..487fe96 100644 --- a/dist/Devel-PPPort/parts/inc/Sv_set +++ b/dist/Devel-PPPort/parts/inc/Sv_set @@ -22,7 +22,7 @@ __UNDEFINED__ SV_NOSTEAL 16 #if ( { VERSION >= 5.7.3 } && { VERSION < 5.8.7 } ) || ( { VERSION >= 5.9.0 } && { VERSION < 5.9.2 } ) #undef sv_setsv_flags -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +#if defined(PERL_USE_GCC_BRACE_GROUPS) #define sv_setsv_flags(dstr, sstr, flags) \ STMT_START { \ if (((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) { \ @@ -48,7 +48,7 @@ __UNDEFINED__ SV_NOSTEAL 16 #endif #endif -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +#if defined(PERL_USE_GCC_BRACE_GROUPS) __UNDEFINED__ sv_setsv_flags(dstr, sstr, flags) \ STMT_START { \ if (((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) { \ @@ -101,7 +101,7 @@ __UNDEFINED__ sv_setsv_flags(dstr, sstr, flags) ) #endif -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +#if defined(PERL_USE_GCC_BRACE_GROUPS) __UNDEFINED__ newSVsv_flags(sv, flags) ({ SV *_sv = newSV(0); sv_setsv_flags(_sv, (sv), (flags)); _sv; }) #else __UNDEFINED__ newSVsv_flags(sv, flags) ((PL_Sv = newSV(0)), sv_setsv_flags(PL_Sv, (sv), (flags)), PL_Sv) diff --git a/dist/Devel-PPPort/parts/inc/call b/dist/Devel-PPPort/parts/inc/call index d1daa6f..af472ec 100644 --- a/dist/Devel-PPPort/parts/inc/call +++ b/dist/Devel-PPPort/parts/inc/call @@ -46,7 +46,7 @@ __UNDEFINED__ PERL_LOADMOD_DENY 0x1 __UNDEFINED__ PERL_LOADMOD_NOIMPORT 0x2 __UNDEFINED__ PERL_LOADMOD_IMPORT_OPS 0x4 -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +#if defined(PERL_USE_GCC_BRACE_GROUPS) # define D_PPP_CROAK_IF_ERROR(cond) ({ SV *_errsv; ((cond) && (_errsv = ERRSV) && (SvROK(_errsv) || SvTRUE(_errsv)) && (croak_sv(_errsv), 1)); }) #else # define D_PPP_CROAK_IF_ERROR(cond) ((cond) && (SvROK(ERRSV) || SvTRUE(ERRSV)) && (croak_sv(ERRSV), 1)) @@ -71,7 +71,7 @@ __UNDEFINED__ PERL_LOADMOD_IMPORT_OPS 0x4 # ifdef eval_sv # undef eval_sv # endif -# if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +# if defined(PERL_USE_GCC_BRACE_GROUPS) # define eval_sv(sv, flags) ({ I32 _flags = (flags); I32 _ret = Perl_eval_sv(aTHX_ sv, (_flags & ~G_RETHROW)); D_PPP_CROAK_IF_ERROR(_flags & G_RETHROW); _ret; }) # else # define eval_sv(sv, flags) ((PL_na = Perl_eval_sv(aTHX_ sv, ((flags) & ~G_RETHROW))), D_PPP_CROAK_IF_ERROR((flags) & G_RETHROW), (I32)PL_na) @@ -82,7 +82,7 @@ __UNDEFINED__ PERL_LOADMOD_IMPORT_OPS 0x4 #if { VERSION < 5.31.2 } # ifdef eval_pv # undef eval_pv -# if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +# if defined(PERL_USE_GCC_BRACE_GROUPS) # define eval_pv(p, croak_on_error) ({ SV *_sv = Perl_eval_pv(aTHX_ p, 0); D_PPP_CROAK_IF_ERROR(croak_on_error); _sv; }) # else # define eval_pv(p, croak_on_error) ((PL_Sv = Perl_eval_pv(aTHX_ p, 0)), D_PPP_CROAK_IF_ERROR(croak_on_error), PL_Sv) diff --git a/dist/Devel-PPPort/parts/inc/cop b/dist/Devel-PPPort/parts/inc/cop index a05865f..fcf64b6 100644 --- a/dist/Devel-PPPort/parts/inc/cop +++ b/dist/Devel-PPPort/parts/inc/cop @@ -57,7 +57,7 @@ DPPP_dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock) I32 i; for (i = startingblock; i >= 0; i--) { - register const PERL_CONTEXT * const cx = &cxstk[i]; + const PERL_CONTEXT * const cx = &cxstk[i]; switch (CxTYPE(cx)) { default: continue; @@ -76,9 +76,9 @@ DPPP_dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock) const PERL_CONTEXT * caller_cx(pTHX_ I32 level, const PERL_CONTEXT **dbcxp) { - register I32 cxix = DPPP_dopoptosub_at(cxstack, cxstack_ix); - register const PERL_CONTEXT *cx; - register const PERL_CONTEXT *ccstack = cxstack; + I32 cxix = DPPP_dopoptosub_at(cxstack, cxstack_ix); + const PERL_CONTEXT *cx; + const PERL_CONTEXT *ccstack = cxstack; const PERL_SI *top_si = PL_curstackinfo; for (;;) { diff --git a/dist/Devel-PPPort/parts/inc/locale b/dist/Devel-PPPort/parts/inc/locale index 41e73e3..b6c2233 100644 --- a/dist/Devel-PPPort/parts/inc/locale +++ b/dist/Devel-PPPort/parts/inc/locale @@ -1,9 +1,46 @@ =provides __UNDEFINED__ +LOCK_NUMERIC_STANDARD +UNLOCK_NUMERIC_STANDARD =implementation +#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() diff --git a/dist/Devel-PPPort/parts/inc/magic b/dist/Devel-PPPort/parts/inc/magic index 34e2b1d..8783e02 100644 --- a/dist/Devel-PPPort/parts/inc/magic +++ b/dist/Devel-PPPort/parts/inc/magic @@ -34,7 +34,7 @@ __UNDEFINED__ sv_setsv_nomg sv_setsv __UNDEFINED__ sv_pvn_nomg sv_pvn #ifdef SVf_IVisUV -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +#if defined(PERL_USE_GCC_BRACE_GROUPS) __UNDEFINED__ SvIV_nomg(sv) (!SvGMAGICAL((sv)) ? SvIV((sv)) : ({ SV *_sviv = sv_mortalcopy_flags((sv), SV_NOSTEAL); IV _iv = SvIV(_sviv); SvFLAGS((sv)) = (SvFLAGS((sv)) & ~SVf_IVisUV) | (SvFLAGS(_sviv) & SVf_IVisUV); _iv; })) __UNDEFINED__ SvUV_nomg(sv) (!SvGMAGICAL((sv)) ? SvUV((sv)) : ({ SV *_svuv = sv_mortalcopy_flags((sv), SV_NOSTEAL); UV _uv = SvUV(_svuv); SvFLAGS((sv)) = (SvFLAGS((sv)) & ~SVf_IVisUV) | (SvFLAGS(_svuv) & SVf_IVisUV); _uv; })) #else diff --git a/dist/Devel-PPPort/parts/inc/mess b/dist/Devel-PPPort/parts/inc/mess index fccec70..523480f 100644 --- a/dist/Devel-PPPort/parts/inc/mess +++ b/dist/Devel-PPPort/parts/inc/mess @@ -21,6 +21,7 @@ mess warn_nocontext croak_nocontext +PERL_ARGS_ASSERT_CROAK_XS_USAGE croak_no_modify Perl_croak_no_modify @@ -200,7 +201,8 @@ mess_sv(pTHX_ SV *basemsg, bool consume) #ifndef croak_xs_usage #if { NEED croak_xs_usage } - +#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE +#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params) void croak_xs_usage(const CV *const cv, const char *const params) @@ -208,11 +210,7 @@ croak_xs_usage(const CV *const cv, const char *const params) dTHX; const GV *const gv = CvGV(cv); -#ifdef PERL_ARGS_ASSERT_CROAK_XS_USAGE PERL_ARGS_ASSERT_CROAK_XS_USAGE; -#else - assert(cv); assert(params); -#endif if (gv) { const char *const gvname = GvNAME(gv); @@ -230,6 +228,7 @@ croak_xs_usage(const CV *const cv, const char *const params) } #endif #endif +#endif =xsinit diff --git a/dist/Devel-PPPort/parts/inc/misc b/dist/Devel-PPPort/parts/inc/misc index 78f55ed..9ec0a04 100644 --- a/dist/Devel-PPPort/parts/inc/misc +++ b/dist/Devel-PPPort/parts/inc/misc @@ -302,7 +302,7 @@ __UNDEFINED__ dITEMS I32 items = SP - MARK __UNDEFINED__ dXSTARG SV * targ = sv_newmortal() __UNDEFINED__ dAXMARK I32 ax = POPMARK; \ - register SV ** const mark = PL_stack_base + ax++ + SV ** const mark = PL_stack_base + ax++ __UNDEFINED__ XSprePUSH (sp = PL_stack_base + ax - 1) @@ -1068,13 +1068,18 @@ __UNDEFINED__ LIKELY(x) (x) __UNDEFINED__ UNLIKELY(x) (x) #ifndef MUTABLE_PTR -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +#if defined(PERL_USE_GCC_BRACE_GROUPS) # define MUTABLE_PTR(p) ({ void *_p = (p); _p; }) #else # define MUTABLE_PTR(p) ((void *) (p)) #endif #endif +__UNDEFINED__ MUTABLE_AV(p) ((AV *)MUTABLE_PTR(p)) +__UNDEFINED__ MUTABLE_CV(p) ((CV *)MUTABLE_PTR(p)) +__UNDEFINED__ MUTABLE_GV(p) ((GV *)MUTABLE_PTR(p)) +__UNDEFINED__ MUTABLE_HV(p) ((HV *)MUTABLE_PTR(p)) +__UNDEFINED__ MUTABLE_IO(p) ((IO *)MUTABLE_PTR(p)) __UNDEFINED__ MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p)) =xsmisc diff --git a/dist/Devel-PPPort/parts/inc/newCONSTSUB b/dist/Devel-PPPort/parts/inc/newCONSTSUB index fe0a6ce..120b234 100644 --- a/dist/Devel-PPPort/parts/inc/newCONSTSUB +++ b/dist/Devel-PPPort/parts/inc/newCONSTSUB @@ -19,11 +19,6 @@ NEED_newCONSTSUB /* Because we define this weirdly */ =implementation -/* Hint: newCONSTSUB - * Returns a CV* as of perl-5.7.1. This return value is not supported - * by Devel::PPPort. - */ - /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ #if { VERSION < 5.004_63 } && { VERSION != 5.004_05 } @@ -37,9 +32,10 @@ NEED_newCONSTSUB /* Because we define this weirdly */ /* (There's no PL_parser in perl < 5.005, so this is completely safe) */ #define D_PPP_PL_copline PL_copline -void +CV * newCONSTSUB(HV *stash, const char *name, SV *sv) { + CV *cv; U32 oldhints = PL_hints; HV *old_cop_stash = PL_curcop->cop_stash; HV *old_curstash = PL_curstash; @@ -50,7 +46,7 @@ newCONSTSUB(HV *stash, const char *name, SV *sv) if (stash) PL_curstash = PL_curcop->cop_stash = stash; - newSUB( + cv = newSUB( start_subparse(FALSE, 0), @@ -63,6 +59,8 @@ newCONSTSUB(HV *stash, const char *name, SV *sv) PL_curcop->cop_stash = old_cop_stash; PL_curstash = old_curstash; PL_curcop->cop_line = oldline; + + return cv; } #endif #endif diff --git a/dist/Devel-PPPort/parts/inc/newRV b/dist/Devel-PPPort/parts/inc/newRV index 6be9ca5..fe25482 100644 --- a/dist/Devel-PPPort/parts/inc/newRV +++ b/dist/Devel-PPPort/parts/inc/newRV @@ -19,7 +19,7 @@ newRV_noinc __UNDEFINED__ newRV_inc(sv) newRV(sv) /* Replace */ #ifndef newRV_noinc -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +#if defined(PERL_USE_GCC_BRACE_GROUPS) # define newRV_noinc(sv) ({ SV *_sv = (SV *)newRV((sv)); SvREFCNT_dec((sv)); _sv; }) #else # define newRV_noinc(sv) ((PL_Sv = (SV *)newRV((sv))), SvREFCNT_dec((sv)), PL_Sv) diff --git a/dist/Devel-PPPort/parts/inc/newSV_type b/dist/Devel-PPPort/parts/inc/newSV_type index 4b17419..00050e7 100644 --- a/dist/Devel-PPPort/parts/inc/newSV_type +++ b/dist/Devel-PPPort/parts/inc/newSV_type @@ -16,7 +16,7 @@ newSV_type =implementation #ifndef newSV_type -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +#if defined(PERL_USE_GCC_BRACE_GROUPS) # define newSV_type(t) ({ SV *_sv = newSV(0); sv_upgrade(_sv, (t)); _sv; }) #else # define newSV_type(t) ((PL_Sv = newSV(0)), sv_upgrade(PL_Sv, (t)), PL_Sv) diff --git a/dist/Devel-PPPort/parts/inc/newSVpv b/dist/Devel-PPPort/parts/inc/newSVpv index c17b6c9..6e96dfa 100644 --- a/dist/Devel-PPPort/parts/inc/newSVpv +++ b/dist/Devel-PPPort/parts/inc/newSVpv @@ -31,7 +31,7 @@ __UNDEFINED__ newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UT __UNDEFINED__ SVf_UTF8 0 #ifndef newSVpvn_flags -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +#if defined(PERL_USE_GCC_BRACE_GROUPS) # define newSVpvn_flags(s, len, flags) ({ SV *_sv = newSVpvn(D_PPP_CONSTPV_ARG((s)), (len)); SvFLAGS(_sv) |= ((flags) & SVf_UTF8); ((flags) & SVs_TEMP) ? sv_2mortal(_sv) : _sv; }) #else # define newSVpvn_flags(s, len, flags) ((PL_Sv = newSVpvn(D_PPP_CONSTPV_ARG((s)), (len))), SvFLAGS(PL_Sv) |= ((flags) & SVf_UTF8), (((flags) & SVs_TEMP) ? sv_2mortal(PL_Sv) : PL_Sv)) diff --git a/dist/Devel-PPPort/parts/inc/ppphtest b/dist/Devel-PPPort/parts/inc/ppphtest index cf64ab0..8140bb9 100644 --- a/dist/Devel-PPPort/parts/inc/ppphtest +++ b/dist/Devel-PPPort/parts/inc/ppphtest @@ -9,7 +9,7 @@ ## ################################################################################ -=tests plan => 238 +=tests plan => 235 BEGIN { if ($ENV{'SKIP_SLOW_TESTS'}) { @@ -284,7 +284,6 @@ ok($o =~ /^Uses newCONSTSUB/m); ok($o =~ /^Uses PL_expect/m); ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m); ok($o =~ /WARNING: PL_expect/m); -ok($o =~ /hint for newCONSTSUB/m); ok($o =~ /^Analysis completed \(1 warning\)/m); ok($o =~ /^Looks good/m); @@ -296,7 +295,6 @@ ok($o =~ /^Uses newCONSTSUB/m); ok($o =~ /^Uses PL_expect/m); ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m); ok($o =~ /WARNING: PL_expect/m); -ok($o !~ /hint for newCONSTSUB/m); ok($o =~ /^Analysis completed \(1 warning\)/m); ok($o =~ /^Looks good/m); @@ -308,7 +306,6 @@ ok($o !~ /^Uses newCONSTSUB/m); ok($o !~ /^Uses PL_expect/m); ok($o !~ /^Uses SvPV_nolen/m); ok($o =~ /WARNING: PL_expect/m); -ok($o !~ /hint for newCONSTSUB/m); ok($o =~ /^Analysis completed \(1 warning\)/m); ok($o =~ /^Looks good/m); diff --git a/dist/Devel-PPPort/parts/inc/sv_xpvf b/dist/Devel-PPPort/parts/inc/sv_xpvf index 23b0da3..d05d2d0 100644 --- a/dist/Devel-PPPort/parts/inc/sv_xpvf +++ b/dist/Devel-PPPort/parts/inc/sv_xpvf @@ -26,7 +26,7 @@ sv_vsetpvf_mg =implementation #if { VERSION >= 5.004 } && !defined(vnewSVpvf) -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +#if defined(PERL_USE_GCC_BRACE_GROUPS) # define vnewSVpvf(pat, args) ({ SV *_sv = newSV(0); sv_vsetpvfn(_sv, (pat), strlen((pat)), (args), Null(SV**), 0, Null(bool*)); _sv; }) #else # define vnewSVpvf(pat, args) ((PL_Sv = newSV(0)), sv_vsetpvfn(PL_Sv, (pat), strlen((pat)), (args), Null(SV**), 0, Null(bool*)), PL_Sv) diff --git a/dist/Devel-PPPort/parts/inc/utf8 b/dist/Devel-PPPort/parts/inc/utf8 index cf5dec0..fbfbaf0 100644 --- a/dist/Devel-PPPort/parts/inc/utf8 +++ b/dist/Devel-PPPort/parts/inc/utf8 @@ -432,7 +432,7 @@ __UNDEFINED__ utf8_to_uvchr(s, lp) /* Also note that SvGETMAGIC() may change presence of SVf_UTF8 flag */ # if { VERSION < 5.17.5 } # undef sv_len_utf8 -# if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +# if defined(PERL_USE_GCC_BRACE_GROUPS) # define sv_len_utf8_nomg(sv) ({ SV *_sv2 = (sv); (SvUTF8(_sv2) ? Perl_sv_len_utf8(aTHX_ (!SvGMAGICAL(_sv2) ? _sv2 : sv_mortalcopy_flags(_sv2, SV_NOSTEAL))) : ({ STRLEN _len; SvPV_nomg(_sv2, _len); _len; })); }) # define sv_len_utf8(sv) ({ SV *_sv1 = (sv); SvGETMAGIC(_sv1); sv_len_utf8_nomg(_sv1); }) # else @@ -440,7 +440,7 @@ __UNDEFINED__ utf8_to_uvchr(s, lp) # define sv_len_utf8(sv) (PL_Sv = (sv), SvGETMAGIC(PL_Sv), sv_len_utf8_nomg(PL_Sv)) # endif # endif -# if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +# if defined(PERL_USE_GCC_BRACE_GROUPS) __UNDEFINED__ sv_len_utf8_nomg(sv) ({ SV *_sv = (sv); sv_len_utf8(!SvGMAGICAL(_sv) ? _sv : sv_mortalcopy_flags(_sv, SV_NOSTEAL)); }) # else __UNDEFINED__ sv_len_utf8_nomg(sv) ((PL_Sv = (sv)), sv_len_utf8(!SvGMAGICAL(PL_Sv) ? PL_Sv : sv_mortalcopy_flags(PL_Sv, SV_NOSTEAL))) diff --git a/dist/Devel-PPPort/parts/inc/uv b/dist/Devel-PPPort/parts/inc/uv index 9332c21..0191b70 100644 --- a/dist/Devel-PPPort/parts/inc/uv +++ b/dist/Devel-PPPort/parts/inc/uv @@ -28,7 +28,7 @@ __UNDEFINED__ sv_setuv(sv, uv) \ __UNDEFINED__ newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv)) -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +#if defined(PERL_USE_GCC_BRACE_GROUPS) __UNDEFINED__ sv_2uv(sv) ({ SV *_sv = (sv); (UV) (SvNOK(_sv) ? SvNV(_sv) : sv_2nv(_sv)); }) #else __UNDEFINED__ sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv))) @@ -38,7 +38,7 @@ __UNDEFINED__ SvUVX(sv) ((UV)SvIVX(sv)) __UNDEFINED__ SvUVXx(sv) SvUVX(sv) __UNDEFINED__ SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +#if defined(PERL_USE_GCC_BRACE_GROUPS) __UNDEFINED__ SvUVx(sv) ({ SV *_sv = (sv)); SvUV(_sv); }) #else __UNDEFINED__ SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) diff --git a/dist/Devel-PPPort/parts/inc/version b/dist/Devel-PPPort/parts/inc/version index c15b50e..624183e 100644 --- a/dist/Devel-PPPort/parts/inc/version +++ b/dist/Devel-PPPort/parts/inc/version @@ -26,7 +26,7 @@ PERL_BCDVERSION =implementation -#define D_PPP_RELEASE_DATE 1597104000 /* 2020-08-11 */ +#define D_PPP_RELEASE_DATE 1602806400 /* 2020-10-16 */ #if ! defined(PERL_REVISION) && ! defined(PERL_VERSION_MAJOR) # if ! defined(__PATCHLEVEL_H_INCLUDED__) \ diff --git a/dist/Devel-PPPort/parts/inc/warn b/dist/Devel-PPPort/parts/inc/warn index d3c0d05..4e998e1 100644 --- a/dist/Devel-PPPort/parts/inc/warn +++ b/dist/Devel-PPPort/parts/inc/warn @@ -13,8 +13,13 @@ __UNDEFINED__ ckWARN +ckWARN_d warner +ck_warner +ck_warner_d Perl_warner +Perl_ck_warner +Perl_ck_warner_d Perl_warner_nocontext =implementation @@ -67,7 +72,10 @@ __UNDEFINED__ WARN_UTF8 44 __UNDEFINED__ WARN_VOID 45 __UNDEFINED__ WARN_ASSERTIONS 46 -__UNDEFINED__ packWARN(a) (a) +__UNDEFINED__ packWARN(a) (a) +__UNDEFINED__ packWARN2(a,b) (packWARN(a) << 8 | (b)) +__UNDEFINED__ packWARN3(a,b,c) (packWARN2(a,b) << 8 | (c)) +__UNDEFINED__ packWARN4(a,b,c,d) (packWARN3(a,b,c) << 8 | (d)) #ifndef ckWARN # ifdef G_WARN_ON @@ -77,34 +85,107 @@ __UNDEFINED__ packWARN(a) (a) # endif #endif +__UNDEFINED__ ckWARN2(a,b) (ckWARN(a) || ckWARN(b)) +__UNDEFINED__ ckWARN3(a,b,c) (ckWARN(c) || ckWARN2(a,b)) +__UNDEFINED__ ckWARN4(a,b,c,d) (ckWARN(d) || ckWARN3(a,b,c)) + +#ifndef ckWARN_d +# ifdef isLEXWARN_off +# define ckWARN_d(a) (isLEXWARN_off || ckWARN(a)) +# else +# define ckWARN_d(a) 1 +# endif +#endif + +__UNDEFINED__ ckWARN2_d(a,b) (ckWARN_d(a) || ckWARN_d(b)) +__UNDEFINED__ ckWARN3_d(a,b,c) (ckWARN_d(c) || ckWARN2_d(a,b)) +__UNDEFINED__ ckWARN4_d(a,b,c,d) (ckWARN_d(d) || ckWARN3_d(a,b,c)) + +__UNDEFINED__ vwarner(err, pat, argsp) \ + STMT_START { SV *sv; \ + PERL_UNUSED_ARG(err); \ + sv = vnewSVpvf(pat, argsp); \ + sv_2mortal(sv); \ + warn("%s", SvPV_nolen(sv)); \ + } STMT_END + + #if { VERSION >= 5.004 } && !defined(warner) -#if { NEED warner } +# if { NEED warner } void warner(U32 err, const char *pat, ...) { - SV *sv; va_list args; - - PERL_UNUSED_ARG(err); - va_start(args, pat); - sv = vnewSVpvf(pat, &args); + vwarner(err, pat, &args); va_end(args); - sv_2mortal(sv); - warn("%s", SvPV_nolen(sv)); } -#define warner Perl_warner +# define warner Perl_warner -#define Perl_warner_nocontext Perl_warner +# define Perl_warner_nocontext Perl_warner +# endif #endif + +#if { VERSION >= 5.004 } && !defined(ck_warner) +# if { NEED ck_warner } + +void +ck_warner(pTHX_ U32 err, const char *pat, ...) +{ + va_list args; + + if ( ! ckWARN((err ) & 0xFF) + && ! ckWARN((err >> 8) & 0xFF) + && ! ckWARN((err >> 16) & 0xFF) + && ! ckWARN((err >> 24) & 0xFF)) + { + return; + } + + va_start(args, pat); + vwarner(err, pat, &args); + va_end(args); +} + +# define ck_warner Perl_ck_warner +# endif +#endif + +#if { VERSION >= 5.004 } && !defined(ck_warner_d) +# if { NEED ck_warner_d } + +void +ck_warner_d(pTHX_ U32 err, const char *pat, ...) +{ + va_list args; + + if ( ! ckWARN_d((err ) & 0xFF) + && ! ckWARN_d((err >> 8) & 0xFF) + && ! ckWARN_d((err >> 16) & 0xFF) + && ! ckWARN_d((err >> 24) & 0xFF)) + { + return; + } + + va_start(args, pat); + vwarner(err, pat, &args); + va_end(args); +} + +# define ck_warner_d Perl_ck_warner_d + + +# endif #endif =xsinit #define NEED_warner +#define NEED_ck_warner +#define NEED_ck_warner_d =xsubs @@ -123,6 +204,20 @@ Perl_warner() #endif void +Perl_ck_warner() + CODE: +#if { VERSION >= 5.004 } + Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Perl_ck_warner %s:%d", "bar", 42); +#endif + +void +Perl_ck_warner_d() + CODE: +#if { VERSION >= 5.004 } + Perl_ck_warner_d(aTHX_ packWARN(WARN_MISC), "Perl_ck_warner_d %s:%d", "bar", 42); +#endif + +void Perl_warner_nocontext() CODE: #if { VERSION >= 5.004 } @@ -137,7 +232,15 @@ ckWARN() Perl_warner_nocontext(packWARN(WARN_MISC), "ckWARN %s:%d", "bar", 42); #endif -=tests plan => 5 +void +ckWARN_d() + CODE: +#if { VERSION >= 5.004 } + if (ckWARN_d(WARN_MISC)) + Perl_warner_nocontext(packWARN(WARN_MISC), "ckWARN_d %s:%d", "bar", 42); +#endif + +=tests plan => 11 $^W = 0; @@ -161,8 +264,32 @@ $warning = ''; Devel::PPPort::ckWARN(); is($warning, ''); +$warning = ''; +Devel::PPPort::ckWARN_d(); +ok(ivers($]) >= ivers("5.004") ? $warning =~ /^ckWARN_d bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::Perl_ck_warner(); +ok($warning eq ''); + +$warning = ''; +Devel::PPPort::Perl_ck_warner_d(); +ok(ivers($]) >= ivers("5.004") ? $warning =~ /^Perl_ck_warner_d bar:42/ : $warning eq ''); + $^W = 1; $warning = ''; Devel::PPPort::ckWARN(); ok(ivers($]) >= ivers("5.004") ? $warning =~ /^ckWARN bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::ckWARN_d(); +ok(ivers($]) >= ivers("5.004") ? $warning =~ /^ckWARN_d bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::Perl_ck_warner(); +ok(ivers($]) >= ivers("5.004") ? $warning =~ /^Perl_ck_warner bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::Perl_ck_warner_d(); +ok(ivers($]) >= ivers("5.004") ? $warning =~ /^Perl_ck_warner_d bar:42/ : $warning eq ''); -- 1.8.3.1