This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Allow formats with lines >64K
authorDavid Mitchell <davem@iabyn.com>
Sun, 29 May 2011 18:54:58 +0000 (19:54 +0100)
committerDavid Mitchell <davem@iabyn.com>
Sun, 29 May 2011 19:21:54 +0000 (20:21 +0100)
Back in 2003, the format bytecode was changed to allow 32-bit offsets,
but all the stored offsets were still being cast to U16. So for example
only the first char of a 65537 char literal would be output.

This commit removes all the U16 casts.

pp_ctl.c
t/op/write.t

index e664bd6..39c3bd9 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4986,14 +4986,14 @@ S_doparseform(pTHX_ SV *sv)
                if (postspace)
                    *fpc++ = FF_SPACE;
                *fpc++ = FF_LITERAL;
-               *fpc++ = (U16)arg;
+               *fpc++ = (U32)arg;
            }
            postspace = FALSE;
            if (s <= send)
                skipspaces--;
            if (skipspaces) {
                *fpc++ = FF_SKIP;
-               *fpc++ = (U16)skipspaces;
+               *fpc++ = (U32)skipspaces;
            }
            skipspaces = 0;
            if (s <= send)
@@ -5004,7 +5004,7 @@ S_doparseform(pTHX_ SV *sv)
                    arg = fpc - linepc + 1;
                else
                    arg = 0;
-               *fpc++ = (U16)arg;
+               *fpc++ = (U32)arg;
            }
            if (s < send) {
                linepc = fpc;
@@ -5027,7 +5027,7 @@ S_doparseform(pTHX_ SV *sv)
            arg = (s - base) - 1;
            if (arg) {
                *fpc++ = FF_LITERAL;
-               *fpc++ = (U16)arg;
+               *fpc++ = (U32)arg;
            }
 
            base = s - 1;
@@ -5054,7 +5054,7 @@ S_doparseform(pTHX_ SV *sv)
                }
                *fpc++ = s - base;              /* fieldsize for FETCH */
                *fpc++ = FF_DECIMAL;
-                *fpc++ = (U16)arg;
+                *fpc++ = (U32)arg;
                 unchopnum |= ! ischop;
             }
             else if (*s == '0' && s[1] == '#') {  /* Zero padded decimals */
@@ -5071,7 +5071,7 @@ S_doparseform(pTHX_ SV *sv)
                 }
                 *fpc++ = s - base;                /* fieldsize for FETCH */
                 *fpc++ = FF_0DECIMAL;
-               *fpc++ = (U16)arg;
+               *fpc++ = (U32)arg;
                 unchopnum |= ! ischop;
            }
            else {                              /* text field */
@@ -5101,7 +5101,7 @@ S_doparseform(pTHX_ SV *sv)
                *fpc++ = ischop ? FF_CHECKCHOP : FF_CHECKNL;
 
                if (prespace)
-                   *fpc++ = (U16)prespace; /* add SPACE or HALFSPACE */
+                   *fpc++ = (U32)prespace; /* add SPACE or HALFSPACE */
                *fpc++ = FF_ITEM;
                if (ismore)
                    *fpc++ = FF_MORE;
index c2e3399..d30c9d7 100644 (file)
@@ -61,7 +61,7 @@ for my $tref ( @NumTests ){
 my $bas_tests = 20;
 
 # number of tests in section 3
-my $bug_tests = 4 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 3 + 2 + 1 + 1;
+my $bug_tests = 4 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 1 + 1;
 
 # number of tests in section 4
 my $hmb_tests = 35;
@@ -712,6 +712,14 @@ ok  defined *{$::{CmT}}{FORMAT}, "glob assign";
     $orig = "x" x 100 . "\n";
     formline $format, $orig, 12345;
     is $^A, ("x" x 100) . " 12345\n", "\@* doesn't overflow";
+
+    # make sure it can cope with formats > 64k
+
+    $format = 'x' x 65537;
+    $^A = '';
+    formline $format;
+    # don't use 'is' here, as the diag output will be too long!
+    ok $^A eq $format, ">64K";
 }