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 => 7;
  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         chop(my $utf8_format = "%-3s\x{100}");
  23         is(
  24                 sprintf($utf8_format, "\xe4"),
  25                 "\xe4  ",
  26                 q(width calculation under utf8 upgrade)
  27         );
  28 }
  29
  30 # Used to mangle PL_sv_undef
  31 fresh_perl_is(
  32     'print sprintf "xxx%n\n"; print undef',
  33     'Modification of a read-only value attempted at - line 1.',
  34     { switches => [ '-w' ] },
  35     q(%n should not be able to modify read-only constants),
  36 );
  37
  38 # check %NNN$ for range bounds, especially negative 2's complement
  39
  40 {
  41     my ($warn, $bad) = (0,0);
  42     local $SIG{__WARN__} = sub {
  43         if ($_[0] =~ /uninitialized/) {
  44             $warn++
  45         }
  46         else {
  47             $bad++
  48         }
  49     };
  50     my $result = sprintf join('', map("%$_\$s%" . ~$_ . '$s', 1..20)),
  51         qw(a b c d);
  52     is($result, "abcd", "only four valid values");
  53     is($warn, 36, "expected warnings");
  54     is($bad,   0, "unexpected warnings");
  55 }
  56