This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Deprecate toFOO_utf8()
authorKarl Williamson <khw@cpan.org>
Mon, 19 Dec 2016 18:23:22 +0000 (11:23 -0700)
committerKarl Williamson <khw@cpan.org>
Sat, 24 Dec 2016 05:36:34 +0000 (22:36 -0700)
Now that there are _safe versions, deprecate the unsafe ones.

embed.fnc
embed.h
ext/XS-APItest/APItest.xs
ext/XS-APItest/t/handy.t
handy.h
pod/perldelta.pod
proto.h
utf8.c
utf8.h

index b7325a9..7e1c3f2 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1729,6 +1729,13 @@ s        |void   |warn_on_first_deprecated_use                               \
                                |const bool use_locale                      \
                                |NN const char * const file                 \
                                |const unsigned line
+s      |U32    |check_and_deprecate                                        \
+                               |NN const U8 * p                            \
+                               |NN const U8 ** e                           \
+                               |const unsigned type                        \
+                               |const bool use_locale                      \
+                               |NN const char * const file                 \
+                               |const unsigned line
 s      |UV     |_to_utf8_case  |const UV uv1                                   \
                                |NN const U8 *p                                 \
                                |NN U8* ustrp                                   \
@@ -1737,18 +1744,22 @@ s       |UV     |_to_utf8_case  |const UV uv1                                   \
                                |NN const char *normal                          \
                                |NULLOK const char *special
 #endif
-Apbmd  |UV     |to_utf8_lower  |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp
+ApbmdD |UV     |to_utf8_lower  |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp
 AMp    |UV     |_to_utf8_lower_flags|NN const U8 *p|NULLOK const U8* e         \
-                               |NN U8* ustrp|NULLOK STRLEN *lenp|bool flags
-Apbmd  |UV     |to_utf8_upper  |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp
+                               |NN U8* ustrp|NULLOK STRLEN *lenp|bool flags    \
+                               |NN const char * const file|const int line
+ApbmdD |UV     |to_utf8_upper  |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp
 AMp    |UV     |_to_utf8_upper_flags   |NN const U8 *p|NULLOK const U8 *e      \
-                               |NN U8* ustrp|NULLOK STRLEN *lenp|bool flags
-Apbmd  |UV     |to_utf8_title  |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp
+                               |NN U8* ustrp|NULLOK STRLEN *lenp|bool flags    \
+                               |NN const char * const file|const int line
+ApbmdD |UV     |to_utf8_title  |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp
 AMp    |UV     |_to_utf8_title_flags   |NN const U8 *p|NULLOK const U8* e      \
-                               |NN U8* ustrp|NULLOK STRLEN *lenp|bool flags
-Apbmd  |UV     |to_utf8_fold   |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp
+                               |NN U8* ustrp|NULLOK STRLEN *lenp|bool flags    \
+                               |NN const char * const file|const int line
+ApbmdD |UV     |to_utf8_fold   |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp
 AMp    |UV     |_to_utf8_fold_flags|NN const U8 *p|NULLOK const U8 *e          \
-                               |NN U8* ustrp|NULLOK STRLEN *lenp|U8 flags
+                               |NN U8* ustrp|NULLOK STRLEN *lenp|U8 flags  \
+                               |NN const char * const file|const int line
 #if defined(PERL_IN_MG_C) || defined(PERL_IN_PP_C)
 pn     |bool   |translate_substr_offsets|STRLEN curlen|IV pos1_iv \
                                         |bool pos1_is_uv|IV len_iv \
diff --git a/embed.h b/embed.h
index f2c7c9b..3b3eb86 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define _is_utf8_xidcont(a)    Perl__is_utf8_xidcont(aTHX_ a)
 #define _is_utf8_xidstart(a)   Perl__is_utf8_xidstart(aTHX_ a)
 #define _to_uni_fold_flags(a,b,c,d)    Perl__to_uni_fold_flags(aTHX_ a,b,c,d)
