]>
Commit | Line | Data |
---|---|---|
8847214f | 1 | #!/usr/bin/perl -w |
a334319f | 2 | # Copyright (C) 1999 Free Software Foundation, Inc. |
8847214f UD |
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 | |
41bdb6e2 AJ |
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. | |
8847214f UD |
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 | |
41bdb6e2 | 14 | # Lesser General Public License for more details. |
8847214f | 15 | |
41bdb6e2 AJ |
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. | |
8847214f UD |
20 | |
21 | # This file needs to be tidied up | |
22 | # Note that functions and tests share the same namespace. | |
23 | ||
6815fabc | 24 | # Information about tests are stored in: %results |
a9b5d2ee UD |
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. | |
6815fabc UD |
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. | |
3a8e65a0 | 37 | # $results{$test}{$type}{"fail"}{$float} is defined and has a 1 if |
6815fabc UD |
38 | # the test is expected to fail |
39 | # $results{$test}{$type}{"ulp"}{$float} is defined and has a delta as value | |
40 | ||
41 | ||
8847214f UD |
42 | use Getopt::Std; |
43 | ||
44 | use strict; | |
45 | ||
46 | use vars qw ($input $output); | |
6815fabc | 47 | use vars qw (%results); |
8847214f UD |
48 | use vars qw (@tests @functions); |
49 | use vars qw ($count); | |
6815fabc | 50 | use vars qw (%beautify @all_floats); |
8847214f UD |
51 | use vars qw ($output_dir $ulps_file); |
52 | ||
6815fabc | 53 | # all_floats is sorted and contains all recognised float types |
3a8e65a0 | 54 | @all_floats = ('double', 'float', 'idouble', |
6815fabc UD |
55 | 'ifloat', 'ildouble', 'ldouble'); |
56 | ||
fe559c5e | 57 | %beautify = |
8847214f UD |
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) { | |
f30e0cd3 | 103 | print "Usage: gen-libm-test.pl [OPTIONS]\n"; |
8847214f UD |
104 | print " -h print this help, then exit\n"; |
105 | print " -o DIR directory where generated files will be placed\n"; | |
a9b5d2ee | 106 | print " -n only generate sorted file NewUlps from libm-test-ulps\n"; |
8847214f UD |
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); | |
a9b5d2ee UD |
120 | &generate_testfile ($input, $output) unless ($opt_n); |
121 | &output_ulps ("${output_dir}libm-test-ulps.h", $ulps_file) unless ($opt_n); | |
8847214f UD |
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 | ||
fe559c5e UD |
166 | return "x" if ($number == 1); |
167 | return "y" if ($number == 2); | |
8847214f UD |
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 | |
6815fabc | 181 | if (exists $results{$test}{'has_ulps'}) { |
8847214f UD |
182 | $rest = ", DELTA$count"; |
183 | } else { | |
184 | $rest = ', 0'; | |
185 | } | |
6815fabc | 186 | if (exists $results{$test}{'has_fails'}) { |
8847214f UD |
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; | |
fe559c5e | 210 | |
8847214f UD |
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; | |
fe559c5e | 226 | |
8847214f UD |
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 { | |
a334319f | 237 | my ($file, $descr, $args) = @_; |
8847214f UD |
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 | ||
a334319f | 251 | $call = "$args[0] ("; |
8847214f UD |
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 | ||
fe559c5e | 285 | # Result |
8847214f UD |
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); | |
fe559c5e | 406 | } |
8847214f UD |
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 | } | |
fe559c5e | 414 | |
8847214f UD |
415 | print $file $pre if (defined $pre); |
416 | ||
6815fabc | 417 | print $file " $cline"; |
8847214f UD |
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); | |
a334319f | 426 | my (@args, $i, $str); |
8847214f UD |
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*\((.*)\)/); | |
a334319f | 439 | &parse_args (\*OUTPUT, $descr, $args); |
8847214f UD |
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/) { | |
6815fabc UD |
449 | my ($fct, $line, $type); |
450 | if (/complex/) { | |
451 | s/,\s*complex\s*//; | |
452 | $type = 'complex'; | |
453 | } else { | |
454 | $type = 'normal'; | |
455 | } | |
8847214f | 456 | ($fct) = ($_ =~ /END\s*\((.*)\)/); |
6815fabc UD |
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'}) { | |
8847214f UD |
463 | $line .= "DELTA$fct"; |
464 | } else { | |
465 | $line .= '0'; | |
466 | } | |
6815fabc | 467 | if (exists $results{$fct}{'has_fails'}) { |
8847214f UD |
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) = @_; | |
a9b5d2ee | 488 | my ($test, $type, $float, $eps, $kind); |
8847214f | 489 | |
6815fabc UD |
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 | |
8847214f UD |
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/) { | |
6815fabc UD |
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 | } | |
8847214f UD |
510 | s/^.+\"(.*)\".*$/$1/; |
511 | $test = $_; | |
a9b5d2ee | 512 | $kind = 'test'; |
8847214f UD |
513 | next; |
514 | } | |
6815fabc | 515 | if (/^Function: /) { |
03965c71 | 516 | if (/Real part of/) { |
6815fabc UD |
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_]+)\"/); | |
a9b5d2ee | 526 | $kind = 'fct'; |
8847214f UD |
527 | next; |
528 | } | |
529 | if (/^i?(float|double|ldouble):/) { | |
6815fabc | 530 | ($float, $eps) = split /\s*:\s*/,$_,2; |
3a8e65a0 | 531 | |
6815fabc UD |
532 | if ($eps eq 'fail') { |
533 | $results{$test}{$type}{'fail'}{$float} = 1; | |
534 | $results{$test}{'has_fails'} = 1; | |
3a8e65a0 UD |
535 | } elsif ($eps eq "0") { |
536 | # ignore | |
537 | next; | |
8847214f | 538 | } else { |
6815fabc UD |
539 | $results{$test}{$type}{'ulp'}{$float} = $eps; |
540 | $results{$test}{'has_ulps'} = 1; | |
8847214f | 541 | } |
3a8e65a0 UD |
542 | if ($type =~ /^real|imag$/) { |
543 | $results{$test}{'type'} = 'complex'; | |
544 | } elsif ($type eq 'normal') { | |
545 | $results{$test}{'type'} = 'normal'; | |
546 | } | |
a9b5d2ee | 547 | $results{$test}{'kind'} = $kind; |
8847214f UD |
548 | next; |
549 | } | |
550 | print "Skipping unknown entry: `$_'\n"; | |
551 | } | |
552 | close ULP; | |
553 | } | |
554 | ||
8847214f UD |
555 | |
556 | # Clean up a floating point number | |
557 | sub clean_up_number { | |
558 | my ($number) = @_; | |
fe559c5e | 559 | |
a334319f UD |
560 | # Remove trailing zeros |
561 | $number =~ s/0+$//; | |
562 | $number =~ s/\.$//; | |
8847214f UD |
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) = @_; | |
6815fabc | 569 | my ($test, $type, $float, $eps, $fct, $last_fct); |
8847214f UD |
570 | |
571 | $last_fct = ''; | |
572 | open NEWULP, ">$file" or die ("Can't open $file: $!"); | |
573 | print NEWULP "# Begin of automatic generation\n"; | |
a9b5d2ee UD |
574 | # first the function calls |
575 | foreach $test (sort keys %results) { | |
576 | next if ($results{$test}{'kind'} ne 'test'); | |
6815fabc UD |
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}) { | |
3a8e65a0 UD |
595 | print NEWULP "$float: ", |
596 | &clean_up_number ($results{$test}{$type}{'ulp'}{$float}), | |
6815fabc UD |
597 | "\n"; |
598 | } | |
599 | if (exists $results{$test}{$type}{'fail'}{$float}) { | |
600 | print NEWULP "$float: fail\n"; | |
601 | } | |
602 | } | |
8847214f UD |
603 | } |
604 | } | |
605 | } | |
606 | print NEWULP "\n# Maximal error of functions:\n"; | |
607 | ||
a9b5d2ee UD |
608 | foreach $fct (sort keys %results) { |
609 | next if ($results{$fct}{'kind'} ne 'fct'); | |
6815fabc UD |
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}) { | |
3a8e65a0 UD |
621 | print NEWULP "$float: ", |
622 | &clean_up_number ($results{$fct}{$type}{'ulp'}{$float}), | |
6815fabc UD |
623 | "\n"; |
624 | } | |
625 | if (exists $results{$fct}{$type}{'fail'}{$float}) { | |
626 | print NEWULP "$float: fail\n"; | |
627 | } | |
628 | } | |
629 | print NEWULP "\n"; | |
8847214f | 630 | } |
8847214f UD |
631 | } |
632 | } | |
633 | print NEWULP "# end of automatic generation\n"; | |
634 | close NEWULP; | |
635 | } | |
636 | ||
637 | sub get_ulps { | |
6815fabc UD |
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 ('; | |
3a8e65a0 | 648 | $res .= (exists $results{$test}{'real'}{'ulp'}{$float} |
6815fabc UD |
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"); | |
8847214f UD |
658 | } |
659 | ||
660 | sub get_failure { | |
6815fabc UD |
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 ('; | |
3a8e65a0 | 671 | $res .= (exists $results{$test}{'real'}{'fail'}{$float} |
6815fabc UD |
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 | ||
8847214f UD |
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); | |
6815fabc | 688 | my ($type); |
8847214f | 689 | |
6815fabc UD |
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"); | |
8847214f UD |
703 | print $file "#define DELTA$name CHOOSE($ldouble, $double, $float, $ildouble, $idouble, $ifloat)\t/* $test */\n"; |
704 | } | |
6815fabc UD |
705 | |
706 | if (exists $results{$test}{'has_fails'}) { | |
8847214f UD |
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 { | |
fe559c5e | 719 | my ($file, $ulps_filename) = @_; |
8847214f UD |
720 | my ($i, $fct); |
721 | ||
722 | open ULP, ">$file" or die ("Can't open $file: $!"); | |
723 | ||
fe559c5e UD |
724 | print ULP "/* This file is automatically generated\n"; |
725 | print ULP " from $ulps_filename with gen-libm-test.pl.\n"; | |
8847214f UD |
726 | print ULP " Don't change it - change instead the master files. */\n\n"; |
727 | ||
fe559c5e | 728 | print ULP "\n/* Maximal error of functions. */\n"; |
8847214f UD |
729 | foreach $fct (@functions) { |
730 | output_test (\*ULP, $fct, $fct); | |
731 | } | |
732 | ||
fe559c5e | 733 | print ULP "\n/* Error of single function calls. */\n"; |
8847214f UD |
734 | for ($i = 0; $i < $count; $i++) { |
735 | output_test (\*ULP, $tests[$i], $i); | |
736 | } | |
737 | close ULP; | |
738 | } |