Deprecate toFOO_utf8()

Now that there are _safe versions, deprecate the unsafe ones.

2 files changed, 74 insertions, 0 deletions

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 9c0fd1930a..39af336fb2 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -6209,8 +6209,18 @@ test_toLOWER_utf8(SV * p, int type)
     CODE:
         input = (U8 *) SvPV(p, len);
         av = newAV();
+        if (type >= 0) {
             e = input + UTF8SKIP(input) - type;
             resultant_cp = toLOWER_utf8_safe(input, e, s, &len);
+        }
+        else if (type == -1) {
+            resultant_cp = toLOWER_utf8(input, s, &len);
+        }
+#ifndef NO_MATHOMS
+        else {
+            resultant_cp = Perl_to_utf8_lower(aTHX_ input, s, &len);
+        }
+#endif
         av_push(av, newSVuv(resultant_cp));
 
         utf8 = newSVpvn((char *) s, len);
@@ -6289,8 +6299,18 @@ test_toFOLD_utf8(SV * p, int type)
     CODE:
         input = (U8 *) SvPV(p, len);
         av = newAV();
+        if (type >= 0) {
             e = input + UTF8SKIP(input) - type;
             resultant_cp = toFOLD_utf8_safe(input, e, s, &len);
+        }
+        else if (type == -1) {
+            resultant_cp = toFOLD_utf8(input, s, &len);
+        }
+#ifndef NO_MATHOMS
+        else {
+            resultant_cp = Perl_to_utf8_fold(aTHX_ input, s, &len);
+        }
+#endif
         av_push(av, newSVuv(resultant_cp));
 
         utf8 = newSVpvn((char *) s, len);
@@ -6369,8 +6389,18 @@ test_toUPPER_utf8(SV * p, int type)
     CODE:
         input = (U8 *) SvPV(p, len);
         av = newAV();
+        if (type >= 0) {
             e = input + UTF8SKIP(input) - type;
             resultant_cp = toUPPER_utf8_safe(input, e, s, &len);
+        }
+        else if (type == -1) {
+            resultant_cp = toUPPER_utf8(input, s, &len);
+        }
+#ifndef NO_MATHOMS
+        else {
+            resultant_cp = Perl_to_utf8_upper(aTHX_ input, s, &len);
+        }
+#endif
         av_push(av, newSVuv(resultant_cp));
 
         utf8 = newSVpvn((char *) s, len);
@@ -6442,8 +6472,18 @@ test_toTITLE_utf8(SV * p, int type)
     CODE:
         input = (U8 *) SvPV(p, len);
         av = newAV();
+        if (type >= 0) {
             e = input + UTF8SKIP(input) - type;
             resultant_cp = toTITLE_utf8_safe(input, e, s, &len);
+        }
+        else if (type == -1) {
+            resultant_cp = toTITLE_utf8(input, s, &len);
+        }
+#ifndef NO_MATHOMS
+        else {
+            resultant_cp = Perl_to_utf8_title(aTHX_ input, s, &len);
+        }
+#endif
         av_push(av, newSVuv(resultant_cp));
 
         utf8 = newSVpvn((char *) s, len);
diff --git a/ext/XS-APItest/t/handy.t b/ext/XS-APItest/t/handy.t
index f21a39d3bd..8712524770 100644
--- a/ext/XS-APItest/t/handy.t
+++ b/ext/XS-APItest/t/handy.t
@@ -161,6 +161,7 @@ my %utf8_param_code = (
                         "_safe"                 =>  0,
                         "_safe, malformed"      =>  1,
                         "deprecated unsafe"     => -1,
+                        "deprecated mathoms"    => -2,
                       );
 
 foreach my $name (sort keys %properties, 'octal') {
@@ -536,8 +537,14 @@ foreach my $name (sort keys %to_properties) {
         $char = quotemeta $char if $char eq '\\' || $char eq "'";
         foreach my $utf8_param("_safe",
                                 "_safe, malformed",
+                                "deprecated unsafe",
+                                "deprecated mathoms",
                                 )
         {
+            use Config;
+            next if    $utf8_param eq 'deprecated mathoms'
+                    && $Config{'ccflags'} =~ /-DNO_MATHOMS/;
+
             my $utf8_param_code = $utf8_param_code{$utf8_param};
             my $expect_error = $utf8_param_code > 0;
 
@@ -560,6 +567,33 @@ foreach my $name (sort keys %to_properties) {
                 use bytes;
                 is ($ret->[2], length $utf8_should_be,
                     "${tab}Got correct number of bytes for utf8 length");
+                if ($utf8_param_code < 0) {
+                    my $warnings_ok;
+                    if (! $seen{"${function}_utf8$utf8_param"}++) {
+                        $warnings_ok = is(@warnings, 1,
+                                                   "${tab}Got a single warning");
+                        if ($warnings_ok) {
+                            my $expected;
+                            if ($utf8_param_code == -2) {
+                                my $lc_func = lc $function;
+                                $expected
+                = qr/starting in Perl .* to_utf8_$lc_func\(\) will be removed/;
+                            }
+                            else {
+                                $expected
+                = qr/starting in Perl .* will require an additional parameter/;
+                            }
+                            $warnings_ok = like($warnings[0], $expected,
+                                      "${tab}Got expected deprecation warning");
+                        }
+                    }
+                    else {
+                        $warnings_ok = is(@warnings, 0,
+                                  "${tab}Deprecation warned only the one time");
+                    }
+                    $warnings_ok or diag("@warnings");
+                    undef @warnings;
+                }
             }
         }
     }