-#define _to_utf8_fold_flags(a,b,c,d,e) Perl__to_utf8_fold_flags(aTHX_ a,b,c,d,e)
-#define _to_utf8_lower_flags(a,b,c,d,e)        Perl__to_utf8_lower_flags(aTHX_ a,b,c,d,e)
-#define _to_utf8_title_flags(a,b,c,d,e)        Perl__to_utf8_title_flags(aTHX_ a,b,c,d,e)
-#define _to_utf8_upper_flags(a,b,c,d,e)        Perl__to_utf8_upper_flags(aTHX_ a,b,c,d,e)
+#define _to_utf8_fold_flags(a,b,c,d,e,f,g)     Perl__to_utf8_fold_flags(aTHX_ a,b,c,d,e,f,g)
+#define _to_utf8_lower_flags(a,b,c,d,e,f,g)    Perl__to_utf8_lower_flags(aTHX_ a,b,c,d,e,f,g)
+#define _to_utf8_title_flags(a,b,c,d,e,f,g)    Perl__to_utf8_title_flags(aTHX_ a,b,c,d,e,f,g)
+#define _to_utf8_upper_flags(a,b,c,d,e,f,g)    Perl__to_utf8_upper_flags(aTHX_ a,b,c,d,e,f,g)
 #define amagic_call(a,b,c,d)   Perl_amagic_call(aTHX_ a,b,c,d)
 #define amagic_deref_call(a,b) Perl_amagic_deref_call(aTHX_ a,b)
 #define apply_attrs_string(a,b,c,d)    Perl_apply_attrs_string(aTHX_ a,b,c,d)
 #  if defined(PERL_IN_UTF8_C)
 #define _byte_dump_string(a,b) S__byte_dump_string(aTHX_ a,b)
 #define _to_utf8_case(a,b,c,d,e,f,g)   S__to_utf8_case(aTHX_ a,b,c,d,e,f,g)
+#define check_and_deprecate(a,b,c,d,e,f)       S_check_and_deprecate(aTHX_ a,b,c,d,e,f)
 #define check_locale_boundary_crossing(a,b,c,d)        S_check_locale_boundary_crossing(aTHX_ a,b,c,d)
 #define does_utf8_overflow     S_does_utf8_overflow
 #define isFF_OVERLONG          S_isFF_OVERLONG
index 9c0fd19..39af336 100644 (file)
@@ -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);
index f21a39d..8712524 100644 (file)
@@ -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;
+                }
             }
         }
     }
diff --git a/handy.h b/handy.h
index 129e98b..330f812 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -870,7 +870,14 @@ implementation, and subject to change in future releases.
 =for apidoc Am|UV|toUPPER_utf8|U8* p|U8* s|STRLEN* lenp
 This is like C<L</toUPPER_utf8_safe>>, but doesn't have the C<e>
 parameter  The function therefore can't check if it is reading
-beyond the end of the string.
+beyond the end of the string.  Starting in Perl v5.30, it will take the C<e>
+parameter, becoming a synonym for C<toUPPER_utf8_safe>.  At that time every
+program that uses it will have to be changed to successfully compile.  In the
+meantime, the first runtime call to C<toUPPER_utf8> from each call point in the
+program will raise a deprecation warning, enabled by default.  You can convert
+your program now to use C<toUPPER_utf8_safe>, and avoid the warnings, and get an
+extra measure of protection, or you can wait until v5.30, when you'll be forced
+to add the C<e> parameter.
 
 =for apidoc Am|U8|toFOLD|U8 ch
 Converts the specified character to foldcase.  If the input is anything but an
@@ -910,7 +917,14 @@ implementation, and subject to change in future releases.
 =for apidoc Am|UV|toFOLD_utf8|U8* p|U8* s|STRLEN* lenp
 This is like C<L</toFOLD_utf8_safe>>, but doesn't have the C<e>
 parameter  The function therefore can't check if it is reading
-beyond the end of the string.
+beyond the end of the string.  Starting in Perl v5.30, it will take the C<e>
+parameter, becoming a synonym for C<toFOLD_utf8_safe>.  At that time every
+program that uses it will have to be changed to successfully compile.  In the
+meantime, the first runtime call to C<toFOLD_utf8> from each call point in the
+program will raise a deprecation warning, enabled by default.  You can convert
+your program now to use C<toFOLD_utf8_safe>, and avoid the warnings, and get an
+extra measure of protection, or you can wait until v5.30, when you'll be forced
+to add the C<e> parameter.
 
 =for apidoc Am|U8|toLOWER|U8 ch
 Converts the specified character to lowercase.  If the input is anything but an
