t/op/sprintf2.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7 }
   8
   9 plan tests => 280;
  10
  11 is(
  12     sprintf("%.40g ",0.01),
  13     sprintf("%.40g", 0.01)." ",
  14     q(the sprintf "%.<number>g" optimization)
  15 );
  16 is(
  17     sprintf("%.40f ",0.01),
  18     sprintf("%.40f", 0.01)." ",
  19     q(the sprintf "%.<number>f" optimization)
  20 );
  21
  22 # cases of $i > 1 are against [perl #39126]
  23 for my $i (1, 5, 10, 20, 50, 100) {
  24     chop(my $utf8_format = "%-*s\x{100}");
  25     my $string = "\xB4"x$i;        # latin1 ACUTE or ebcdic COPYRIGHT
  26     my $expect = $string."  "x$i;  # followed by 2*$i spaces
  27     is(sprintf($utf8_format, 3*$i, $string), $expect,
  28        "width calculation under utf8 upgrade, length=$i");
  29 }
  30
  31 # Used to mangle PL_sv_undef
  32 fresh_perl_is(
  33     'print sprintf "xxx%n\n"; print undef',
  34     'Modification of a read-only value attempted at - line 1.',
  35     { switches => [ '-w' ] },
  36     q(%n should not be able to modify read-only constants),
  37 );
  38
  39 # check overflows
  40 for (int(~0/2+1), ~0, "9999999999999999999") {
  41     is(eval {sprintf "%${_}d", 0}, undef, "no sprintf result expected %${_}d");
  42     like($@, qr/^Integer overflow in format string for sprintf /, "overflow in sprintf");
  43     is(eval {printf "%${_}d\n", 0}, undef, "no printf result expected %${_}d");
  44     like($@, qr/^Integer overflow in format string for prtf /, "overflow in printf");
  45 }
  46
  47 # check %NNN$ for range bounds
  48 {
  49     my ($warn, $bad) = (0,0);
  50     local $SIG{__WARN__} = sub {
  51         if ($_[0] =~ /uninitialized/) {
  52             $warn++
  53         }
  54         else {
  55             $bad++
  56         }
  57     };
  58
  59     my $fmt = join('', map("%$_\$s%" . ((1 << 31)-$_) . '$s', 1..20));
  60     my $result = sprintf $fmt, qw(a b c d);
  61     is($result, "abcd", "only four valid values in $fmt");
  62     is($warn, 36, "expected warnings");
  63     is($bad,   0, "unexpected warnings");
  64 }
  65
  66 {
  67     foreach my $ord (0 .. 255) {
  68         my $bad = 0;
  69         local $SIG{__WARN__} = sub {
  70             if ($_[0] !~ /^Invalid conversion in sprintf/) {
  71                 warn $_[0];
  72                 $bad++;
  73             }
  74         };
  75         my $r = eval {sprintf '%v' . chr $ord};
  76         is ($bad, 0, "pattern '%v' . chr $ord");
  77     }
  78 }