| 1 | #!./perl
|
|---|
| 2 |
|
|---|
| 3 | # Tests sprintf, excluding handling of 64-bit integers or long
|
|---|
| 4 | # doubles (if supported), of machine-specific short and long
|
|---|
| 5 | # integers, machine-specific floating point exceptions (infinity,
|
|---|
| 6 | # not-a-number ...), of the effects of locale, and of features
|
|---|
| 7 | # specific to multi-byte characters (under the utf8 pragma and such).
|
|---|
| 8 |
|
|---|
| 9 | BEGIN {
|
|---|
| 10 | chdir 't' if -d 't';
|
|---|
| 11 | @INC = '../lib';
|
|---|
| 12 | }
|
|---|
| 13 | use warnings;
|
|---|
| 14 | use Config;
|
|---|
| 15 | use strict;
|
|---|
| 16 |
|
|---|
| 17 | my @tests = ();
|
|---|
| 18 | my ($i, $template, $data, $result, $comment, $w, $x, $evalData, $n, $p);
|
|---|
| 19 |
|
|---|
| 20 | my $Is_VMS_VAX = 0;
|
|---|
| 21 | # We use HW_MODEL since ARCH_NAME was not in VMS V5.*
|
|---|
| 22 | if ($^O eq 'VMS') {
|
|---|
| 23 | my $hw_model;
|
|---|
| 24 | chomp($hw_model = `write sys\$output f\$getsyi("HW_MODEL")`);
|
|---|
| 25 | $Is_VMS_VAX = $hw_model < 1024 ? 1 : 0;
|
|---|
| 26 | }
|
|---|
| 27 |
|
|---|
| 28 | # No %Config.
|
|---|
| 29 | my $Is_Ultrix_VAX = $^O eq 'ultrix' && `uname -m` =~ /^VAX$/;
|
|---|
| 30 |
|
|---|
| 31 | while (<DATA>) {
|
|---|
| 32 | s/^\s*>//; s/<\s*$//;
|
|---|
| 33 | ($template, $data, $result, $comment) = split(/<\s*>/, $_, 4);
|
|---|
| 34 | if ($^O eq 'os390' || $^O eq 's390') { # non-IEEE (s390 is UTS)
|
|---|
| 35 | $data =~ s/([eE])96$/${1}63/; # smaller exponents
|
|---|
| 36 | $result =~ s/([eE]\+)102$/${1}69/; # " "
|
|---|
| 37 | $data =~ s/([eE])\-101$/${1}-56/; # larger exponents
|
|---|
| 38 | $result =~ s/([eE])\-102$/${1}-57/; # " "
|
|---|
| 39 | }
|
|---|
| 40 | if ($Is_VMS_VAX || $Is_Ultrix_VAX) {
|
|---|
| 41 | # VAX DEC C 5.3 at least since there is no
|
|---|
| 42 | # ccflags =~ /float=ieee/ on VAX.
|
|---|
| 43 | # AXP is unaffected whether or not it's using ieee.
|
|---|
| 44 | $data =~ s/([eE])96$/${1}26/; # smaller exponents
|
|---|
| 45 | $result =~ s/([eE]\+)102$/${1}32/; # " "
|
|---|
| 46 | $data =~ s/([eE])\-101$/${1}-24/; # larger exponents
|
|---|
| 47 | $result =~ s/([eE])\-102$/${1}-25/; # " "
|
|---|
| 48 | }
|
|---|
| 49 |
|
|---|
| 50 | $evalData = eval $data;
|
|---|
| 51 | $data = ref $evalData ? $evalData : [$evalData];
|
|---|
| 52 | push @tests, [$template, $data, $result, $comment];
|
|---|
| 53 | }
|
|---|
| 54 |
|
|---|
| 55 | print '1..', scalar @tests, "\n";
|
|---|
| 56 |
|
|---|
| 57 | $SIG{__WARN__} = sub {
|
|---|
| 58 | if ($_[0] =~ /^Invalid conversion/) {
|
|---|
| 59 | $w = ' INVALID';
|
|---|
| 60 | } elsif ($_[0] =~ /^Use of uninitialized value/) {
|
|---|
| 61 | $w = ' UNINIT';
|
|---|
| 62 | } else {
|
|---|
| 63 | warn @_;
|
|---|
| 64 | }
|
|---|
| 65 | };
|
|---|
| 66 |
|
|---|
| 67 | for ($i = 1; @tests; $i++) {
|
|---|
| 68 | ($template, $data, $result, $comment) = @{shift @tests};
|
|---|
| 69 | $w = undef;
|
|---|
| 70 | $x = sprintf(">$template<", @$data);
|
|---|
| 71 | substr($x, -1, 0) = $w if $w;
|
|---|
| 72 | # $x may have 3 exponent digits, not 2
|
|---|
| 73 | my $y = $x;
|
|---|
| 74 | if ($y =~ s/([Ee][-+])0(\d)/$1$2/) {
|
|---|
| 75 | # if result is left-adjusted, append extra space
|
|---|
| 76 | if ($template =~ /%\+?\-/ and $result =~ / $/) {
|
|---|
| 77 | $y =~ s/<$/ </;
|
|---|
| 78 | }
|
|---|
| 79 | # if result is zero-filled, add extra zero
|
|---|
| 80 | elsif ($template =~ /%\+?0/ and $result =~ /^0/) {
|
|---|
| 81 | $y =~ s/^>0/>00/;
|
|---|
| 82 | }
|
|---|
| 83 | # if result is right-adjusted, prepend extra space
|
|---|
| 84 | elsif ($result =~ /^ /) {
|
|---|
| 85 | $y =~ s/^>/> /;
|
|---|
| 86 | }
|
|---|
| 87 | }
|
|---|
| 88 |
|
|---|
| 89 | my $skip = 0;
|
|---|
| 90 | if ($comment =~ s/\s+skip:\s*(.*)//) {
|
|---|
| 91 | my $os = $1;
|
|---|
| 92 | my $osv = exists $Config{osvers} ? $Config{osvers} : "0";
|
|---|
| 93 | # >comment skip: all<
|
|---|
| 94 | if ($os =~ /\ball\b/i) {
|
|---|
| 95 | $skip = 1;
|
|---|
| 96 | # >comment skip: VMS hpux:10.20<
|
|---|
| 97 | } elsif ($os =~ /\b$^O(?::(\S+))?\b/i) {
|
|---|
| 98 | my $vsn = defined $1 ? $1 : "0";
|
|---|
| 99 | # Only compare on the the first pair of digits, as numeric
|
|---|
| 100 | # compares don't like 2.6.10-3mdksmp or 2.6.8-24.10-default
|
|---|
| 101 | s/^(\d+(\.\d+)?).*/$1/ for $osv, $vsn;
|
|---|
| 102 | $skip = $vsn ? ($osv <= $vsn ? 1 : 0) : 1;
|
|---|
| 103 | }
|
|---|
| 104 | $skip and $comment =~ s/$/, failure expected on $^O $osv/;
|
|---|
| 105 | }
|
|---|
| 106 |
|
|---|
| 107 | if ($x eq ">$result<") {
|
|---|
| 108 | print "ok $i\n";
|
|---|
| 109 | }
|
|---|
| 110 | elsif ($skip) {
|
|---|
| 111 | print "ok $i # skip $comment\n";
|
|---|
| 112 | }
|
|---|
| 113 | elsif ($y eq ">$result<") # Some C libraries always give
|
|---|
| 114 | { # three-digit exponent
|
|---|
| 115 | print("ok $i # >$result< $x three-digit exponent accepted\n");
|
|---|
| 116 | }
|
|---|
| 117 | elsif ($result =~ /[-+]\d{3}$/ &&
|
|---|
| 118 | # Suppress tests with modulo of exponent >= 100 on platforms
|
|---|
| 119 | # which can't handle such magnitudes (or where we can't tell).
|
|---|
| 120 | ((!eval {require POSIX}) || # Costly: only do this if we must!
|
|---|
| 121 | (length(&POSIX::DBL_MAX) - rindex(&POSIX::DBL_MAX, '+')) == 3))
|
|---|
| 122 | {
|
|---|
| 123 | print("ok $i # >$template< >$data< >$result<",
|
|---|
| 124 | " Suppressed: exponent out of range?\n");
|
|---|
| 125 | }
|
|---|
| 126 | else {
|
|---|
| 127 | $y = ($x eq $y ? "" : " => $y");
|
|---|
| 128 | print("not ok $i >$template< >$data< >$result< $x$y",
|
|---|
| 129 | $comment ? " # $comment\n" : "\n");
|
|---|
| 130 | }
|
|---|
| 131 | }
|
|---|
| 132 |
|
|---|
| 133 | # In each of the following lines, there are three required fields:
|
|---|
| 134 | # printf template, data to be formatted (as a Perl expression), and
|
|---|
| 135 | # expected result of formatting. An optional fourth field can contain
|
|---|
| 136 | # a comment. Each field is delimited by a starting '>' and a
|
|---|
| 137 | # finishing '<'; any whitespace outside these start and end marks is
|
|---|
| 138 | # not part of the field. If formatting requires more than one data
|
|---|
| 139 | # item (for example, if variable field widths are used), the Perl data
|
|---|
| 140 | # expression should return a reference to an array having the requisite
|
|---|
| 141 | # number of elements. Even so, subterfuge is sometimes required: see
|
|---|
| 142 | # tests for %n and %p.
|
|---|
| 143 | #
|
|---|
| 144 | # Tests that are expected to fail on a certain OS can be marked as such
|
|---|
| 145 | # by trailing the comment with a skip: section. Skips are tags separated
|
|---|
| 146 | # bu space consisting of a $^O optionally trailed with :osvers. In the
|
|---|
| 147 | # latter case, all os-levels below that are expected to fail. A special
|
|---|
| 148 | # tag 'all' is allowed for todo tests that should fail on any system
|
|---|
| 149 | #
|
|---|
| 150 | # >%G< >1234567e96< >1.23457E+102< >exponent too big skip: os390<
|
|---|
| 151 | # >%.0g< >-0.0< >-0< >No minus skip: MSWin32 VMS hpux:10.20<
|
|---|
| 152 | # >%d< >4< >1< >4 != 1 skip: all<
|
|---|
| 153 | #
|
|---|
| 154 | # The following tests are not currently run, for the reasons stated:
|
|---|
| 155 |
|
|---|
| 156 | =pod
|
|---|
| 157 |
|
|---|
| 158 | =begin problematic
|
|---|
| 159 |
|
|---|
| 160 | >%.0f< >1.5< >2< >Standard vague: no rounding rules<
|
|---|
| 161 | >%.0f< >2.5< >2< >Standard vague: no rounding rules<
|
|---|
| 162 |
|
|---|
| 163 | =end problematic
|
|---|
| 164 |
|
|---|
| 165 | =cut
|
|---|
| 166 |
|
|---|
| 167 | # template data result
|
|---|
| 168 | __END__
|
|---|
| 169 | >%6. 6s< >''< >%6. 6s INVALID< >(See use of $w in code above)<
|
|---|
| 170 | >%6 .6s< >''< >%6 .6s INVALID<
|
|---|
| 171 | >%6.6 s< >''< >%6.6 s INVALID<
|
|---|
| 172 | >%A< >''< >%A INVALID<
|
|---|
| 173 | >%B< >''< >%B INVALID<
|
|---|
| 174 | >%C< >''< >%C INVALID<
|
|---|
| 175 | >%D< >0x7fffffff< >2147483647< >Synonym for %ld<
|
|---|
| 176 | >%E< >123456.789< >1.234568E+05< >Like %e, but using upper-case "E"<
|
|---|
| 177 | >%F< >123456.789< >123456.789000< >Synonym for %f<
|
|---|
| 178 | >%G< >1234567.89< >1.23457E+06< >Like %g, but using upper-case "E"<
|
|---|
| 179 | >%G< >1234567e96< >1.23457E+102<
|
|---|
| 180 | >%G< >.1234567e-101< >1.23457E-102<
|
|---|
| 181 | >%G< >12345.6789< >12345.7<
|
|---|
| 182 | >%G< >1234567e96< >1.23457E+102< >exponent too big skip: os390<
|
|---|
| 183 | >%G< >.1234567e-101< >1.23457E-102< >exponent too small skip: os390<
|
|---|
| 184 | >%H< >''< >%H INVALID<
|
|---|
| 185 | >%I< >''< >%I INVALID<
|
|---|
| 186 | >%J< >''< >%J INVALID<
|
|---|
| 187 | >%K< >''< >%K INVALID<
|
|---|
| 188 | >%L< >''< >%L INVALID<
|
|---|
| 189 | >%M< >''< >%M INVALID<
|
|---|
| 190 | >%N< >''< >%N INVALID<
|
|---|
| 191 | >%O< >2**32-1< >37777777777< >Synonym for %lo<
|
|---|
| 192 | >%P< >''< >%P INVALID<
|
|---|
| 193 | >%Q< >''< >%Q INVALID<
|
|---|
| 194 | >%R< >''< >%R INVALID<
|
|---|
| 195 | >%S< >''< >%S INVALID<
|
|---|
| 196 | >%T< >''< >%T INVALID<
|
|---|
| 197 | >%U< >2**32-1< >4294967295< >Synonym for %lu<
|
|---|
| 198 | >%V< >''< >%V INVALID<
|
|---|
| 199 | >%W< >''< >%W INVALID<
|
|---|
| 200 | >%X< >2**32-1< >FFFFFFFF< >Like %x, but with u/c letters<
|
|---|
| 201 | >%#X< >2**32-1< >0XFFFFFFFF<
|
|---|
| 202 | >%Y< >''< >%Y INVALID<
|
|---|
| 203 | >%Z< >''< >%Z INVALID<
|
|---|
| 204 | >%a< >''< >%a INVALID<
|
|---|
| 205 | >%b< >2**32-1< >11111111111111111111111111111111<
|
|---|
| 206 | >%+b< >2**32-1< >11111111111111111111111111111111<
|
|---|
| 207 | >%#b< >2**32-1< >0b11111111111111111111111111111111<
|
|---|
| 208 | >%34b< >2**32-1< > 11111111111111111111111111111111<
|
|---|
| 209 | >%034b< >2**32-1< >0011111111111111111111111111111111<
|
|---|
| 210 | >%-34b< >2**32-1< >11111111111111111111111111111111 <
|
|---|
| 211 | >%-034b< >2**32-1< >11111111111111111111111111111111 <
|
|---|
| 212 | >%c< >ord('A')< >A<
|
|---|
| 213 | >%10c< >ord('A')< > A<
|
|---|
| 214 | >%#10c< >ord('A')< > A< ># modifier: no effect<
|
|---|
| 215 | >%010c< >ord('A')< >000000000A<
|
|---|
| 216 | >%10lc< >ord('A')< > A< >l modifier: no effect<
|
|---|
| 217 | >%10hc< >ord('A')< > A< >h modifier: no effect<
|
|---|
| 218 | >%10.5c< >ord('A')< > A< >precision: no effect<
|
|---|
| 219 | >%-10c< >ord('A')< >A <
|
|---|
|
|---|