@@ -958,7 +972,14 @@ implementation, and subject to change in future releases.
 =for apidoc Am|UV|toLOWER_utf8|U8* p|U8* s|STRLEN* lenp
 This is like C<L</toLOWER_utf8_safe>>, but doesn't have the C<e>
 parameter  The function therefore can't check if it is reading
-beyond the end of the string.
+beyond the end of the string.  Starting in Perl v5.30, it will take the C<e>
+parameter, becoming a synonym for C<toLOWER_utf8_safe>.  At that time every
+program that uses it will have to be changed to successfully compile.  In the
+meantime, the first runtime call to C<toLOWER_utf8> from each call point in the
+program will raise a deprecation warning, enabled by default.  You can convert
+your program now to use C<toLOWER_utf8_safe>, and avoid the warnings, and get an
+extra measure of protection, or you can wait until v5.30, when you'll be forced
+to add the C<e> parameter.
 
 =for apidoc Am|U8|toTITLE|U8 ch
 Converts the specified character to titlecase.  If the input is anything but an
@@ -999,7 +1020,14 @@ implementation, and subject to change in future releases.
 =for apidoc Am|UV|toTITLE_utf8|U8* p|U8* s|STRLEN* lenp
 This is like C<L</toLOWER_utf8_safe>>, but doesn't have the C<e>
 parameter  The function therefore can't check if it is reading
-beyond the end of the string.
+beyond the end of the string.  Starting in Perl v5.30, it will take the C<e>
+parameter, becoming a synonym for C<toTITLE_utf8_safe>.  At that time every
+program that uses it will have to be changed to successfully compile.  In the
+meantime, the first runtime call to C<toTITLE_utf8> from each call point in the
+program will raise a deprecation warning, enabled by default.  You can convert
+your program now to use C<toTITLE_utf8_safe>, and avoid the warnings, and get an
+extra measure of protection, or you can wait until v5.30, when you'll be forced
+to add the C<e> parameter.
 
 =cut
 
@@ -1926,10 +1954,10 @@ _generic_utf8_safe(classnum, p, e, _is_utf8_FOO_with_len(classnum, p, e))
 #define toUPPER_utf8(p,s,l)    to_utf8_upper(p,s,l)
 
 /* For internal core use only, subject to change */
-#define _toFOLD_utf8_flags(p,e,s,l,f)  _to_utf8_fold_flags (p,e,s,l,f)
-#define _toLOWER_utf8_flags(p,e,s,l,f) _to_utf8_lower_flags(p,e,s,l,f)
-#define _toTITLE_utf8_flags(p,e,s,l,f) _to_utf8_title_flags(p,e,s,l,f)
-#define _toUPPER_utf8_flags(p,e,s,l,f) _to_utf8_upper_flags(p,e,s,l,f)
+#define _toFOLD_utf8_flags(p,e,s,l,f)  _to_utf8_fold_flags (p,e,s,l,f, "", 0)
+#define _toLOWER_utf8_flags(p,e,s,l,f) _to_utf8_lower_flags(p,e,s,l,f, "", 0)
+#define _toTITLE_utf8_flags(p,e,s,l,f) _to_utf8_title_flags(p,e,s,l,f, "", 0)
+#define _toUPPER_utf8_flags(p,e,s,l,f) _to_utf8_upper_flags(p,e,s,l,f, "", 0)
 
 #define toFOLD_utf8_safe(p,e,s,l)   _toFOLD_utf8_flags(p,e,s,l, FOLD_FLAGS_FULL)
 #define toLOWER_utf8_safe(p,e,s,l)  _toLOWER_utf8_flags(p,e,s,l, 0)
index fce4786..f34e3e0 100644 (file)
@@ -332,8 +332,8 @@ been added, each with the
 suffix C<_safe>, like C<isSPACE_utf8_safe>.  These take an extra
 parameter, giving an upper limit of how far into the string it is safe
 to read.  Using the old versions could cause attempts to read beyond the
