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