New lightweight Carp has a require. If Carp is used in a __DIE__ handler

[p5sagit/p5-mst-13.2.git] / sv.c

diff --git a/sv.c b/sv.c
index ef46563..1b15240 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4925,14 +4925,22 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            goto integer;
 
        case 'D':
+#ifdef IV_IS_QUAD
+           /* nothing */
+#else
            intsize = 'l';
+#endif
            /* FALL THROUGH */
        case 'd':
        case 'i':
            if (args) {
                switch (intsize) {
                case 'h':       iv = (short)va_arg(*args, int); break;
+#ifdef IV_IS_QUAD
+               default:        iv = va_arg(*args, IV); break;
+#else
                default:        iv = va_arg(*args, int); break;
+#endif
                case 'l':       iv = va_arg(*args, long); break;
                case 'V':       iv = va_arg(*args, IV); break;
 #ifdef HAS_QUAD
@@ -4944,7 +4952,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                iv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
                switch (intsize) {
                case 'h':       iv = (short)iv; break;
+#ifdef IV_IS_QUAD
+               default:        break;
+#else
                default:        iv = (int)iv; break;
+#endif
                case 'l':       iv = (long)iv; break;
                case 'V':       break;
 #ifdef HAS_QUAD
@@ -4965,7 +4977,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            goto integer;
 
        case 'U':
+#ifdef IV_IS_QUAD
+           /* nothing */
+#else
            intsize = 'l';
+#endif
            /* FALL THROUGH */
        case 'u':
            base = 10;
@@ -4976,7 +4992,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            goto uns_integer;
 
        case 'O':
+#ifdef IV_IS_QUAD
+           /* nothing */
+#else
            intsize = 'l';
+#endif
            /* FALL THROUGH */
        case 'o':
            base = 8;
@@ -4990,7 +5010,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            if (args) {
                switch (intsize) {
                case 'h':  uv = (unsigned short)va_arg(*args, unsigned); break;
+#ifdef UV_IS_QUAD
+               default:   uv = va_arg(*args, UV); break;
+#else
                default:   uv = va_arg(*args, unsigned); break;
+#endif
                case 'l':  uv = va_arg(*args, unsigned long); break;
                case 'V':  uv = va_arg(*args, UV); break;
 #ifdef HAS_QUAD
@@ -5002,7 +5026,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                uv = (svix < svmax) ? SvUVx(svargs[svix++]) : 0;
                switch (intsize) {
                case 'h':       uv = (unsigned short)uv; break;
+#ifdef UV_IS_QUAD
+               default:        break;
+#else
                default:        uv = (unsigned)uv; break;
+#endif
                case 'l':       uv = (unsigned long)uv; break;
                case 'V':       break;
 #ifdef HAS_QUAD
@@ -5152,7 +5180,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            if (args) {
                switch (intsize) {
                case 'h':       *(va_arg(*args, short*)) = i; break;
+#ifdef IV_IS_QUAD
+               default:        *(va_arg(*args, IV*)) = i; break;
+#else
                default:        *(va_arg(*args, int*)) = i; break;
+#endif
                case 'l':       *(va_arg(*args, long*)) = i; break;
                case 'V':       *(va_arg(*args, IV*)) = i; break;
 #ifdef HAS_QUAD
@@ -5173,10 +5205,21 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                SV *msg = sv_newmortal();
                Perl_sv_setpvf(aTHX_ msg, "Invalid conversion in %s: ",
                          (PL_op->op_type == OP_PRTF) ? "printf" : "sprintf");
-               if (c)
-                   Perl_sv_catpvf(aTHX_ msg, isPRINT(c) ? "\"%%%c\"" : "\"%%\\%03o\"",
-                             c & 0xFF);
-               else
+               if (c) {
+#ifdef UV_IS_QUAD
+                   if (isPRINT(c))
+                       Perl_sv_catpvf(aTHX_ msg, 
+                                      "\"%%%c\"", c & 0xFF);
+                   else
+                       Perl_sv_catpvf(aTHX_ msg,
+                                      "\"%%\\%03" PERL_PRIo64 "\"",
+                                      (UV)c & 0xFF);
+#else
+                   Perl_sv_catpvf(aTHX_ msg, isPRINT(c) ?
+                                  "\"%%%c\"" : "\"%%\\%03o\"",
+                                  c & 0xFF);
+#endif
+               } else
                    sv_catpv(msg, "end of string");
                Perl_warner(aTHX_ WARN_PRINTF, "%_", msg); /* yes, this is reentrant */
            }