-end of the input buffer if the UTF-8 is not well-formed, and the use
-of the C<isI<FOO>_utf8> ones now raises a deprecation warning.  Details are at
+end of the input buffer if the UTF-8 is not well-formed, and ther use
+now raises a deprecation warning.  Details are at
 L<perlapi/Character classification>.
 
 =item *
diff --git a/proto.h b/proto.h
index eb8a7e7..3c3a6ce 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -102,18 +102,18 @@ PERL_CALLCONV bool        Perl__is_utf8_xidstart(pTHX_ const U8 *p)
 PERL_CALLCONV UV       Perl__to_uni_fold_flags(pTHX_ UV c, U8 *p, STRLEN *lenp, U8 flags);
 #define PERL_ARGS_ASSERT__TO_UNI_FOLD_FLAGS    \
        assert(p); assert(lenp)
-PERL_CALLCONV UV       Perl__to_utf8_fold_flags(pTHX_ const U8 *p, const U8 *e, U8* ustrp, STRLEN *lenp, U8 flags);
+PERL_CALLCONV UV       Perl__to_utf8_fold_flags(pTHX_ const U8 *p, const U8 *e, U8* ustrp, STRLEN *lenp, U8 flags, const char * const file, const int line);
 #define PERL_ARGS_ASSERT__TO_UTF8_FOLD_FLAGS   \
-       assert(p); assert(ustrp)
-PERL_CALLCONV UV       Perl__to_utf8_lower_flags(pTHX_ const U8 *p, const U8* e, U8* ustrp, STRLEN *lenp, bool flags);
+       assert(p); assert(ustrp); assert(file)
+PERL_CALLCONV UV       Perl__to_utf8_lower_flags(pTHX_ const U8 *p, const U8* e, U8* ustrp, STRLEN *lenp, bool flags, const char * const file, const int line);
 #define PERL_ARGS_ASSERT__TO_UTF8_LOWER_FLAGS  \
-       assert(p); assert(ustrp)
-PERL_CALLCONV UV       Perl__to_utf8_title_flags(pTHX_ const U8 *p, const U8* e, U8* ustrp, STRLEN *lenp, bool flags);
+       assert(p); assert(ustrp); assert(file)
+PERL_CALLCONV UV       Perl__to_utf8_title_flags(pTHX_ const U8 *p, const U8* e, U8* ustrp, STRLEN *lenp, bool flags, const char * const file, const int line);
 #define PERL_ARGS_ASSERT__TO_UTF8_TITLE_FLAGS  \
-       assert(p); assert(ustrp)
-PERL_CALLCONV UV       Perl__to_utf8_upper_flags(pTHX_ const U8 *p, const U8 *e, U8* ustrp, STRLEN *lenp, bool flags);
+       assert(p); assert(ustrp); assert(file)
+PERL_CALLCONV UV       Perl__to_utf8_upper_flags(pTHX_ const U8 *p, const U8 *e, U8* ustrp, STRLEN *lenp, bool flags, const char * const file, const int line);
 #define PERL_ARGS_ASSERT__TO_UTF8_UPPER_FLAGS  \
-       assert(p); assert(ustrp)
+       assert(p); assert(ustrp); assert(file)
 PERL_CALLCONV void     Perl__warn_problematic_locale(void);
 PERL_CALLCONV LOGOP*   Perl_alloc_LOGOP(pTHX_ I32 type, OP *first, OP *other);
 PERL_CALLCONV PADOFFSET        Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags);
@@ -3464,25 +3464,33 @@ PERL_CALLCONV UV        Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, S
        assert(p); assert(ustrp); assert(swashp); assert(normal)
 
 #ifndef NO_MATHOMS
-PERL_CALLCONV UV       Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
+PERL_CALLCONV UV       Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
+                       __attribute__deprecated__;
 #define PERL_ARGS_ASSERT_TO_UTF8_FOLD  \
        assert(p); assert(ustrp)
 #endif
+
 #ifndef NO_MATHOMS
