This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Devel::PPPort: Fix D_PPP_FIX_UTF8_ERRSV macro
[perl5.git] / dist / Devel-PPPort / parts / inc / mess
index d73b4e5..e9af174 100644 (file)
@@ -19,10 +19,8 @@ mess_nocontext
 mess
 
 warn_nocontext
-Perl_warn_nocontext
 
 croak_nocontext
-Perl_croak_nocontext
 
 croak_no_modify
 Perl_croak_no_modify
@@ -37,7 +35,6 @@ PERL_ARGS_ASSERT_CROAK_XS_USAGE
 NEED_mess
 NEED_mess_nocontext
 NEED_vmess
-_dppp_fix_utf8_errsv
 
 =implementation
 
@@ -53,14 +50,14 @@ _dppp_fix_utf8_errsv
 #ifndef croak_sv
 #if { VERSION >= 5.7.3 } || ( { VERSION >= 5.6.1 } && { VERSION < 5.7.0 } )
 #  if ( { VERSION >= 5.8.0 } && { VERSION < 5.8.9 } ) || ( { VERSION >= 5.9.0 } && { VERSION < 5.10.1 } )
-#    define _dppp_fix_utf8_errsv(errsv, sv)                     \
+#    define D_PPP_FIX_UTF8_ERRSV(errsv, sv)                     \
         STMT_START {                                            \
-            if (sv != ERRSV)                                    \
-                SvFLAGS(ERRSV) = (SvFLAGS(ERRSV) & ~SVf_UTF8) | \
+            if (sv != errsv)                                    \
+                SvFLAGS(errsv) = (SvFLAGS(errsv) & ~SVf_UTF8) | \
                                  (SvFLAGS(sv) & SVf_UTF8);      \
         } STMT_END
 #  else
-#    define _dppp_fix_utf8_errsv(errsv, sv) STMT_START {} STMT_END
+#    define D_PPP_FIX_UTF8_ERRSV(errsv, sv) STMT_START {} STMT_END
 #  endif
 #  define croak_sv(sv)                        \
     STMT_START {                              \
@@ -68,7 +65,7 @@ _dppp_fix_utf8_errsv
             sv_setsv(ERRSV, sv);              \
             croak(NULL);                      \
         } else {                              \
-            _dppp_fix_utf8_errsv(ERRSV, sv);  \
+            D_PPP_FIX_UTF8_ERRSV(ERRSV, sv);  \
             croak("%" SVf, SVfARG(sv));       \
         }                                     \
     } STMT_END
@@ -184,40 +181,34 @@ mess_sv(pTHX_ SV *basemsg, bool consume)
 #define warn_nocontext warn
 #endif
 
-#ifndef Perl_warn_nocontext
-#define Perl_warn_nocontext warn_nocontext
-#endif
-
 #ifndef croak_nocontext
 #define croak_nocontext croak
 #endif
 
-#ifndef Perl_croak_nocontext
-#define Perl_croak_nocontext croak_nocontext
-#endif
-
 #ifndef croak_no_modify
-#define croak_no_modify() croak("%s", PL_no_modify)
+#define croak_no_modify() croak_nocontext("%s", PL_no_modify)
 #define Perl_croak_no_modify() croak_no_modify()
 #endif
 
 #ifndef croak_memory_wrap
 #if { VERSION >= 5.9.2 } || ( { VERSION >= 5.8.6 } && { VERSION < 5.9.0 } )
-#  define croak_memory_wrap() croak("%s", PL_memory_wrap)
+#  define croak_memory_wrap() croak_nocontext("%s", PL_memory_wrap)
 #else
-#  define croak_memory_wrap() croak("panic: memory wrap")
+#  define croak_memory_wrap() croak_nocontext("panic: memory wrap")
 #endif
 #endif
 
+#ifndef croak_xs_usage
+#if { NEED croak_xs_usage }
+
 #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
 #define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
 #endif
 
-#ifndef croak_xs_usage
-#if { NEED croak_xs_usage }
 void
-croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
+croak_xs_usage(const CV *const cv, const char *const params)
 {
+    dTHX;
     const GV *const gv = CvGV(cv);
 
     PERL_ARGS_ASSERT_CROAK_XS_USAGE;
@@ -435,7 +426,7 @@ if ($] ge '5.006') {
 
 if (ord('A') != 65) {
     skip 'skip: no ASCII support', 0 for 1..24;
-} elsif ($] ge '5.008') {
+} elsif ($] ge '5.008' && $] ne '5.012000') {
     undef $die;
     ok !defined eval { Devel::PPPort::croak_sv(eval '"\N{U+E1}\n"') };
     ok $@, "\xE1\n";