From: Nicholas Clark Date: Sun, 1 Nov 2009 16:43:22 +0000 (+0000) Subject: Remove Perl_pmflag() from the public API, and mark it as deprecated. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=879d0c7269cae2ffd414e7e03bcd3bc03ba587d3;p=p5sagit%2Fp5-mst-13.2.git Remove Perl_pmflag() from the public API, and mark it as deprecated. regcomp.c stopped using it before 5.10, leaving only toke.c. The only code on CPAN that uses it is copies of regcomp.c. Replace it with a static function, with a cleaner interface. --- diff --git a/MANIFEST b/MANIFEST index 4f685b8..44b1bde 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3207,6 +3207,7 @@ ext/XS-APItest/t/exception.t XS::APItest extension ext/XS-APItest/t/hash.t XS::APItest: tests for hash related APIs ext/XS-APItest/t/my_cxt.t XS::APItest: test MY_CXT interface ext/XS-APItest/t/op.t XS::APItest: tests for OP related APIs +ext/XS-APItest/t/pmflag.t Test deprecation warning for Perl_pmflag() ext/XS-APItest/t/printf.t XS::APItest extension ext/XS-APItest/t/push.t XS::APItest extension ext/XS-APItest/t/rmagical.t XS::APItest extension diff --git a/embed.fnc b/embed.fnc index d107614..3d07282 100644 --- a/embed.fnc +++ b/embed.fnc @@ -800,7 +800,7 @@ Apd |void |packlist |NN SV *cat|NN const char *pat|NN const char *patend|NN SV #if defined(PERL_USES_PL_PIDSTATUS) && defined(PERL_IN_UTIL_C) s |void |pidgone |Pid_t pid|int status #endif -Ap |void |pmflag |NN U32* pmfl|int ch +DUXpo |void |pmflag |NN U32 *pmfl|int ch : Used in perly.y p |OP* |pmruntime |NN OP *o|NN OP *expr|bool isreg #if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT) diff --git a/embed.h b/embed.h index 58e36ee..8012c5e 100644 --- a/embed.h +++ b/embed.h @@ -695,7 +695,6 @@ #define pidgone S_pidgone #endif #endif -#define pmflag Perl_pmflag #ifdef PERL_CORE #define pmruntime Perl_pmruntime #endif @@ -3063,7 +3062,6 @@ #define pidgone(a,b) S_pidgone(aTHX_ a,b) #endif #endif -#define pmflag(a,b) Perl_pmflag(aTHX_ a,b) #ifdef PERL_CORE #define pmruntime(a,b,c) Perl_pmruntime(aTHX_ a,b,c) #endif diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index c40e4b8..f80f3ea 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -23,10 +23,10 @@ our @EXPORT = qw( print_double print_int print_long my_cxt_getint my_cxt_getsv my_cxt_setint my_cxt_setsv sv_setsv_cow_hashkey_core sv_setsv_cow_hashkey_notcore rmagical_cast rmagical_flags - DPeek utf16_to_utf8 utf16_to_utf8_reversed + DPeek utf16_to_utf8 utf16_to_utf8_reversed pmflag ); -our $VERSION = '0.16'; +our $VERSION = '0.17'; use vars '$WARNINGS_ON_BOOTSTRAP'; use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END); diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 18d6752..e8c36d7 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -921,3 +921,13 @@ utf16_to_utf8 (sv, ...) SvPOK_on(dest); ST(0) = dest; XSRETURN(1); + +U32 +pmflag (flag, before = 0) + int flag + U32 before + CODE: + pmflag(&before, flag); + RETVAL = before; + OUTPUT: + RETVAL diff --git a/ext/XS-APItest/t/pmflag.t b/ext/XS-APItest/t/pmflag.t new file mode 100644 index 0000000..269b6bc --- /dev/null +++ b/ext/XS-APItest/t/pmflag.t @@ -0,0 +1,41 @@ +#!perl +use strict; +use Test::More 'no_plan'; + +my @warnings; +$SIG{__WARN__} = sub { + push @warnings, "@_"; +}; + +use XS::APItest 'pmflag'; + +foreach (["\0", 0], + ['Q', 0], + ['c', 0x00004000], + ) { + my ($char, $val) = @$_; + my $ord = ord $char; + foreach my $before (0, 1) { + my $got = pmflag($ord, $before); + is($got, $before | $val, "Flag $ord, before $before"); + is(@warnings, 1); + like($warnings[0], + qr/^Perl_pmflag\(\) is deprecated, and will be removed from the XS API/); + @warnings = (); + + no warnings 'deprecated'; + + $got = pmflag($ord, $before); + is($got, $before | $val, "Flag $ord, before $before"); + is(@warnings, 0); + @warnings = (); + + use warnings; + $got = pmflag($ord, $before); + is($got, $before | $val, "Flag $ord, before $before"); + is(@warnings, 1); + like($warnings[0], + qr/^Perl_pmflag\(\) is deprecated, and will be removed from the XS API/); + @warnings = (); + } +} diff --git a/perl.h b/perl.h index c4521aa..9f80c5b 100644 --- a/perl.h +++ b/perl.h @@ -3179,6 +3179,14 @@ typedef pthread_key_t perl_key; # endif #endif +#if !defined(PERL_CORE) && !defined(PERL_NO_SHORT_NAMES) +# if defined(PERL_IMPLICIT_CONTEXT) +# define pmflag(a,b) Perl_pmflag(aTHX_ a,b) +# else +# define pmflag Perl_pmflag +# endif +#endif + #ifdef HASATTRIBUTE_DEPRECATED # define __attribute__deprecated__ __attribute__((deprecated)) #endif diff --git a/pod/perl5112delta.pod b/pod/perl5112delta.pod index fb8c855..b2a6522 100644 --- a/pod/perl5112delta.pod +++ b/pod/perl5112delta.pod @@ -167,13 +167,15 @@ XXX =head1 Changed Internals -XXX Changes which affect the interface available to C code go here. - =over 4 =item * -XXX +C has been removed from the public API. Calling it now generates +a deprecation warning, and it will be removed in a future release. Although +listed as part of the API, it was never documented, and only ever used in +F, and prior to 5.10, F. In core, it has been replaced by a +static function. =back diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 22b30f8..3f0a78a 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -3280,6 +3280,13 @@ so it was not possible to set up some or all fixed-width byte-order conversion functions. This is only a problem when you're using the '<' or '>' modifiers in (un)pack templates. See L. +=item Perl_pmflag() is deprecated, and will be removed from the XS API + +(D deprecated) XS code called the C function C. This was part of +Perl's listed public API for extending or embedding the perl interpreter. It has +now been removed from the public API, and will be removed in a future release, +hence XS code should be re-written not to use it. + =item Perl %s required--this is only version %s, stopped (F) The module in question uses features of a version of Perl more diff --git a/proto.h b/proto.h index f4769a3..6888848 100644 --- a/proto.h +++ b/proto.h @@ -2500,7 +2500,8 @@ PERL_CALLCONV void Perl_packlist(pTHX_ SV *cat, const char *pat, const char *pat #if defined(PERL_USES_PL_PIDSTATUS) && defined(PERL_IN_UTIL_C) STATIC void S_pidgone(pTHX_ Pid_t pid, int status); #endif -PERL_CALLCONV void Perl_pmflag(pTHX_ U32* pmfl, int ch) +PERL_CALLCONV void Perl_pmflag(pTHX_ U32 *pmfl, int ch) + __attribute__deprecated__ __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_PMFLAG \ assert(pmfl) diff --git a/toke.c b/toke.c index 8c019c5..61ac8ae 100644 --- a/toke.c +++ b/toke.c @@ -10932,21 +10932,28 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL return s; } +static U32 +S_pmflag(U32 pmfl, const char ch) { + switch (ch) { + CASE_STD_PMMOD_FLAGS_PARSE_SET(&pmfl); + case GLOBAL_PAT_MOD: pmfl |= PMf_GLOBAL; break; + case CONTINUE_PAT_MOD: pmfl |= PMf_CONTINUE; break; + case ONCE_PAT_MOD: pmfl |= PMf_KEEP; break; + case KEEPCOPY_PAT_MOD: pmfl |= PMf_KEEPCOPY; break; + } + return pmfl; +} + void Perl_pmflag(pTHX_ U32* pmfl, int ch) { PERL_ARGS_ASSERT_PMFLAG; - PERL_UNUSED_CONTEXT; + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), + "Perl_pmflag() is deprecated, and will be removed from the XS API"); + if (ch<256) { - const char c = (char)ch; - switch (c) { - CASE_STD_PMMOD_FLAGS_PARSE_SET(pmfl); - case GLOBAL_PAT_MOD: *pmfl |= PMf_GLOBAL; break; - case CONTINUE_PAT_MOD: *pmfl |= PMf_CONTINUE; break; - case ONCE_PAT_MOD: *pmfl |= PMf_KEEP; break; - case KEEPCOPY_PAT_MOD: *pmfl |= PMf_KEEPCOPY; break; - } + *pmfl = S_pmflag(*pmfl, (char)ch); } } @@ -11000,7 +11007,7 @@ S_scan_pat(pTHX_ char *start, I32 type) modstart = s; #endif while (*s && strchr(valid_flags, *s)) - pmflag(&pm->op_pmflags,*s++); + pm->op_pmflags = S_pmflag(pm->op_pmflags, *s++); #ifdef PERL_MAD if (PL_madskills && modstart != s) { SV* tmptoken = newSVpvn(modstart, s - modstart); @@ -11080,7 +11087,7 @@ S_scan_subst(pTHX_ char *start) es++; } else if (strchr(S_PAT_MODS, *s)) - pmflag(&pm->op_pmflags,*s++); + pm->op_pmflags = S_pmflag(pm->op_pmflags, *s++); else break; }