-PERL_CALLCONV UV       Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
+PERL_CALLCONV UV       Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
+                       __attribute__deprecated__;
 #define PERL_ARGS_ASSERT_TO_UTF8_LOWER \
        assert(p); assert(ustrp)
 #endif
+
 #ifndef NO_MATHOMS
-PERL_CALLCONV UV       Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
+PERL_CALLCONV UV       Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
+                       __attribute__deprecated__;
 #define PERL_ARGS_ASSERT_TO_UTF8_TITLE \
        assert(p); assert(ustrp)
 #endif
+
 #ifndef NO_MATHOMS
-PERL_CALLCONV UV       Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
+PERL_CALLCONV UV       Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
+                       __attribute__deprecated__;
 #define PERL_ARGS_ASSERT_TO_UTF8_UPPER \
        assert(p); assert(ustrp)
 #endif
+
 PERL_CALLCONV bool     Perl_try_amagic_bin(pTHX_ int method, int flags);
 PERL_CALLCONV bool     Perl_try_amagic_un(pTHX_ int method, int flags);
 PERL_CALLCONV I32      Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s, const char *strbeg, const char *strend, char **new_s, I32 ocnt, U32 flags);
@@ -5611,6 +5619,9 @@ STATIC char *     S__byte_dump_string(pTHX_ const U8 * s, const STRLEN len);
 STATIC UV      S__to_utf8_case(pTHX_ const UV uv1, const U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp, const char *normal, const char *special);
 #define PERL_ARGS_ASSERT__TO_UTF8_CASE \
        assert(p); assert(ustrp); assert(swashp); assert(normal)
+STATIC U32     S_check_and_deprecate(pTHX_ const U8 * p, const U8 ** e, const unsigned type, const bool use_locale, const char * const file, const unsigned line);
+#define PERL_ARGS_ASSERT_CHECK_AND_DEPRECATE   \
+       assert(p); assert(e); assert(file)
 STATIC UV      S_check_locale_boundary_crossing(pTHX_ const U8* const p, const UV result, U8* const ustrp, STRLEN *lenp)
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_CHECK_LOCALE_BOUNDARY_CROSSING        \
diff --git a/utf8.c b/utf8.c
index fc7415a..dc4c5b8 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -2541,11 +2541,20 @@ S_warn_on_first_deprecated_use(pTHX_ const char * const name,
                Perl_croak(aTHX_ "panic: hv_store() unexpectedly failed");
             }
 
+            if (strEQ(file, "mathoms.c")) {
+                Perl_warner(aTHX_ WARN_DEPRECATED,
+                            "In %s, line %d, starting in Perl v5.30, %s()"
+                            " will be removed.  Avoid this message by"
+                            " converting to use %s().\n",
+                            file, line, name, alternative);
+            }
+            else {
                 Perl_warner(aTHX_ WARN_DEPRECATED,
                             "In %s, line %d, starting in Perl v5.30, %s() will"
                             " require an additional parameter.  Avoid this"
                             " message by converting to use %s().\n",
                             file, line, name, alternative);
+            }
         }
     }
 }
@@ -2989,6 +2998,84 @@ S_check_locale_boundary_crossing(pTHX_ const U8* const p, const UV result, U8* c
     return original;
 }
 
