Add a TODO test for block evals segfaulting on syntax errors.

[p5sagit/p5-mst-13.2.git] / t / op / sprintf2.t

diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index 3e608d8..e81b59e 100644 (file)
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }   
 
-plan tests => 1319;
+plan tests => 1368;
 
 use strict;
 use Config;
@@ -41,9 +41,9 @@ for my $i (1, 3, 5, 10) {
 }
 
 # Used to mangle PL_sv_undef
-fresh_perl_is(
+fresh_perl_like(
     'print sprintf "xxx%n\n"; print undef',
-    'Modification of a read-only value attempted at - line 1.',
+    'Modification of a read-only value attempted at - line 1\.',
     { switches => [ '-w' ] },
     q(%n should not be able to modify read-only constants),
 );
@@ -60,7 +60,7 @@ for (int(~0/2+1), ~0, "9999999999999999999") {
 {
     my ($warn, $bad) = (0,0);
     local $SIG{__WARN__} = sub {
-       if ($_[0] =~ /uninitialized/) {
+       if ($_[0] =~ /missing argument/i) {
            $warn++
        }
        else {
@@ -148,20 +148,35 @@ eval { my $q = pack "q", 0 };
 my $Q = $@ eq '';
 
 my @tests = (
-  [ '%lld' => '%d', [qw( 4294967296 -100000000000000 )] ],
-  [ '%lli' => '%i', [qw( 4294967296 -100000000000000 )] ],
-  [ '%llu' => '%u', [qw( 4294967296  100000000000000 )] ],
-  [ '%Ld'  => '%d', [qw( 4294967296 -100000000000000 )] ],
-  [ '%Li'  => '%i', [qw( 4294967296 -100000000000000 )] ],
-  [ '%Lu'  => '%u', [qw( 4294967296  100000000000000 )] ],
+  [ '%lld' => [qw( 4294967296 -100000000000000 )] ],
+  [ '%lli' => [qw( 4294967296 -100000000000000 )] ],
+  [ '%llu' => [qw( 4294967296  100000000000000 )] ],
+  [ '%Ld'  => [qw( 4294967296 -100000000000000 )] ],
+  [ '%Li'  => [qw( 4294967296 -100000000000000 )] ],
+  [ '%Lu'  => [qw( 4294967296  100000000000000 )] ],
 );
 
 for my $t (@tests) {
-  my($fmt, $conv) = @$t;
-  for my $num (@{$t->[2]}) {
+  my($fmt, $nums) = @$t;
+  for my $num (@$nums) {
     my $w; local $SIG{__WARN__} = sub { $w = shift };
     is(sprintf($fmt, $num), $Q ? $num : $fmt, "quad: $fmt -> $num");
-    like($w, $Q ? '' : qr/Invalid conversion in sprintf: "$conv"/, "warning: $fmt");
+    like($w, $Q ? '' : qr/Invalid conversion in sprintf: "$fmt"/, "warning: $fmt");
   }
 }
 
+# Check unicode vs byte length
+for my $width (1,2,3,4,5,6,7) {
+    for my $precis (1,2,3,4,5,6,7) {
+        my $v = "\x{20ac}\x{20ac}";
+        my $format = "%" . $width . "." . $precis . "s";
+        my $chars = ($precis > 2 ? 2 : $precis);
+        my $space = ($width < 2 ? 0 : $width - $chars);
+        fresh_perl_is(
+            'my $v = "\x{20ac}\x{20ac}"; my $x = sprintf "'.$format.'", $v; $x =~ /^(\s*)(\S*)$/; print "$_" for map {length} $1, $2',
+            "$space$chars",
+            {},
+            q(sprintf ").$format.q(", "\x{20ac}\x{20ac}"),
+        );
+    }
+}