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.

3 files changed, 53 insertions, 2 deletions

diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm
index c40e4b8a4b..f80f3ea13e 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 18d6752e8b..e8c36d7961 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 0000000000..269b6bc64b
--- /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 = ();
+    }
+}