| 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 + 256;
|
|---|
| 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 |
|
|---|
| 57 | {
|
|---|
| 58 | foreach my $ord (0 .. 255) {
|
|---|
| 59 | my $bad = 0;
|
|---|
| 60 | local $SIG{__WARN__} = sub {
|
|---|
| 61 | unless ($_[0] =~ /^Invalid conversion in sprintf/ ||
|
|---|
| 62 | $_[0] =~ /^Use of uninitialized value in sprintf/) {
|
|---|
| 63 | warn $_[0];
|
|---|
| 64 | $bad++;
|
|---|
| 65 | }
|
|---|
| 66 | };
|
|---|
| 67 | my $r = eval {sprintf '%v' . chr $ord};
|
|---|
| 68 | is ($bad, 0, "pattern '%v' . chr $ord");
|
|---|
| 69 | }
|
|---|
| 70 | }
|
|---|