+STATIC U32
+S_check_and_deprecate(pTHX_ const U8 *p,
+                            const U8 **e,
+                            const unsigned int type,    /* See below */
+                            const bool use_locale,      /* Is this a 'LC_'
+                                                           macro call? */
+                            const char * const file,
+                            const unsigned line)
+{
+    /* This is a temporary function to deprecate the unsafe calls to the case
+     * changing macros and functions.  It keeps all the special stuff in just
+     * one place.
+     *
+     * It updates *e with the pointer to the end of the input string.  If using
+     * the old-style macros, *e is NULL on input, and so this function assumes
+     * the input string is long enough to hold the entire UTF-8 sequence, and
+     * sets *e accordingly, but it then returns a flag to pass the
+     * utf8n_to_uvchr(), to tell it that this size is a guess, and to avoid
+     * using the full length if possible.
+     *
+     * It also does the assert that *e > p when *e is not NULL.  This should be
+     * migrated to the callers when this function gets deleted.
+     *
+     * The 'type' parameter is used for the caller to specify which case
+     * changing function this is called from: */
+
+#       define DEPRECATE_TO_UPPER 0
+#       define DEPRECATE_TO_TITLE 1
+#       define DEPRECATE_TO_LOWER 2
+#       define DEPRECATE_TO_FOLD  3
+
+    U32 utf8n_flags = 0;
+    const char * name;
+    const char * alternative;
+
+    PERL_ARGS_ASSERT_CHECK_AND_DEPRECATE;
+
+    if (*e == NULL) {
+        utf8n_flags = _UTF8_NO_CONFIDENCE_IN_CURLEN;
+        *e = p + UTF8SKIP(p);
+
+        /* For mathoms.c calls, we use the function name we know is stored
+         * there */
+        if (type == DEPRECATE_TO_UPPER) {
+            name = strEQ(file, "mathoms.c")
+                   ? "to_utf8_upper"
+                   : "toUPPER_utf8";
+            alternative = "toUPPER_utf8_safe";
+        }
+        else if (type == DEPRECATE_TO_TITLE) {
+            name = strEQ(file, "mathoms.c")
+                   ? "to_utf8_title"
+                   : "toTITLE_utf8";
+            alternative = "toTITLE_utf8_safe";
+        }
+        else if (type == DEPRECATE_TO_LOWER) {
+            name = strEQ(file, "mathoms.c")
+                   ? "to_utf8_lower"
+                   : "toLOWER_utf8";
+            alternative = "toLOWER_utf8_safe";
+        }
+        else if (type == DEPRECATE_TO_FOLD) {
+            name = strEQ(file, "mathoms.c")
+                   ? "to_utf8_fold"
+                   : "toFOLD_utf8";
+            alternative = "toFOLD_utf8_safe";
+        }
+        else Perl_croak(aTHX_ "panic: Unexpected case change type");
+
+        warn_on_first_deprecated_use(name, alternative, use_locale, file, line);
+    }
+    else {
+        assert (p < *e);
+    }
+
+    return utf8n_flags;
+}
+
 /* The process for changing the case is essentially the same for the four case
  * change types, except there are complications for folding.  Otherwise the
  * difference is only which case to change to.  To make sure that they all do
@@ -3019,7 +3106,6 @@ S_check_locale_boundary_crossing(pTHX_ const U8* const p, const UV result, U8* c
  * going on. */
 #define CASE_CHANGE_BODY_START(locale_flags, LC_L1_change_macro, L1_func,    \
                                L1_func_extra_param)                          \
