remove Perl_pmflag
Robin Barker [Mon, 19 Apr 2010 16:00:59 +0000 (17:00 +0100)]
MANIFEST
embed.fnc
ext/XS-APItest/APItest.pm
ext/XS-APItest/APItest.xs
ext/XS-APItest/t/pmflag.t
global.sym
perl.h
pod/perldiag.pod
proto.h
toke.c

index f774db8..436d921 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3224,7 +3224,7 @@ 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/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
index 60bf9a7..c1580e0 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -908,7 +908,6 @@ 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
-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)
index acb885e..8612cff 100644 (file)
@@ -23,7 +23,7 @@ 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 pmflag my_exit
+                 DPeek utf16_to_utf8 utf16_to_utf8_reversed my_exit
                  sv_count
 );
 
index 328ddea..ee57c83 100644 (file)
@@ -922,16 +922,6 @@ utf16_to_utf8 (sv, ...)
        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:
index 269b6bc..65011d2 100644 (file)
@@ -1,41 +1,7 @@
 #!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 = ();
-    }
-}
index 6b9b267..6f053a6 100644 (file)
@@ -420,7 +420,6 @@ Perl_set_numeric_standard
 Perl_require_pv
 Perl_pack_cat
 Perl_packlist
-Perl_pmflag
 Perl_pop_scope
 Perl_push_scope
 Perl_ref
diff --git a/perl.h b/perl.h
index 50351a9..89997a0 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -3197,14 +3197,6 @@ 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
index 30ce129..6d6322a 100644 (file)
@@ -3447,13 +3447,6 @@ 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<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
diff --git a/proto.h b/proto.h
index 87f57f0..53e103d 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2627,12 +2627,6 @@ 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)
-                       __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);
diff --git a/toke.c b/toke.c
index fa0d939..21b69cb 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -11848,19 +11848,6 @@ S_pmflag(U32 pmfl, const char ch) {
     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)
 {