1 | #!/usr/bin/perl -w
|
---|
2 | # Copyright (C) 1999 Free Software Foundation, Inc.
|
---|
3 | # This file is part of the GNU C Library.
|
---|
4 | # Contributed by Andreas Jaeger <aj@suse.de>, 1999.
|
---|
5 |
|
---|
6 | # The GNU C Library is free software; you can redistribute it and/or
|
---|
7 | # modify it under the terms of the GNU Lesser General Public
|
---|
8 | # License as published by the Free Software Foundation; either
|
---|
9 | # version 2.1 of the License, or (at your option) any later version.
|
---|
10 |
|
---|
11 | # The GNU C Library is distributed in the hope that it will be useful,
|
---|
12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
---|
14 | # Lesser General Public License for more details.
|
---|
15 |
|
---|
16 | # You should have received a copy of the GNU Lesser General Public
|
---|
17 | # License along with the GNU C Library; if not, write to the Free
|
---|
18 | # Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
|
---|
19 | # 02111-1307 USA.
|
---|
20 |
|
---|
21 | # This file needs to be tidied up
|
---|
22 | # Note that functions and tests share the same namespace.
|
---|
23 |
|
---|
24 | # Information about tests are stored in: %results
|
---|
25 | # $results{$test}{"kind"} is either "fct" or "test" and flags whether this
|
---|
26 | # is a maximal error of a function or a single test.
|
---|
27 | # $results{$test}{"type"} is the result type, e.g. normal or complex.
|
---|
28 | # $results{$test}{"has_ulps"} is set if deltas exist.
|
---|
29 | # $results{$test}{"has_fails"} is set if exptected failures exist.
|
---|
30 | # In the following description $type and $float are:
|
---|
31 | # - $type is either "normal", "real" (for the real part of a complex number)
|
---|
32 | # or "imag" (for the imaginary part # of a complex number).
|
---|
33 | # - $float is either of float, ifloat, double, idouble, ldouble, ildouble;
|
---|
34 | # It represents the underlying floating point type (float, double or long
|
---|
35 | # double) and if inline functions (the leading i stands for inline)
|
---|
36 | # are used.
|
---|
37 | # $results{$test}{$type}{"fail"}{$float} is defined and has a 1 if
|
---|
38 | # the test is expected to fail
|
---|
39 | # $results{$test}{$type}{"ulp"}{$float} is defined and has a delta as value
|
---|
40 |
|
---|
41 |
|
---|
42 | use Getopt::Std;
|
---|
43 |
|
---|
44 | use strict;
|
---|
45 |
|
---|
46 | use vars qw ($input $output);
|
---|
47 | use vars qw (%results);
|
---|
48 | use vars qw (@tests @functions);
|
---|
49 | use vars qw ($count);
|
---|
50 | use vars qw (%beautify @all_floats);
|
---|
51 | use vars qw ($output_dir $ulps_file);
|
---|
52 |
|
---|
53 | # all_floats is sorted and contains all recognised float types
|
---|
54 | @all_floats = ('double', 'float', 'idouble',
|
---|
55 | 'ifloat', 'ildouble', 'ldouble');
|
---|
56 |
|
---|
57 | %beautify =
|
---|
58 | ( "minus_zero" => "-0",
|
---|
59 | "plus_zero" => "+0",
|
---|
60 | "minus_infty" => "-inf",
|
---|
61 | "plus_infty" => "inf",
|
---|
62 | "nan_value" => "NaN",
|
---|
63 | "M_El" => "e",
|
---|
64 | "M_E2l" => "e^2",
|
---|
65 | "M_E3l" => "e^3",
|
---|
66 | "M_LOG10El", "log10(e)",
|
---|
67 | "M_PIl" => "pi",
|
---|
68 | "M_PI_34l" => "3/4 pi",
|
---|
69 | "M_PI_2l" => "pi/2",
|
---|
70 | "M_PI_4l" => "pi/4",
|
---|
71 | "M_PI_6l" => "pi/6",
|
---|
72 | "M_PI_34_LOG10El" => "3/4 pi*log10(e)",
|
---|
73 | "M_PI_LOG10El" => "pi*log10(e)",
|
---|
74 | "M_PI2_LOG10El" => "pi/2*log10(e)",
|
---|
75 | "M_PI4_LOG10El" => "pi/4*log10(e)",
|
---|
76 | "M_LOG_SQRT_PIl" => "log(sqrt(pi))",
|
---|
77 | "M_LOG_2_SQRT_PIl" => "log(2*sqrt(pi))",
|
---|
78 | "M_2_SQRT_PIl" => "2 sqrt (pi)",
|
---|
79 | "M_SQRT_PIl" => "sqrt (pi)",
|
---|
80 | "INVALID_EXCEPTION" => "invalid exception",
|
---|
81 | "DIVIDE_BY_ZERO_EXCEPTION" => "division by zero exception",
|
---|
82 | "INVALID_EXCEPTION_OK" => "invalid exception allowed",
|
---|
83 | "DIVIDE_BY_ZERO_EXCEPTION_OK" => "division by zero exception allowed",
|
---|
84 | "EXCEPTIONS_OK" => "exceptions allowed",
|
---|
85 | "IGNORE_ZERO_INF_SIGN" => "sign of zero/inf not specified",
|
---|
86 | "INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN" => "invalid exception and sign of zero/inf not specified"
|
---|
87 | );
|
---|
88 |
|
---|
89 |
|
---|
90 | # get Options
|
---|
91 | # Options:
|
---|
92 | # u: ulps-file
|
---|
93 | # h: help
|
---|
94 | # o: output-directory
|
---|
95 | # n: generate new ulps file
|
---|
96 | use vars qw($opt_u $opt_h $opt_o $opt_n);
|
---|
97 | getopts('u:o:nh');
|
---|
98 |
|
---|
99 | $ulps_file = 'libm-test-ulps';
|
---|
100 | $output_dir = '';
|
---|
101 |
|
---|
102 | if ($opt_h) {
|
---|
103 | print "Usage: gen-libm-test.pl [OPTIONS]\n";
|
---|
104 | print " -h print this help, then exit\n";
|
---|
105 | print " -o DIR directory where generated files will be placed\n";
|
---|
106 | print " -n only generate sorted file NewUlps from libm-test-ulps\n";
|
---|
107 | print " -u FILE input file with ulps\n";
|
---|
108 | exit 0;
|
---|
109 | }
|
---|
110 |
|
---|
111 | $ulps_file = $opt_u if ($opt_u);
|
---|
112 | $output_dir = $opt_o if ($opt_o);
|
---|
113 |
|
---|
114 | $input = "libm-test.inc";
|
---|
115 | $output = "${output_dir}libm-test.c";
|
---|
116 |
|
---|
117 | $count = 0;
|
---|
118 |
|
---|
119 | &parse_ulps ($ulps_file);
|
---|
120 | &generate_testfile ($input, $output) unless ($opt_n);
|
---|
121 | &output_ulps ("${output_dir}libm-test-ulps.h", $ulps_file) unless ($opt_n);
|
---|
122 | &print_ulps_file ("${output_dir}NewUlps") if ($opt_n);
|
---|
123 |
|
---|
124 | # Return a nicer representation
|
---|
125 | sub beautify {
|
---|
126 | my ($arg) = @_;
|
---|
127 | my ($tmp);
|
---|
128 |
|
---|
129 | if (exists $beautify{$arg}) {
|
---|
130 | return $beautify{$arg};
|
---|
131 | }
|
---|
132 | if ($arg =~ /^-/) {
|
---|
133 | $tmp = $arg;
|
---|
134 | $tmp =~ s/^-//;
|
---|
135 | if (exists $beautify{$tmp}) {
|
---|
136 | return '-' . $beautify{$tmp};
|
---|
137 | }
|
---|
138 | }
|
---|
139 | if ($arg =~ /[0-9]L$/) {
|
---|
140 | $arg =~ s/L$//;
|
---|
141 | }
|
---|
142 | return $arg;
|
---|
143 | }
|
---|
144 |
|
---|
145 | # Return a nicer representation of a complex number
|
---|
146 | sub build_complex_beautify {
|
---|
147 | my ($r, $i) = @_;
|
---|
148 | my ($str1, $str2);
|
---|
149 |
|
---|
150 | $str1 = &beautify ($r);
|
---|
151 | $str2 = &beautify ($i);
|
---|
152 | if ($str2 =~ /^-/) {
|
---|
153 | $str2 =~ s/^-//;
|
---|
154 | $str1 .= ' - ' . $str2;
|
---|
155 | } else {
|
---|
156 | $str1 .= ' + ' . $str2;
|
---|
157 | }
|
---|
158 | $str1 .= ' i';
|
---|
159 | return $str1;
|
---|
160 | }
|
---|
161 |
|
---|
162 | # Return name of a variable
|
---|
163 | sub get_variable {
|
---|
164 | my ($number) = @_;
|
---|
165 |
|
---|
166 | return "x" if ($number == 1);
|
---|
167 | return "y" if ($number == 2);
|
---|
168 | return "z" if ($number == 3);
|
---|
169 | # return x1,x2,...
|
---|
170 | $number =-3;
|
---|
171 | return "x$number";
|
---|
172 | }
|
---|
173 |
|
---|
174 | # Add a new test to internal data structures and fill in the
|
---|
175 | # ulps, failures and exception information for the C line.
|
---|
176 | sub new_test {
|
---|
177 | my ($test, $exception) = @_;
|
---|
178 | my $rest;
|
---|
179 |
|
---|
180 | # Add ulp, xfail
|
---|
181 | if (exists $results{$test}{'has_ulps'}) {
|
---|
182 | $rest = ", DELTA$count";
|
---|
183 | } else {
|
---|
184 | $rest = ', 0';
|
---|
185 | }
|
---|
186 | if (exists $results{$test}{'has_fails'}) {
|
---|
187 | $rest .= ", FAIL$count";
|
---|
188 | } else {
|
---|
189 | $rest .= ', 0';
|
---|
190 | }
|
---|
191 | if (defined $exception) {
|
---|
192 | $rest .= ", $exception";
|
---|
193 | } else {
|
---|
194 | $rest .= ', 0';
|
---|
195 | }
|
---|
196 | $rest .= ");\n";
|
---|
197 | # We must increment here to keep @tests and count in sync
|
---|
198 | push @tests, $test;
|
---|
199 | ++$count;
|
---|
200 | return $rest;
|
---|
201 | }
|
---|
202 |
|
---|
203 | # Treat some functions especially.
|
---|
204 | # Currently only sincos needs extra treatment.
|
---|
205 | sub special_functions {
|
---|
206 | my ($file, $args) = @_;
|
---|
207 | my (@args, $str, $test, $cline);
|
---|
208 |
|
---|
209 | @args = split /,\s*/, $args;
|
---|
210 |
|
---|
211 | unless ($args[0] =~ /sincos/) {
|
---|
212 | die ("Don't know how to handle $args[0] extra.");
|
---|
213 | }
|
---|
214 | print $file " FUNC (sincos) ($args[1], &sin_res, &cos_res);\n";
|
---|
215 |
|
---|
216 | $str = 'sincos (' . &beautify ($args[1]) . ', &sin_res, &cos_res)';
|
---|
217 | # handle sin
|
---|
218 | $test = $str . ' puts ' . &beautify ($args[2]) . ' in sin_res';
|
---|
219 | if ($#args == 4) {
|
---|
220 | $test .= " plus " . &beautify ($args[4]);
|
---|
221 | }
|
---|
222 |
|
---|
223 | $cline = " check_float (\"$test\", sin_res, $args[2]";
|
---|
224 | $cline .= &new_test ($test, $args[4]);
|
---|
225 | print $file $cline;
|
---|
226 |
|
---|
227 | # handle cos
|
---|
228 | $test = $str . ' puts ' . &beautify ($args[3]) . ' in cos_res';
|
---|
229 | $cline = " check_float (\"$test\", cos_res, $args[3]";
|
---|
230 | # only tests once for exception
|
---|
231 | $cline .= &new_test ($test, undef);
|
---|
232 | print $file $cline;
|
---|
233 | }
|
---|
234 |
|
---|
235 | # Parse the arguments to TEST_x_y
|
---|
236 | sub parse_args {
|
---|
237 | my ($file, $descr, $args) = @_;
|
---|
238 | my (@args, $str, $descr_args, $descr_res, @descr);
|
---|
239 | my ($current_arg, $cline, $i);
|
---|
240 | my ($pre, $post, @special);
|
---|
241 | my ($extra_var, $call, $c_call);
|
---|
242 |
|
---|
243 | if ($descr eq 'extra') {
|
---|
244 | &special_functions ($file, $args);
|
---|
245 | return;
|
---|
246 | }
|
---|
247 | ($descr_args, $descr_res) = split /_/,$descr, 2;
|
---|
248 |
|
---|
249 | @args = split /,\s*/, $args;
|
---|
250 |
|
---|
251 | $call = "$args[0] (";
|
---|
252 |
|
---|
253 | # Generate first the string that's shown to the user
|
---|
254 | $current_arg = 1;
|
---|
255 | $extra_var = 0;
|
---|
256 | @descr = split //,$descr_args;
|
---|
257 | for ($i = 0; $i <= $#descr; $i++) {
|
---|
258 | if ($i >= 1) {
|
---|
259 | $call .= ', ';
|
---|
260 | }
|
---|
261 | # FLOAT, int, long int, long long int
|
---|
262 | if ($descr[$i] =~ /f|i|l|L/) {
|
---|
263 | $call .= &beautify ($args[$current_arg]);
|
---|
264 | ++$current_arg;
|
---|
265 | next;
|
---|
266 | }
|
---|
267 | # &FLOAT, &int - argument is added here
|
---|
268 | if ($descr[$i] =~ /F|I/) {
|
---|
269 | ++$extra_var;
|
---|
270 | $call .= '&' . &get_variable ($extra_var);
|
---|
271 | next;
|
---|
272 | }
|
---|
273 | # complex
|
---|
274 | if ($descr[$i] eq 'c') {
|
---|
275 | $call .= &build_complex_beautify ($args[$current_arg], $args[$current_arg+1]);
|
---|
276 | $current_arg += 2;
|
---|
277 | next;
|
---|
278 | }
|
---|
279 |
|
---|
280 | die ("$descr[$i] is unknown");
|
---|
281 | }
|
---|
282 | $call .= ')';
|
---|
283 | $str = "$call == ";
|
---|
284 |
|
---|
285 | # Result
|
---|
286 | @descr = split //,$descr_res;
|
---|
287 | foreach (@descr) {
|
---|
288 | if ($_ =~ /f|i|l|L/) {
|
---|
289 | $str .= &beautify ($args[$current_arg]);
|
---|
290 | ++$current_arg;
|
---|
291 | } elsif ($_ eq 'c') {
|
---|
292 | $str .= &build_complex_beautify ($args[$current_arg], $args[$current_arg+1]);
|
---|
293 | $current_arg += 2;
|
---|
294 | } elsif ($_ eq 'b') {
|
---|
295 | # boolean
|
---|
296 | $str .= ($args[$current_arg] == 0) ? "false" : "true";
|
---|
297 | ++$current_arg;
|
---|
298 | } elsif ($_ eq '1') {
|
---|
299 | ++$current_arg;
|
---|
300 | } else {
|
---|
301 | die ("$_ is unknown");
|
---|
302 | }
|
---|
303 | }
|
---|
304 | # consistency check
|
---|
305 | if ($current_arg == $#args) {
|
---|
306 | die ("wrong number of arguments")
|
---|
307 | unless ($args[$current_arg] =~ /EXCEPTION|IGNORE_ZERO_INF_SIGN/);
|
---|
308 | } elsif ($current_arg < $#args) {
|
---|
309 | die ("wrong number of arguments");
|
---|
310 | } elsif ($current_arg > ($#args+1)) {
|
---|
311 | die ("wrong number of arguments");
|
---|
312 | }
|
---|
313 |
|
---|
314 |
|
---|
315 | # check for exceptions
|
---|
316 | if ($current_arg <= $#args) {
|
---|
317 | $str .= " plus " . &beautify ($args[$current_arg]);
|
---|
318 | }
|
---|
319 |
|
---|
320 | # Put the C program line together
|
---|
321 | # Reset some variables to start again
|
---|
322 | $current_arg = 1;
|
---|
323 | $extra_var = 0;
|
---|
324 | if (substr($descr_res,0,1) eq 'f') {
|
---|
325 | $cline = 'check_float'
|
---|
326 | } elsif (substr($descr_res,0,1) eq 'b') {
|
---|
327 | $cline = 'check_bool';
|
---|
328 | } elsif (substr($descr_res,0,1) eq 'c') {
|
---|
329 | $cline = 'check_complex';
|
---|
330 | } elsif (substr($descr_res,0,1) eq 'i') {
|
---|
331 | $cline = 'check_int';
|
---|
332 | } elsif (substr($descr_res,0,1) eq 'l') {
|
---|
333 | $cline = 'check_long';
|
---|
334 | } elsif (substr($descr_res,0,1) eq 'L') {
|
---|
335 | $cline = 'check_longlong';
|
---|
336 | }
|
---|
337 | # Special handling for some macros:
|
---|
338 | $cline .= " (\"$str\", ";
|
---|
339 | if ($args[0] =~ /fpclassify|isnormal|isfinite|signbit/) {
|
---|
340 | $c_call = "$args[0] (";
|
---|
341 | } else {
|
---|
342 | $c_call = " FUNC($args[0]) (";
|
---|
343 | }
|
---|
344 | @descr = split //,$descr_args;
|
---|
345 | for ($i=0; $i <= $#descr; $i++) {
|
---|
346 | if ($i >= 1) {
|
---|
347 | $c_call .= ', ';
|
---|
348 | }
|
---|
349 | # FLOAT, int, long int, long long int
|
---|
350 | if ($descr[$i] =~ /f|i|l|L/) {
|
---|
351 | $c_call .= $args[$current_arg];
|
---|
352 | $current_arg++;
|
---|
353 | next;
|
---|
354 | }
|
---|
355 | # &FLOAT, &int
|
---|
356 | if ($descr[$i] =~ /F|I/) {
|
---|
357 | ++$extra_var;
|
---|
358 | $c_call .= '&' . &get_variable ($extra_var);
|
---|
359 | next;
|
---|
360 | }
|
---|
361 | # complex
|
---|
362 | if ($descr[$i] eq 'c') {
|
---|
363 | $c_call .= "BUILD_COMPLEX ($args[$current_arg], $args[$current_arg+1])";
|
---|
364 | $current_arg += 2;
|
---|
365 | next;
|
---|
366 | }
|
---|
367 | }
|
---|
368 | $c_call .= ')';
|
---|
369 | $cline .= "$c_call, ";
|
---|
370 |
|
---|
371 | @descr = split //,$descr_res;
|
---|
372 | foreach (@descr) {
|
---|
373 | if ($_ =~ /b|f|i|l|L/ ) {
|
---|
374 | $cline .= $args[$current_arg];
|
---|
375 | $current_arg++;
|
---|
376 | } elsif ($_ eq 'c') {
|
---|
377 | $cline .= "BUILD_COMPLEX ($args[$current_arg], $args[$current_arg+1])";
|
---|
378 | $current_arg += 2;
|
---|
379 | } elsif ($_ eq '1') {
|
---|
380 | push @special, $args[$current_arg];
|
---|
381 | ++$current_arg;
|
---|
382 | }
|
---|
383 | }
|
---|
384 | # Add ulp, xfail
|
---|
385 | $cline .= &new_test ($str, ($current_arg <= $#args) ? $args[$current_arg] : undef);
|
---|
386 |
|
---|
387 | # special treatment for some functions
|
---|
388 | if ($args[0] eq 'frexp') {
|
---|
389 | if (defined $special[0] && $special[0] ne "IGNORE") {
|
---|
390 | my ($str) = "$call sets x to $special[0]";
|
---|
391 | $post = " check_int (\"$str\", x, $special[0]";
|
---|
392 | $post .= &new_test ($str, undef);
|
---|
393 | }
|
---|
394 | } elsif ($args[0] eq 'gamma' || $args[0] eq 'lgamma') {
|
---|
395 | $pre = " signgam = 0;\n";
|
---|
396 | if (defined $special[0] && $special[0] ne "IGNORE") {
|
---|
397 | my ($str) = "$call sets signgam to $special[0]";
|
---|
398 | $post = " check_int (\"$str\", signgam, $special[0]";
|
---|
399 | $post .= &new_test ($str, undef);
|
---|
400 | }
|
---|
401 | } elsif ($args[0] eq 'modf') {
|
---|
402 | if (defined $special[0] && $special[0] ne "IGNORE") {
|
---|
403 | my ($str) = "$call sets x to $special[0]";
|
---|
404 | $post = " check_float (\"$str\", x, $special[0]";
|
---|
405 | $post .= &new_test ($str, undef);
|
---|
406 | }
|
---|
407 | } elsif ($args[0] eq 'remquo') {
|
---|
408 | if (defined $special[0] && $special[0] ne "IGNORE") {
|
---|
409 | my ($str) = "$call sets x to $special[0]";
|
---|
410 | $post = " check_int (\"$str\", x, $special[0]";
|
---|
411 | $post .= &new_test ($str, undef);
|
---|
412 | }
|
---|
413 | }
|
---|
414 |
|
---|
415 | print $file $pre if (defined $pre);
|
---|
416 |
|
---|
417 | print $file " $cline";
|
---|
418 |
|
---|
419 | print $file $post if (defined $post);
|
---|
420 | }
|
---|
421 |
|
---|
422 | # Generate libm-test.c
|
---|
423 | sub generate_testfile {
|
---|
424 | my ($input, $output) = @_;
|
---|
425 | my ($lasttext);
|
---|
426 | my (@args, $i, $str);
|
---|
427 |
|
---|
428 | open INPUT, $input or die ("Can't open $input: $!");
|
---|
429 | open OUTPUT, ">$output" or die ("Can't open $output: $!");
|
---|
430 |
|
---|
431 | # Replace the special macros
|
---|
432 | while (<INPUT>) {
|
---|
433 |
|
---|
434 | # TEST_...
|
---|
435 | if (/^\s*TEST_/) {
|
---|
436 | my ($descr, $args);
|
---|
437 | chop;
|
---|
438 | ($descr, $args) = ($_ =~ /TEST_(\w+)\s*\((.*)\)/);
|
---|
439 | &parse_args (\*OUTPUT, $descr, $args);
|
---|
440 | next;
|
---|
441 | }
|
---|
442 | # START (function)
|
---|
443 | if (/START/) {
|
---|
444 | print OUTPUT " init_max_error ();\n";
|
---|
445 | next;
|
---|
446 | }
|
---|
447 | # END (function)
|
---|
448 | if (/END/) {
|
---|
449 | my ($fct, $line, $type);
|
---|
450 | if (/complex/) {
|
---|
451 | s/,\s*complex\s*//;
|
---|
452 | $type = 'complex';
|
---|
453 | } else {
|
---|
454 | $type = 'normal';
|
---|
455 | }
|
---|
456 | ($fct) = ($_ =~ /END\s*\((.*)\)/);
|
---|
457 | if ($type eq 'complex') {
|
---|
458 | $line = " print_complex_max_error (\"$fct\", ";
|
---|
459 | } else {
|
---|
460 | $line = " print_max_error (\"$fct\", ";
|
---|
461 | }
|
---|
462 | if (exists $results{$fct}{'has_ulps'}) {
|
---|
463 | $line .= "DELTA$fct";
|
---|
464 | } else {
|
---|
465 | $line .= '0';
|
---|
466 | }
|
---|
467 | if (exists $results{$fct}{'has_fails'}) {
|
---|
468 | $line .= ", FAIL$fct";
|
---|
469 | } else {
|
---|
470 | $line .= ', 0';
|
---|
471 | }
|
---|
472 | $line .= ");\n";
|
---|
473 | print OUTPUT $line;
|
---|
474 | push @functions, $fct;
|
---|
475 | next;
|
---|
476 | }
|
---|
477 | print OUTPUT;
|
---|
478 | }
|
---|
479 | close INPUT;
|
---|
480 | close OUTPUT;
|
---|
481 | }
|
---|
482 |
|
---|
483 |
|
---|
484 |
|
---|
485 | # Parse ulps file
|
---|
486 | sub parse_ulps {
|
---|
487 | my ($file) = @_;
|
---|
488 | my ($test, $type, $float, $eps, $kind);
|
---|
489 |
|
---|
490 | # $type has the following values:
|
---|
491 | # "normal": No complex variable
|
---|
492 | # "real": Real part of complex result
|
---|
493 | # "imag": Imaginary part of complex result
|
---|
494 | open ULP, $file or die ("Can't open $file: $!");
|
---|
495 | while (<ULP>) {
|
---|
496 | chop;
|
---|
497 | # ignore comments and empty lines
|
---|
498 | next if /^#/;
|
---|
499 | next if /^\s*$/;
|
---|
500 | if (/^Test/) {
|
---|
501 | if (/Real part of:/) {
|
---|
502 | s/Real part of: //;
|
---|
503 | $type = 'real';
|
---|
504 | } elsif (/Imaginary part of:/) {
|
---|
505 | s/Imaginary part of: //;
|
---|
506 | $type = 'imag';
|
---|
507 | } else {
|
---|
508 | $type = 'normal';
|
---|
509 | }
|
---|
510 | s/^.+\"(.*)\".*$/$1/;
|
---|
511 | $test = $_;
|
---|
512 | $kind = 'test';
|
---|
513 | next;
|
---|
514 | }
|
---|
515 | if (/^Function: /) {
|
---|
516 | if (/Real part of/) {
|
---|
517 | s/Real part of //;
|
---|
518 | $type = 'real';
|
---|
519 | } elsif (/Imaginary part of/) {
|
---|
520 | s/Imaginary part of //;
|
---|
521 | $type = 'imag';
|
---|
522 | } else {
|
---|
523 | $type = 'normal';
|
---|
524 | }
|
---|
525 | ($test) = ($_ =~ /^Function:\s*\"([a-zA-Z0-9_]+)\"/);
|
---|
526 | $kind = 'fct';
|
---|
527 | next;
|
---|
528 | }
|
---|
529 | if (/^i?(float|double|ldouble):/) {
|
---|
530 | ($float, $eps) = split /\s*:\s*/,$_,2;
|
---|
531 |
|
---|
532 | if ($eps eq 'fail') {
|
---|
533 | $results{$test}{$type}{'fail'}{$float} = 1;
|
---|
534 | $results{$test}{'has_fails'} = 1;
|
---|
535 | } elsif ($eps eq "0") {
|
---|
536 | # ignore
|
---|
537 | next;
|
---|
538 | } else {
|
---|
539 | $results{$test}{$type}{'ulp'}{$float} = $eps;
|
---|
540 | $results{$test}{'has_ulps'} = 1;
|
---|
541 | }
|
---|
542 | if ($type =~ /^real|imag$/) {
|
---|
543 | $results{$test}{'type'} = 'complex';
|
---|
544 | } elsif ($type eq 'normal') {
|
---|
545 | $results{$test}{'type'} = 'normal';
|
---|
546 | }
|
---|
547 | $results{$test}{'kind'} = $kind;
|
---|
548 | next;
|
---|
549 | }
|
---|
550 | print "Skipping unknown entry: `$_'\n";
|
---|
551 | }
|
---|
552 | close ULP;
|
---|
553 | }
|
---|
554 |
|
---|
555 |
|
---|
556 | # Clean up a floating point number
|
---|
557 | sub clean_up_number {
|
---|
558 | my ($number) = @_;
|
---|
559 |
|
---|
560 | # Remove trailing zeros
|
---|
561 | $number =~ s/0+$//;
|
---|
562 | $number =~ s/\.$//;
|
---|
563 | return $number;
|
---|
564 | }
|
---|
565 |
|
---|
566 | # Output a file which can be read in as ulps file.
|
---|
567 | sub print_ulps_file {
|
---|
568 | my ($file) = @_;
|
---|
569 | my ($test, $type, $float, $eps, $fct, $last_fct);
|
---|
570 |
|
---|
571 | $last_fct = '';
|
---|
572 | open NEWULP, ">$file" or die ("Can't open $file: $!");
|
---|
573 | print NEWULP "# Begin of automatic generation\n";
|
---|
574 | # first the function calls
|
---|
575 | foreach $test (sort keys %results) {
|
---|
576 | next if ($results{$test}{'kind'} ne 'test');
|
---|
577 | foreach $type ('real', 'imag', 'normal') {
|
---|
578 | if (exists $results{$test}{$type}) {
|
---|
579 | if (defined $results{$test}) {
|
---|
580 | ($fct) = ($test =~ /^(\w+)\s/);
|
---|
581 | if ($fct ne $last_fct) {
|
---|
582 | $last_fct = $fct;
|
---|
583 | print NEWULP "\n# $fct\n";
|
---|
584 | }
|
---|
585 | }
|
---|
586 | if ($type eq 'normal') {
|
---|
587 | print NEWULP "Test \"$test\":\n";
|
---|
588 | } elsif ($type eq 'real') {
|
---|
589 | print NEWULP "Test \"Real part of: $test\":\n";
|
---|
590 | } elsif ($type eq 'imag') {
|
---|
591 | print NEWULP "Test \"Imaginary part of: $test\":\n";
|
---|
592 | }
|
---|
593 | foreach $float (@all_floats) {
|
---|
594 | if (exists $results{$test}{$type}{'ulp'}{$float}) {
|
---|
595 | print NEWULP "$float: ",
|
---|
596 | &clean_up_number ($results{$test}{$type}{'ulp'}{$float}),
|
---|
597 | "\n";
|
---|
598 | }
|
---|
599 | if (exists $results{$test}{$type}{'fail'}{$float}) {
|
---|
600 | print NEWULP "$float: fail\n";
|
---|
601 | }
|
---|
602 | }
|
---|
603 | }
|
---|
604 | }
|
---|
605 | }
|
---|
606 | print NEWULP "\n# Maximal error of functions:\n";
|
---|
607 |
|
---|
608 | foreach $fct (sort keys %results) {
|
---|
609 | next if ($results{$fct}{'kind'} ne 'fct');
|
---|
610 | foreach $type ('real', 'imag', 'normal') {
|
---|
611 | if (exists $results{$fct}{$type}) {
|
---|
612 | if ($type eq 'normal') {
|
---|
613 | print NEWULP "Function: \"$fct\":\n";
|
---|
614 | } elsif ($type eq 'real') {
|
---|
615 | print NEWULP "Function: Real part of \"$fct\":\n";
|
---|
616 | } elsif ($type eq 'imag') {
|
---|
617 | print NEWULP "Function: Imaginary part of \"$fct\":\n";
|
---|
618 | }
|
---|
619 | foreach $float (@all_floats) {
|
---|
620 | if (exists $results{$fct}{$type}{'ulp'}{$float}) {
|
---|
621 | print NEWULP "$float: ",
|
---|
622 | &clean_up_number ($results{$fct}{$type}{'ulp'}{$float}),
|
---|
623 | "\n";
|
---|
624 | }
|
---|
625 | if (exists $results{$fct}{$type}{'fail'}{$float}) {
|
---|
626 | print NEWULP "$float: fail\n";
|
---|
627 | }
|
---|
628 | }
|
---|
629 | print NEWULP "\n";
|
---|
630 | }
|
---|
631 | }
|
---|
632 | }
|
---|
633 | print NEWULP "# end of automatic generation\n";
|
---|
634 | close NEWULP;
|
---|
635 | }
|
---|
636 |
|
---|
637 | sub get_ulps {
|
---|
638 | my ($test, $type, $float) = @_;
|
---|
639 |
|
---|
640 | if ($type eq 'complex') {
|
---|
641 | my ($res);
|
---|
642 | # Return 0 instead of BUILD_COMPLEX (0,0)
|
---|
643 | if (!exists $results{$test}{'real'}{'ulp'}{$float} &&
|
---|
644 | !exists $results{$test}{'imag'}{'ulp'}{$float}) {
|
---|
645 | return "0";
|
---|
646 | }
|
---|
647 | $res = 'BUILD_COMPLEX (';
|
---|
648 | $res .= (exists $results{$test}{'real'}{'ulp'}{$float}
|
---|
649 | ? $results{$test}{'real'}{'ulp'}{$float} : "0");
|
---|
650 | $res .= ', ';
|
---|
651 | $res .= (exists $results{$test}{'imag'}{'ulp'}{$float}
|
---|
652 | ? $results{$test}{'imag'}{'ulp'}{$float} : "0");
|
---|
653 | $res .= ')';
|
---|
654 | return $res;
|
---|
655 | }
|
---|
656 | return (exists $results{$test}{'normal'}{'ulp'}{$float}
|
---|
657 | ? $results{$test}{'normal'}{'ulp'}{$float} : "0");
|
---|
658 | }
|
---|
659 |
|
---|
660 | sub get_failure {
|
---|
661 | my ($test, $type, $float) = @_;
|
---|
662 | if ($type eq 'complex') {
|
---|
663 | # return x,y
|
---|
664 | my ($res);
|
---|
665 | # Return 0 instead of BUILD_COMPLEX_INT (0,0)
|
---|
666 | if (!exists $results{$test}{'real'}{'ulp'}{$float} &&
|
---|
667 | !exists $results{$test}{'imag'}{'ulp'}{$float}) {
|
---|
668 | return "0";
|
---|
669 | }
|
---|
670 | $res = 'BUILD_COMPLEX_INT (';
|
---|
671 | $res .= (exists $results{$test}{'real'}{'fail'}{$float}
|
---|
672 | ? $results{$test}{'real'}{'fail'}{$float} : "0");
|
---|
673 | $res .= ', ';
|
---|
674 | $res .= (exists $results{$test}{'imag'}{'fail'}{$float}
|
---|
675 | ? $results{$test}{'imag'}{'fail'}{$float} : "0");
|
---|
676 | $res .= ')';
|
---|
677 | return $res;
|
---|
678 | }
|
---|
679 | return (exists $results{$test}{'normal'}{'fail'}{$float}
|
---|
680 | ? $results{$test}{'normal'}{'fail'}{$float} : "0");
|
---|
681 |
|
---|
682 | }
|
---|
683 |
|
---|
684 | # Output the defines for a single test
|
---|
685 | sub output_test {
|
---|
686 | my ($file, $test, $name) = @_;
|
---|
687 | my ($ldouble, $double, $float, $ildouble, $idouble, $ifloat);
|
---|
688 | my ($type);
|
---|
689 |
|
---|
690 | # Do we have ulps/failures?
|
---|
691 | if (!exists $results{$test}{'type'}) {
|
---|
692 | return;
|
---|
693 | }
|
---|
694 | $type = $results{$test}{'type'};
|
---|
695 | if (exists $results{$test}{'has_ulps'}) {
|
---|
696 | # XXX use all_floats (change order!)
|
---|
697 | $ldouble = &get_ulps ($test, $type, "ldouble");
|
---|
698 | $double = &get_ulps ($test, $type, "double");
|
---|
699 | $float = &get_ulps ($test, $type, "float");
|
---|
700 | $ildouble = &get_ulps ($test, $type, "ildouble");
|
---|
701 | $idouble = &get_ulps ($test, $type, "idouble");
|
---|
702 | $ifloat = &get_ulps ($test, $type, "ifloat");
|
---|
703 | print $file "#define DELTA$name CHOOSE($ldouble, $double, $float, $ildouble, $idouble, $ifloat)\t/* $test */\n";
|
---|
704 | }
|
---|
705 |
|
---|
706 | if (exists $results{$test}{'has_fails'}) {
|
---|
707 | $ldouble = &get_failure ($test, "ldouble");
|
---|
708 | $double = &get_failure ($test, "double");
|
---|
709 | $float = &get_failure ($test, "float");
|
---|
710 | $ildouble = &get_failure ($test, "ildouble");
|
---|
711 | $idouble = &get_failure ($test, "idouble");
|
---|
712 | $ifloat = &get_failure ($test, "ifloat");
|
---|
713 | print $file "#define FAIL$name CHOOSE($ldouble, $double, $float $ildouble, $idouble, $ifloat)\t/* $test */\n";
|
---|
714 | }
|
---|
715 | }
|
---|
716 |
|
---|
717 | # Print include file
|
---|
718 | sub output_ulps {
|
---|
719 | my ($file, $ulps_filename) = @_;
|
---|
720 | my ($i, $fct);
|
---|
721 |
|
---|
722 | open ULP, ">$file" or die ("Can't open $file: $!");
|
---|
723 |
|
---|
724 | print ULP "/* This file is automatically generated\n";
|
---|
725 | print ULP " from $ulps_filename with gen-libm-test.pl.\n";
|
---|
726 | print ULP " Don't change it - change instead the master files. */\n\n";
|
---|
727 |
|
---|
728 | print ULP "\n/* Maximal error of functions. */\n";
|
---|
729 | foreach $fct (@functions) {
|
---|
730 | output_test (\*ULP, $fct, $fct);
|
---|
731 | }
|
---|
732 |
|
---|
733 | print ULP "\n/* Error of single function calls. */\n";
|
---|
734 | for ($i = 0; $i < $count; $i++) {
|
---|
735 | output_test (\*ULP, $tests[$i], $i);
|
---|
736 | }
|
---|
737 | close ULP;
|
---|
738 | }
|
---|