-    if (e == NULL) e = p + UTF8SKIP(p);                                      \
                                                                              \
     if (flags & (locale_flags)) {                                            \
         /* Treat a UTF-8 locale as not being in locale at all */             \
@@ -3053,9 +3139,8 @@ S_check_locale_boundary_crossing(pTHX_ const U8* const p, const UV result, U8* c
         STRLEN len_result;                                                   \
         result = utf8n_to_uvchr(p, e - p, &len_result, UTF8_CHECK_ONLY);     \
         if (len_result == (STRLEN) -1) {                                     \
-            _force_out_malformed_utf8_message(p, e,                          \
-                                              _UTF8_NO_CONFIDENCE_IN_CURLEN, \
-                                              1 /* Die */ );                 \
+            _force_out_malformed_utf8_message(p, e, utf8n_flags,             \
+                                                            1 /* Die */ );   \
         }
 
 #define CASE_CHANGE_BODY_END(locale_flags, change_macro)                     \
@@ -3092,9 +3177,17 @@ Instead use L</toUPPER_utf8_safe>.
  *         be used. */
 
 UV
-Perl__to_utf8_upper_flags(pTHX_ const U8 *p, const U8 *e, U8* ustrp, STRLEN *lenp, bool flags)
+Perl__to_utf8_upper_flags(pTHX_ const U8 *p,
+                                const U8 *e,
+                                U8* ustrp,
+                                STRLEN *lenp,
+                                bool flags,
+                                const char * const file,
+                                const int line)
 {
     UV result;
+    const U32 utf8n_flags = check_and_deprecate(p, &e, DEPRECATE_TO_UPPER,
+                                                cBOOL(flags), file, line);
 
     PERL_ARGS_ASSERT__TO_UTF8_UPPER_FLAGS;
 
@@ -3118,9 +3211,17 @@ Instead use L</toTITLE_utf8_safe>.
  */
 
 UV
-Perl__to_utf8_title_flags(pTHX_ const U8 *p, const U8 *e, U8* ustrp, STRLEN *lenp, bool flags)
+Perl__to_utf8_title_flags(pTHX_ const U8 *p,
+                                const U8 *e,
+                                U8* ustrp,
+                                STRLEN *lenp,
+                                bool flags,
+                                const char * const file,
+                                const int line)
 {
     UV result;
+    const U32 utf8n_flags = check_and_deprecate(p, &e, DEPRECATE_TO_TITLE,
+                                                cBOOL(flags), file, line);
 
     PERL_ARGS_ASSERT__TO_UTF8_TITLE_FLAGS;
 
@@ -3142,9 +3243,17 @@ Instead use L</toLOWER_utf8_safe>.
  */
 
 UV
-Perl__to_utf8_lower_flags(pTHX_ const U8 *p, const U8 *e, U8* ustrp, STRLEN *lenp, bool flags)
+Perl__to_utf8_lower_flags(pTHX_ const U8 *p,
+                                const U8 *e,
+                                U8* ustrp,
+                                STRLEN *lenp,
+                                bool flags,
+                                const char * const file,
+                                const int line)
 {
     UV result;
+    const U32 utf8n_flags = check_and_deprecate(p, &e, DEPRECATE_TO_LOWER,
+                                                cBOOL(flags), file, line);
 
     PERL_ARGS_ASSERT__TO_UTF8_LOWER_FLAGS;
 
@@ -3170,9 +3279,17 @@ Instead use L</toFOLD_utf8_safe>.
  */
 
 UV
-Perl__to_utf8_fold_flags(pTHX_ const U8 *p, const U8 *e, U8* ustrp, STRLEN *lenp, U8 flags)
+Perl__to_utf8_fold_flags(pTHX_ const U8 *p,
+                               const U8 *e,
+                               U8* ustrp,
+                               STRLEN *lenp,
+                               U8 flags,
+                               const char * const file,
+                               const int line)
 {
     UV result;
+    const U32 utf8n_flags = check_and_deprecate(p, &e, DEPRECATE_TO_FOLD,
+                                                cBOOL(flags), file, line);
 
     PERL_ARGS_ASSERT__TO_UTF8_FOLD_FLAGS;
 
diff --git a/utf8.h b/utf8.h
index 4134ed8..0fbe4b7 100644 (file)
--- a/utf8.h
+++ b/utf8.h
@@ -78,13 +78,13 @@ the string is invariant.
 #define to_uni_fold(c, p, lenp) _to_uni_fold_flags(c, p, lenp, FOLD_FLAGS_FULL)
 
 #define to_utf8_fold(s, r, lenr)                                                \
-    _to_utf8_fold_flags (s, NULL, r, lenr, FOLD_FLAGS_FULL)
+    _to_utf8_fold_flags (s, NULL, r, lenr, FOLD_FLAGS_FULL, __FILE__, __LINE__)
 #define to_utf8_lower(s, r, lenr)                                               \
-                  _to_utf8_lower_flags(s, NULL, r ,lenr, 0)
+                  _to_utf8_lower_flags(s, NULL, r ,lenr, 0, __FILE__, __LINE__)
 #define to_utf8_upper(s, r, lenr)                                               \
-                  _to_utf8_upper_flags(s, NULL, r, lenr, 0)
+                  _to_utf8_upper_flags(s, NULL, r, lenr, 0, __FILE__, __LINE__)
 #define to_utf8_title(s, r, lenr)                                               \
-                  _to_utf8_title_flags(s, NULL, r, lenr ,0)
+                  _to_utf8_title_flags(s, NULL, r, lenr ,0, __FILE__, __LINE__)
 
 #define foldEQ_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2) \
                    foldEQ_utf8_flags(s1, pe1, l1, u1, s2, pe2, l2, u2, 0)