'EXCLUDED' => [
'PPPort.pm', # we use PPPort_pm.PL instead
],
- 'CUSTOMIZED' => [ qw(Makefile.PL) ],
},
'Devel::SelfStubber' => {
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)
* 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()
use strict;
use vars qw($VERSION $data);
-$VERSION = '3.60';
+$VERSION = '3.62';
sub _init_data
{
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 (<F>) {
next unless/^%include (\w+)/;
else {
foreach my $define (keys %defines) {
# Don't override input 'M' symbols.
- $remaining{$define} = $new_code
+ $remaining{$define} = 'Z'
unless defined $remaining{$define};
}
}
__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
__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)
#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)) { \
#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)) { \
)
#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)
__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))
# 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)
#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)
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;
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 (;;) {
=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()
__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
warn_nocontext
croak_nocontext
+PERL_ARGS_ASSERT_CROAK_XS_USAGE
croak_no_modify
Perl_croak_no_modify
#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)
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);
}
#endif
#endif
+#endif
=xsinit
__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)
__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
=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 }
/* (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;
if (stash)
PL_curstash = PL_curcop->cop_stash = stash;
- newSUB(
+ cv = newSUB(
start_subparse(FALSE, 0),
PL_curcop->cop_stash = old_cop_stash;
PL_curstash = old_curstash;
PL_curcop->cop_line = oldline;
+
+ return cv;
}
#endif
#endif
__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)
=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)
__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))
##
################################################################################
-=tests plan => 238
+=tests plan => 235
BEGIN {
if ($ENV{'SKIP_SLOW_TESTS'}) {
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);
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);
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);
=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)
/* 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
# 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)))
__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)))
__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))
=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__) \
__UNDEFINED__
ckWARN
+ckWARN_d
warner
+ck_warner
+ck_warner_d
Perl_warner
+Perl_ck_warner
+Perl_ck_warner_d
Perl_warner_nocontext
=implementation
__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
# 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
#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 }
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;
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 '');
https://perl5.git.perl.org / perl5.git / commitdiff