Make format items @* and ^* work with references (safely). Note no-one

said anything about sanely.

p4raw-id: //depot/perl@34140

diff --git a/pp_ctl.c b/pp_ctl.c
index dc6c215..fc75c72 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -773,7 +773,7 @@ PP(pp_formline)
                if (itemsize) {
                    STRLEN to_copy = itemsize;
                    const char *const send = s + len;
-                   const U8 *source;
+                   const U8 *source = (const U8 *) s;
                    U8 *tmp = NULL;
 
                    gotsome = TRUE;
@@ -794,7 +794,7 @@ PP(pp_formline)
                        }
                    }
                    if (targ_is_utf8 && !item_is_utf8) {
-                       source = tmp = bytes_to_utf8((U8*)SvPVX(sv), &to_copy);
+                       source = tmp = bytes_to_utf8(source, &to_copy);
                        SvCUR_set(PL_formtarget,
                                  t - SvPVX_const(PL_formtarget));
                    } else {
@@ -810,7 +810,6 @@ PP(pp_formline)
                            SvCUR_set(PL_formtarget,
                                      t - SvPVX_const(PL_formtarget));
                        }
-                       source = (U8 *) SvPVX(sv);
 
                        /* Easy. They agree.  */
                        assert (item_is_utf8 == targ_is_utf8);

diff --git a/t/op/write.t b/t/op/write.t
index 96e99e4..429936c 100755 (executable)
--- a/t/op/write.t
+++ b/t/op/write.t
@@ -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;
+my $bug_tests = 4 + 3 * 3 * 5 * 2 * 3 + 2;
 
 # number of tests in section 4
 my $hmb_tests = 35;
@@ -569,6 +569,15 @@ for my $tref ( @NumTests ){
   }
 }
 
+{
+  # This will fail an assertion in 5.10.0 built with -DDEBUGGING (because
+  # pp_formline attempts to set SvCUR() on an SVt_RV). I suspect that it will
+  # be doing something similarly out of bounds on everything from 5.000
+  my $ref = [];
+  is swrite('>^*<', $ref), ">$ref<";
+  is swrite('>@*<', $ref), ">$ref<";
+}
+
 format EMPTY =
 .