ext/XS-APItest/t/my_cxt.t XS::APItest: test MY_CXT interface
ext/XS-APItest/t/my_exit.t XS::APItest: test my_exit
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/pmflag.t Test removal of 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
#if defined(PERL_USES_PL_PIDSTATUS) && defined(PERL_IN_UTIL_C)
s |void |pidgone |Pid_t pid|int status
#endif
-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)
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 pmflag my_exit
+ DPeek utf16_to_utf8 utf16_to_utf8_reversed my_exit
sv_count
);
ST(0) = dest;
XSRETURN(1);
-U32
-pmflag (flag, before = 0)
- int flag
- U32 before
- CODE:
- pmflag(&before, flag);
- RETVAL = before;
- OUTPUT:
- RETVAL
-
void
my_exit(int exitcode)
PPCODE:
#!perl
use strict;
-use Test::More 'no_plan';
+use Test::More 'tests' => 2;
-my @warnings;
-$SIG{__WARN__} = sub {
- push @warnings, "@_";
-};
+ok(!eval q{use XS::APItest 'pmflag'; 1}, "Perl_pmflag\(\) removed");
+like($@, qr{\Wpmflag\W\s+is\s+not\s+exported\b}, "pmflag not exported");
-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 = ();
- }
-}
Perl_require_pv
Perl_pack_cat
Perl_packlist
-Perl_pmflag
Perl_pop_scope
Perl_push_scope
Perl_ref
# 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
conversion functions. This is only a problem when you're using the
'<' or '>' modifiers in (un)pack templates. See L<perlfunc/pack>.
-=item Perl_pmflag() is deprecated, and will be removed from the XS API
-
-(D deprecated) XS code called the C function C<Perl_pmflag>. 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
#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)
- __attribute__deprecated__
- __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_PMFLAG \
- assert(pmfl)
-
PERL_CALLCONV OP* Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2);
return pmfl;
}
-void
-Perl_pmflag(pTHX_ U32* pmfl, int ch)
-{
- PERL_ARGS_ASSERT_PMFLAG;
-
- Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
- "Perl_pmflag() is deprecated, and will be removed from the XS API");
-
- if (ch<256) {
- *pmfl = S_pmflag(*pmfl, (char)ch);
- }
-}
-
STATIC char *
S_scan_pat(pTHX_ char *start, I32 type)
{