1#!./perl -w
2
3BEGIN {
4    chdir 't' if -d 't';
5    @INC = '../lib';
6    require './test.pl';
7}   
8
9plan tests => 7 + 256;
10
11is(
12    sprintf("%.40g ",0.01),
13    sprintf("%.40g", 0.01)." ",
14    q(the sprintf "%.<number>g" optimization)
15);
16is(
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
31fresh_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}
71