to improve -DCHECK_FORMAT

Message-ID: <533D273D4014D411AB1D00062938C4D90849C55A@hotel.npl.co.uk>

p4raw-id: //depot/perl@23767

diff --git a/mg.c b/mg.c
index 8315721..255e208 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -2616,7 +2616,7 @@ Perl_sighandler(int sig)
        (void)rsignal(sig, PL_csighandlerp);
 #endif
 #endif /* !PERL_MICRO */
-       Perl_die(aTHX_ Nullformat);
+       DieNull;
     }
 cleanup:
     if (flags & 1)

diff --git a/perl.h b/perl.h
index 4bcf229..06e8a13 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -2392,9 +2392,9 @@ typedef pthread_key_t     perl_key;
 
 #ifndef SVf
 #  ifdef CHECK_FORMAT
-#    define SVf "p"
+#    define SVf "-p"
 #    ifndef SVf256
-#      define SVf256 SVf
+#      define SVf256 "-256p" 
 #    endif
 #  else
 #    define SVf "_"
@@ -2415,17 +2415,17 @@ typedef pthread_key_t   perl_key;
 
 #ifndef VDf
 #  ifdef CHECK_FORMAT
-#    define VDf "p"
+#    define VDf "-1p"
 #  else
 #    define VDf "vd"
 #  endif
 #endif
 
-#ifndef Nullformat
+#ifndef DieNull
 #  ifdef CHECK_FORMAT
-#    define Nullformat "%s",""
+#    define DieNull vdie(aTHX_ Nullch, Null(va_list *))
 #  else
-#    define Nullformat Nullch
+#    define DieNull Perl_die(aTHX_ Nullch)
 #  endif
 #endif
 

diff --git a/pp.h b/pp.h
index 82635df..fed78e6 100644 (file)
--- a/pp.h
+++ b/pp.h
@@ -88,6 +88,7 @@ Refetch the stack pointer.  Used after a callback.  See L<perlcall>.
 
 #define NORMAL PL_op->op_next
 #define DIE return Perl_die
+#define DIE_NULL return DieNull
 
 /*
 =for apidoc Ams||PUTBACK

diff --git a/pp_sys.c b/pp_sys.c
index e0d9ca0..e125fb9 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -504,7 +504,7 @@ PP(pp_die)
                    sv_setsv(error,*PL_stack_sp--);
                }
            }
-           DIE(aTHX_ Nullformat);
+           DIE_NULL;
        }
        else {
            if (SvPOK(error) && SvCUR(error))

diff --git a/sv.c b/sv.c
index a009dfc..d750f10 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -9392,6 +9392,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                fill = *q++;
            EXPECT_NUMBER(q, width);
 
+#ifdef CHECK_FORMAT
+       if ((*q == 'p') && left) {
+            vectorize = (width == 1);
+       }
+#endif
        if (vectorize) {
            if (vectorarg) {
                if (args)
@@ -9583,6 +9588,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            goto string;
 
        case '_':
+#ifdef CHECK_FORMAT
+       format_sv:
+#endif
            /*
             * The "%_" hack might have to be changed someday,
             * if ISO or ANSI decide to use '_' for something.
@@ -9604,6 +9612,19 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            /* INTEGERS */
 
        case 'p':
+#ifdef CHECK_FORMAT
+           if (left) {
+               left = FALSE;
+               if (width > 0) {
+                   width = 0;
+                   if (vectorize) 
+                       goto format_d;
+                   precis = width;
+                   has_precis = TRUE;
+               }
+               goto format_sv;
+           }
+#endif
            if (alt || vectorize)
                goto unknown;
            uv = PTR2UV(args ? va_arg(*args, void*) : argsv);
@@ -9616,6 +9637,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 #else
            intsize = 'l';
 #endif
+#ifdef CHECK_FORMAT
+       format_d:
+#endif
            /* FALL THROUGH */
        case 'd':
        case 'i':