]>
Commit | Line | Data |
---|---|---|
8847214f | 1 | #!/usr/bin/perl -w |
f7a9f785 | 2 | # Copyright (C) 1999-2016 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 | 16 | # You should have received a copy of the GNU Lesser General Public |
59ba27a6 PE |
17 | # License along with the GNU C Library; if not, see |
18 | # <http://www.gnu.org/licenses/>. | |
8847214f UD |
19 | |
20 | # This file needs to be tidied up | |
21 | # Note that functions and tests share the same namespace. | |
22 | ||
6815fabc UD |
23 | # Information about tests are stored in: %results |
24 | # $results{$test}{"type"} is the result type, e.g. normal or complex. | |
25 | # $results{$test}{"has_ulps"} is set if deltas exist. | |
6815fabc UD |
26 | # In the following description $type and $float are: |
27 | # - $type is either "normal", "real" (for the real part of a complex number) | |
28 | # or "imag" (for the imaginary part # of a complex number). | |
29 | # - $float is either of float, ifloat, double, idouble, ldouble, ildouble; | |
30 | # It represents the underlying floating point type (float, double or long | |
31 | # double) and if inline functions (the leading i stands for inline) | |
32 | # are used. | |
6815fabc UD |
33 | # $results{$test}{$type}{"ulp"}{$float} is defined and has a delta as value |
34 | ||
35 | ||
8847214f UD |
36 | use Getopt::Std; |
37 | ||
38 | use strict; | |
39 | ||
ffb536d0 | 40 | use vars qw ($input $output $auto_input); |
6815fabc | 41 | use vars qw (%results); |
6815fabc | 42 | use vars qw (%beautify @all_floats); |
1c0d11bc | 43 | use vars qw ($output_dir $ulps_file $srcdir); |
ffb536d0 | 44 | use vars qw (%auto_tests); |
8847214f | 45 | |
6815fabc | 46 | # all_floats is sorted and contains all recognised float types |
3a8e65a0 | 47 | @all_floats = ('double', 'float', 'idouble', |
6815fabc UD |
48 | 'ifloat', 'ildouble', 'ldouble'); |
49 | ||
fe559c5e | 50 | %beautify = |
8847214f UD |
51 | ( "minus_zero" => "-0", |
52 | "plus_zero" => "+0", | |
ffb536d0 JM |
53 | "-0x0p+0f" => "-0", |
54 | "-0x0p+0" => "-0", | |
55 | "-0x0p+0L" => "-0", | |
56 | "0x0p+0f" => "+0", | |
57 | "0x0p+0" => "+0", | |
58 | "0x0p+0L" => "+0", | |
8847214f UD |
59 | "minus_infty" => "-inf", |
60 | "plus_infty" => "inf", | |
67e971f1 | 61 | "qnan_value" => "qNaN", |
8847214f UD |
62 | ); |
63 | ||
64 | ||
65 | # get Options | |
66 | # Options: | |
67 | # u: ulps-file | |
68 | # h: help | |
69 | # o: output-directory | |
70 | # n: generate new ulps file | |
71 | use vars qw($opt_u $opt_h $opt_o $opt_n); | |
72 | getopts('u:o:nh'); | |
73 | ||
74 | $ulps_file = 'libm-test-ulps'; | |
75 | $output_dir = ''; | |
1c0d11bc | 76 | ($srcdir = $0) =~ s{[^/]*$}{}; |
8847214f UD |
77 | |
78 | if ($opt_h) { | |
f30e0cd3 | 79 | print "Usage: gen-libm-test.pl [OPTIONS]\n"; |
8847214f UD |
80 | print " -h print this help, then exit\n"; |
81 | print " -o DIR directory where generated files will be placed\n"; | |
a9b5d2ee | 82 | print " -n only generate sorted file NewUlps from libm-test-ulps\n"; |
8847214f UD |
83 | print " -u FILE input file with ulps\n"; |
84 | exit 0; | |
85 | } | |
86 | ||
87 | $ulps_file = $opt_u if ($opt_u); | |
88 | $output_dir = $opt_o if ($opt_o); | |
89 | ||
90 | $input = "libm-test.inc"; | |
1c0d11bc | 91 | $auto_input = "${srcdir}auto-libm-test-out"; |
8847214f UD |
92 | $output = "${output_dir}libm-test.c"; |
93 | ||
8847214f | 94 | &parse_ulps ($ulps_file); |
ffb536d0 | 95 | &parse_auto_input ($auto_input); |
a9b5d2ee UD |
96 | &generate_testfile ($input, $output) unless ($opt_n); |
97 | &output_ulps ("${output_dir}libm-test-ulps.h", $ulps_file) unless ($opt_n); | |
8847214f UD |
98 | &print_ulps_file ("${output_dir}NewUlps") if ($opt_n); |
99 | ||
100 | # Return a nicer representation | |
101 | sub beautify { | |
102 | my ($arg) = @_; | |
103 | my ($tmp); | |
104 | ||
105 | if (exists $beautify{$arg}) { | |
106 | return $beautify{$arg}; | |
107 | } | |
108 | if ($arg =~ /^-/) { | |
109 | $tmp = $arg; | |
110 | $tmp =~ s/^-//; | |
111 | if (exists $beautify{$tmp}) { | |
112 | return '-' . $beautify{$tmp}; | |
113 | } | |
114 | } | |
ffb536d0 JM |
115 | if ($arg =~ /^-?0x[0-9a-f.]*p[-+][0-9]+f$/) { |
116 | $arg =~ s/f$//; | |
117 | } | |
8847214f UD |
118 | if ($arg =~ /[0-9]L$/) { |
119 | $arg =~ s/L$//; | |
120 | } | |
121 | return $arg; | |
122 | } | |
123 | ||
124 | # Return a nicer representation of a complex number | |
125 | sub build_complex_beautify { | |
126 | my ($r, $i) = @_; | |
127 | my ($str1, $str2); | |
128 | ||
129 | $str1 = &beautify ($r); | |
130 | $str2 = &beautify ($i); | |
131 | if ($str2 =~ /^-/) { | |
132 | $str2 =~ s/^-//; | |
133 | $str1 .= ' - ' . $str2; | |
134 | } else { | |
135 | $str1 .= ' + ' . $str2; | |
136 | } | |
137 | $str1 .= ' i'; | |
138 | return $str1; | |
139 | } | |
140 | ||
3779b5b6 JM |
141 | # Return the text to put in an initializer for a test's exception |
142 | # information. | |
143 | sub show_exceptions { | |
5a28590a | 144 | my ($ignore_result, $non_finite, $exception) = @_; |
ee1466a9 | 145 | $ignore_result = ($ignore_result ? "IGNORE_RESULT|" : ""); |
5a28590a | 146 | $non_finite = ($non_finite ? "NON_FINITE|" : ""); |
3779b5b6 | 147 | if (defined $exception) { |
5a28590a | 148 | return ", ${ignore_result}${non_finite}$exception"; |
8847214f | 149 | } else { |
5a28590a | 150 | return ", ${ignore_result}${non_finite}0"; |
8847214f | 151 | } |
8847214f UD |
152 | } |
153 | ||
8847214f UD |
154 | # Parse the arguments to TEST_x_y |
155 | sub parse_args { | |
351fe550 JM |
156 | my ($file, $descr, $args) = @_; |
157 | my (@args, $descr_args, $descr_res, @descr); | |
215db402 | 158 | my ($current_arg, $cline, $cline_res, $i); |
f44bf14a | 159 | my (@special); |
351fe550 | 160 | my ($call_args); |
ee1466a9 | 161 | my ($ignore_result_any, $ignore_result_all); |
b29b6bb8 JM |
162 | my ($num_res, @args_res, @start_rm, $rm); |
163 | my (@plus_oflow, @minus_oflow, @plus_uflow, @minus_uflow); | |
8795b4a4 JM |
164 | my (@errno_plus_oflow, @errno_minus_oflow); |
165 | my (@errno_plus_uflow, @errno_minus_uflow); | |
5a28590a | 166 | my ($non_finite); |
8847214f | 167 | |
8847214f UD |
168 | ($descr_args, $descr_res) = split /_/,$descr, 2; |
169 | ||
170 | @args = split /,\s*/, $args; | |
171 | ||
351fe550 | 172 | $call_args = ""; |
8847214f UD |
173 | |
174 | # Generate first the string that's shown to the user | |
175 | $current_arg = 1; | |
8847214f UD |
176 | @descr = split //,$descr_args; |
177 | for ($i = 0; $i <= $#descr; $i++) { | |
f16cc3eb JM |
178 | my $comma = ""; |
179 | if ($current_arg > 1) { | |
180 | $comma = ', '; | |
8847214f UD |
181 | } |
182 | # FLOAT, int, long int, long long int | |
183 | if ($descr[$i] =~ /f|i|l|L/) { | |
351fe550 | 184 | $call_args .= $comma . &beautify ($args[$current_arg]); |
8847214f UD |
185 | ++$current_arg; |
186 | next; | |
187 | } | |
f16cc3eb | 188 | # &FLOAT, &int - simplify call by not showing argument. |
8847214f | 189 | if ($descr[$i] =~ /F|I/) { |
8847214f UD |
190 | next; |
191 | } | |
192 | # complex | |
193 | if ($descr[$i] eq 'c') { | |
351fe550 | 194 | $call_args .= $comma . &build_complex_beautify ($args[$current_arg], $args[$current_arg+1]); |
8847214f UD |
195 | $current_arg += 2; |
196 | next; | |
197 | } | |
198 | ||
199 | die ("$descr[$i] is unknown"); | |
200 | } | |
8847214f | 201 | |
fe559c5e | 202 | # Result |
9962a2d3 JM |
203 | @args_res = @args[$current_arg .. $#args]; |
204 | $num_res = 0; | |
8847214f UD |
205 | @descr = split //,$descr_res; |
206 | foreach (@descr) { | |
207 | if ($_ =~ /f|i|l|L/) { | |
9962a2d3 | 208 | ++$num_res; |
8847214f | 209 | } elsif ($_ eq 'c') { |
9962a2d3 | 210 | $num_res += 2; |
8847214f UD |
211 | } elsif ($_ eq 'b') { |
212 | # boolean | |
9962a2d3 | 213 | ++$num_res; |
8847214f | 214 | } elsif ($_ eq '1') { |
9962a2d3 | 215 | ++$num_res; |
8847214f UD |
216 | } else { |
217 | die ("$_ is unknown"); | |
218 | } | |
219 | } | |
220 | # consistency check | |
9962a2d3 JM |
221 | if ($#args_res == $num_res - 1) { |
222 | # One set of results for all rounding modes, no flags. | |
b29b6bb8 | 223 | @start_rm = ( 0, 0, 0, 0 ); |
9962a2d3 JM |
224 | } elsif ($#args_res == $num_res) { |
225 | # One set of results for all rounding modes, with flags. | |
8847214f | 226 | die ("wrong number of arguments") |
9962a2d3 | 227 | unless ($args_res[$#args_res] =~ /EXCEPTION|ERRNO|IGNORE_ZERO_INF_SIGN|TEST_NAN_SIGN|NO_TEST_INLINE|XFAIL_TEST/); |
b29b6bb8 | 228 | @start_rm = ( 0, 0, 0, 0 ); |
9962a2d3 JM |
229 | } elsif ($#args_res == 4 * $num_res + 3) { |
230 | # One set of results per rounding mode, with flags. | |
b29b6bb8 | 231 | @start_rm = ( 0, $num_res + 1, 2 * $num_res + 2, 3 * $num_res + 3 ); |
9962a2d3 | 232 | } else { |
8847214f UD |
233 | die ("wrong number of arguments"); |
234 | } | |
235 | ||
8847214f UD |
236 | # Put the C program line together |
237 | # Reset some variables to start again | |
238 | $current_arg = 1; | |
351fe550 | 239 | $cline = "{ \"$call_args\""; |
8847214f UD |
240 | @descr = split //,$descr_args; |
241 | for ($i=0; $i <= $#descr; $i++) { | |
8847214f UD |
242 | # FLOAT, int, long int, long long int |
243 | if ($descr[$i] =~ /f|i|l|L/) { | |
323e5cb7 | 244 | $cline .= ", $args[$current_arg]"; |
8847214f UD |
245 | $current_arg++; |
246 | next; | |
247 | } | |
248 | # &FLOAT, &int | |
249 | if ($descr[$i] =~ /F|I/) { | |
8847214f UD |
250 | next; |
251 | } | |
252 | # complex | |
253 | if ($descr[$i] eq 'c') { | |
323e5cb7 | 254 | $cline .= ", $args[$current_arg], $args[$current_arg+1]"; |
8847214f UD |
255 | $current_arg += 2; |
256 | next; | |
257 | } | |
258 | } | |
8847214f UD |
259 | |
260 | @descr = split //,$descr_res; | |
b29b6bb8 JM |
261 | @plus_oflow = qw(max_value plus_infty max_value plus_infty); |
262 | @minus_oflow = qw(minus_infty minus_infty -max_value -max_value); | |
263 | @plus_uflow = qw(plus_zero plus_zero plus_zero min_subnorm_value); | |
264 | @minus_uflow = qw(-min_subnorm_value minus_zero minus_zero minus_zero); | |
8795b4a4 JM |
265 | @errno_plus_oflow = qw(0 ERRNO_ERANGE 0 ERRNO_ERANGE); |
266 | @errno_minus_oflow = qw(ERRNO_ERANGE ERRNO_ERANGE 0 0); | |
267 | @errno_plus_uflow = qw(ERRNO_ERANGE ERRNO_ERANGE ERRNO_ERANGE 0); | |
268 | @errno_minus_uflow = qw(0 ERRNO_ERANGE ERRNO_ERANGE ERRNO_ERANGE); | |
b29b6bb8 JM |
269 | for ($rm = 0; $rm <= 3; $rm++) { |
270 | $current_arg = $start_rm[$rm]; | |
9962a2d3 JM |
271 | $ignore_result_any = 0; |
272 | $ignore_result_all = 1; | |
273 | $cline_res = ""; | |
274 | @special = (); | |
275 | foreach (@descr) { | |
276 | if ($_ =~ /b|f|i|l|L/ ) { | |
277 | my ($result) = $args_res[$current_arg]; | |
278 | if ($result eq "IGNORE") { | |
279 | $ignore_result_any = 1; | |
280 | $result = "0"; | |
281 | } else { | |
282 | $ignore_result_all = 0; | |
283 | } | |
284 | $cline_res .= ", $result"; | |
285 | $current_arg++; | |
286 | } elsif ($_ eq 'c') { | |
287 | my ($result1) = $args_res[$current_arg]; | |
288 | if ($result1 eq "IGNORE") { | |
289 | $ignore_result_any = 1; | |
290 | $result1 = "0"; | |
291 | } else { | |
292 | $ignore_result_all = 0; | |
293 | } | |
294 | my ($result2) = $args_res[$current_arg + 1]; | |
295 | if ($result2 eq "IGNORE") { | |
296 | $ignore_result_any = 1; | |
297 | $result2 = "0"; | |
298 | } else { | |
299 | $ignore_result_all = 0; | |
300 | } | |
301 | $cline_res .= ", $result1, $result2"; | |
302 | $current_arg += 2; | |
303 | } elsif ($_ eq '1') { | |
304 | push @special, $args_res[$current_arg]; | |
305 | ++$current_arg; | |
ee1466a9 | 306 | } |
8847214f | 307 | } |
9962a2d3 JM |
308 | if ($ignore_result_any && !$ignore_result_all) { |
309 | die ("some but not all function results ignored\n"); | |
310 | } | |
5a28590a JM |
311 | # Determine whether any arguments or results, for any rounding |
312 | # mode, are non-finite. | |
313 | $non_finite = ($args =~ /qnan_value|plus_infty|minus_infty/); | |
9962a2d3 JM |
314 | # Add exceptions. |
315 | $cline_res .= show_exceptions ($ignore_result_any, | |
5a28590a | 316 | $non_finite, |
9962a2d3 JM |
317 | ($current_arg <= $#args_res) |
318 | ? $args_res[$current_arg] | |
319 | : undef); | |
320 | ||
321 | # special treatment for some functions | |
322 | $i = 0; | |
323 | foreach (@special) { | |
324 | ++$i; | |
325 | my ($extra_expected) = $_; | |
326 | my ($run_extra) = ($extra_expected ne "IGNORE" ? 1 : 0); | |
327 | if (!$run_extra) { | |
328 | $extra_expected = "0"; | |
329 | } | |
330 | $cline_res .= ", $run_extra, $extra_expected"; | |
8847214f | 331 | } |
9962a2d3 | 332 | $cline_res =~ s/^, //; |
b29b6bb8 JM |
333 | $cline_res =~ s/plus_oflow/$plus_oflow[$rm]/g; |
334 | $cline_res =~ s/minus_oflow/$minus_oflow[$rm]/g; | |
335 | $cline_res =~ s/plus_uflow/$plus_uflow[$rm]/g; | |
336 | $cline_res =~ s/minus_uflow/$minus_uflow[$rm]/g; | |
8795b4a4 JM |
337 | $cline_res =~ s/ERRNO_PLUS_OFLOW/$errno_plus_oflow[$rm]/g; |
338 | $cline_res =~ s/ERRNO_MINUS_OFLOW/$errno_minus_oflow[$rm]/g; | |
339 | $cline_res =~ s/ERRNO_PLUS_UFLOW/$errno_plus_uflow[$rm]/g; | |
340 | $cline_res =~ s/ERRNO_MINUS_UFLOW/$errno_minus_uflow[$rm]/g; | |
9962a2d3 | 341 | $cline .= ", { $cline_res }"; |
8847214f | 342 | } |
323e5cb7 | 343 | print $file " $cline },\n"; |
8847214f UD |
344 | } |
345 | ||
ffb536d0 JM |
346 | # Convert a condition from auto-libm-test-out to C form. |
347 | sub convert_condition { | |
348 | my ($cond) = @_; | |
349 | my (@conds, $ret); | |
350 | @conds = split /:/, $cond; | |
351 | foreach (@conds) { | |
352 | s/-/_/g; | |
353 | s/^/TEST_COND_/; | |
354 | } | |
355 | $ret = join " && ", @conds; | |
356 | return "($ret)"; | |
357 | } | |
358 | ||
359 | # Return text to OR a value into an accumulated flags string. | |
360 | sub or_value { | |
361 | my ($cond) = @_; | |
362 | if ($cond eq "0") { | |
363 | return ""; | |
364 | } else { | |
365 | return " | $cond"; | |
366 | } | |
367 | } | |
368 | ||
aa97dee1 JM |
369 | # Return a conditional expression between two values. |
370 | sub cond_value { | |
ffb536d0 JM |
371 | my ($cond, $if, $else) = @_; |
372 | if ($cond eq "1") { | |
aa97dee1 | 373 | return $if; |
ffb536d0 | 374 | } elsif ($cond eq "0") { |
aa97dee1 | 375 | return $else; |
ffb536d0 | 376 | } else { |
aa97dee1 | 377 | return "($cond ? $if : $else)"; |
ffb536d0 JM |
378 | } |
379 | } | |
380 | ||
aa97dee1 JM |
381 | # Return text to OR a conditional expression between two values into |
382 | # an accumulated flags string. | |
383 | sub or_cond_value { | |
384 | my ($cond, $if, $else) = @_; | |
385 | return or_value (cond_value ($cond, $if, $else)); | |
386 | } | |
387 | ||
8847214f UD |
388 | # Generate libm-test.c |
389 | sub generate_testfile { | |
390 | my ($input, $output) = @_; | |
8847214f UD |
391 | |
392 | open INPUT, $input or die ("Can't open $input: $!"); | |
393 | open OUTPUT, ">$output" or die ("Can't open $output: $!"); | |
394 | ||
395 | # Replace the special macros | |
396 | while (<INPUT>) { | |
ae3a5dff | 397 | # AUTO_TESTS (function), |
ffb536d0 | 398 | if (/^\s*AUTO_TESTS_/) { |
ae3a5dff JM |
399 | my ($descr, $func, @modes, $auto_test, $num_auto_tests); |
400 | my (@rm_tests, $rm, $i); | |
401 | @modes = qw(downward tonearest towardzero upward); | |
402 | ($descr, $func) = ($_ =~ /AUTO_TESTS_(\w+)\s*\((\w+)\)/); | |
403 | for ($rm = 0; $rm <= 3; $rm++) { | |
404 | $rm_tests[$rm] = [sort keys %{$auto_tests{$func}{$modes[$rm]}}]; | |
405 | } | |
406 | $num_auto_tests = scalar @{$rm_tests[0]}; | |
407 | for ($rm = 1; $rm <= 3; $rm++) { | |
408 | if ($num_auto_tests != scalar @{$rm_tests[$rm]}) { | |
409 | die ("inconsistent numbers of tests for $func\n"); | |
410 | } | |
411 | for ($i = 0; $i < $num_auto_tests; $i++) { | |
412 | if ($rm_tests[0][$i] ne $rm_tests[$rm][$i]) { | |
413 | die ("inconsistent list of tests of $func\n"); | |
414 | } | |
415 | } | |
416 | } | |
417 | if ($num_auto_tests == 0) { | |
418 | die ("no automatic tests for $func\n"); | |
419 | } | |
420 | foreach $auto_test (@{$rm_tests[0]}) { | |
421 | my ($format, $inputs, $format_conv, $args_str); | |
422 | ($format, $inputs) = split / /, $auto_test, 2; | |
ffb536d0 | 423 | $inputs =~ s/ /, /g; |
ffb536d0 JM |
424 | $format_conv = convert_condition ($format); |
425 | print OUTPUT "#if $format_conv\n"; | |
ae3a5dff JM |
426 | $args_str = "$func, $inputs"; |
427 | for ($rm = 0; $rm <= 3; $rm++) { | |
428 | my ($auto_test_out, $outputs, $flags); | |
429 | my ($flags_conv, @flags, %flag_cond); | |
430 | $auto_test_out = $auto_tests{$func}{$modes[$rm]}{$auto_test}; | |
431 | ($outputs, $flags) = split / : */, $auto_test_out; | |
432 | $outputs =~ s/ /, /g; | |
433 | @flags = split / /, $flags; | |
434 | foreach (@flags) { | |
435 | if (/^([^:]*):(.*)$/) { | |
436 | my ($flag, $cond); | |
437 | $flag = $1; | |
438 | $cond = convert_condition ($2); | |
439 | if (defined ($flag_cond{$flag})) { | |
440 | if ($flag_cond{$flag} ne "1") { | |
441 | $flag_cond{$flag} .= " || $cond"; | |
442 | } | |
443 | } else { | |
444 | $flag_cond{$flag} = $cond; | |
ffb536d0 JM |
445 | } |
446 | } else { | |
ae3a5dff | 447 | $flag_cond{$_} = "1"; |
ffb536d0 | 448 | } |
ffb536d0 | 449 | } |
ae3a5dff | 450 | $flags_conv = ""; |
863893ec JM |
451 | if (defined ($flag_cond{"ignore-zero-inf-sign"})) { |
452 | $flags_conv .= or_cond_value ($flag_cond{"ignore-zero-inf-sign"}, | |
453 | "IGNORE_ZERO_INF_SIGN", "0"); | |
454 | } | |
ae3a5dff JM |
455 | if (defined ($flag_cond{"no-test-inline"})) { |
456 | $flags_conv .= or_cond_value ($flag_cond{"no-test-inline"}, | |
457 | "NO_TEST_INLINE", "0"); | |
aa97dee1 | 458 | } |
ae3a5dff JM |
459 | if (defined ($flag_cond{"xfail"})) { |
460 | $flags_conv .= or_cond_value ($flag_cond{"xfail"}, | |
461 | "XFAIL_TEST", "0"); | |
ffb536d0 | 462 | } |
ae3a5dff JM |
463 | my (@exc_list) = qw(divbyzero inexact invalid overflow underflow); |
464 | my ($exc); | |
465 | foreach $exc (@exc_list) { | |
466 | my ($exc_expected, $exc_ok, $no_exc, $exc_cond, $exc_ok_cond); | |
467 | $exc_expected = "\U$exc\E_EXCEPTION"; | |
468 | $exc_ok = "\U$exc\E_EXCEPTION_OK"; | |
469 | $no_exc = "0"; | |
470 | if ($exc eq "inexact") { | |
471 | $exc_ok = "0"; | |
472 | $no_exc = "NO_INEXACT_EXCEPTION"; | |
473 | } | |
474 | if (defined ($flag_cond{$exc})) { | |
475 | $exc_cond = $flag_cond{$exc}; | |
476 | } else { | |
477 | $exc_cond = "0"; | |
478 | } | |
479 | if (defined ($flag_cond{"$exc-ok"})) { | |
480 | $exc_ok_cond = $flag_cond{"$exc-ok"}; | |
481 | } else { | |
482 | $exc_ok_cond = "0"; | |
483 | } | |
484 | $flags_conv .= or_cond_value ($exc_cond, | |
485 | cond_value ($exc_ok_cond, | |
486 | $exc_ok, $exc_expected), | |
487 | cond_value ($exc_ok_cond, | |
488 | $exc_ok, $no_exc)); | |
ffb536d0 | 489 | } |
ae3a5dff JM |
490 | my ($errno_expected, $errno_unknown_cond); |
491 | if (defined ($flag_cond{"errno-edom"})) { | |
492 | if ($flag_cond{"errno-edom"} ne "1") { | |
493 | die ("unexpected condition for errno-edom"); | |
494 | } | |
495 | if (defined ($flag_cond{"errno-erange"})) { | |
496 | die ("multiple errno values expected"); | |
497 | } | |
498 | $errno_expected = "ERRNO_EDOM"; | |
499 | } elsif (defined ($flag_cond{"errno-erange"})) { | |
500 | if ($flag_cond{"errno-erange"} ne "1") { | |
501 | die ("unexpected condition for errno-erange"); | |
502 | } | |
503 | $errno_expected = "ERRNO_ERANGE"; | |
504 | } else { | |
505 | $errno_expected = "ERRNO_UNCHANGED"; | |
ffb536d0 | 506 | } |
ae3a5dff JM |
507 | if (defined ($flag_cond{"errno-edom-ok"})) { |
508 | if (defined ($flag_cond{"errno-erange-ok"}) | |
509 | && ($flag_cond{"errno-erange-ok"} | |
510 | ne $flag_cond{"errno-edom-ok"})) { | |
511 | $errno_unknown_cond = "($flag_cond{\"errno-edom-ok\"} || $flag_cond{\"errno-erange-ok\"})"; | |
512 | } else { | |
513 | $errno_unknown_cond = $flag_cond{"errno-edom-ok"}; | |
514 | } | |
515 | } elsif (defined ($flag_cond{"errno-erange-ok"})) { | |
516 | $errno_unknown_cond = $flag_cond{"errno-erange-ok"}; | |
517 | } else { | |
518 | $errno_unknown_cond = "0"; | |
ffb536d0 | 519 | } |
ae3a5dff JM |
520 | $flags_conv .= or_cond_value ($errno_unknown_cond, |
521 | "0", $errno_expected); | |
522 | if ($flags_conv eq "") { | |
523 | $flags_conv = ", NO_EXCEPTION"; | |
ffb536d0 | 524 | } else { |
ae3a5dff | 525 | $flags_conv =~ s/^ \|/,/; |
ffb536d0 | 526 | } |
ae3a5dff | 527 | $args_str .= ", $outputs$flags_conv"; |
ffb536d0 | 528 | } |
ae3a5dff | 529 | &parse_args (\*OUTPUT, $descr, $args_str); |
ffb536d0 JM |
530 | print OUTPUT "#endif\n"; |
531 | } | |
ffb536d0 JM |
532 | next; |
533 | } | |
8847214f UD |
534 | |
535 | # TEST_... | |
536 | if (/^\s*TEST_/) { | |
537 | my ($descr, $args); | |
538 | chop; | |
539 | ($descr, $args) = ($_ =~ /TEST_(\w+)\s*\((.*)\)/); | |
351fe550 | 540 | &parse_args (\*OUTPUT, $descr, $args); |
51df539d JM |
541 | next; |
542 | } | |
8847214f UD |
543 | print OUTPUT; |
544 | } | |
545 | close INPUT; | |
546 | close OUTPUT; | |
547 | } | |
548 | ||
549 | ||
550 | ||
551 | # Parse ulps file | |
552 | sub parse_ulps { | |
553 | my ($file) = @_; | |
e6b6a857 | 554 | my ($test, $type, $float, $eps); |
8847214f | 555 | |
6815fabc UD |
556 | # $type has the following values: |
557 | # "normal": No complex variable | |
558 | # "real": Real part of complex result | |
559 | # "imag": Imaginary part of complex result | |
8847214f UD |
560 | open ULP, $file or die ("Can't open $file: $!"); |
561 | while (<ULP>) { | |
562 | chop; | |
563 | # ignore comments and empty lines | |
564 | next if /^#/; | |
565 | next if /^\s*$/; | |
6815fabc | 566 | if (/^Function: /) { |
03965c71 | 567 | if (/Real part of/) { |
6815fabc UD |
568 | s/Real part of //; |
569 | $type = 'real'; | |
570 | } elsif (/Imaginary part of/) { | |
571 | s/Imaginary part of //; | |
572 | $type = 'imag'; | |
573 | } else { | |
574 | $type = 'normal'; | |
575 | } | |
576 | ($test) = ($_ =~ /^Function:\s*\"([a-zA-Z0-9_]+)\"/); | |
8847214f UD |
577 | next; |
578 | } | |
579 | if (/^i?(float|double|ldouble):/) { | |
6815fabc | 580 | ($float, $eps) = split /\s*:\s*/,$_,2; |
3a8e65a0 | 581 | |
b7dab1e4 | 582 | if ($eps eq "0") { |
3a8e65a0 UD |
583 | # ignore |
584 | next; | |
8847214f | 585 | } else { |
6815fabc UD |
586 | $results{$test}{$type}{'ulp'}{$float} = $eps; |
587 | $results{$test}{'has_ulps'} = 1; | |
8847214f | 588 | } |
3a8e65a0 UD |
589 | if ($type =~ /^real|imag$/) { |
590 | $results{$test}{'type'} = 'complex'; | |
591 | } elsif ($type eq 'normal') { | |
592 | $results{$test}{'type'} = 'normal'; | |
593 | } | |
8847214f UD |
594 | next; |
595 | } | |
596 | print "Skipping unknown entry: `$_'\n"; | |
597 | } | |
598 | close ULP; | |
599 | } | |
600 | ||
8847214f UD |
601 | |
602 | # Clean up a floating point number | |
603 | sub clean_up_number { | |
604 | my ($number) = @_; | |
fe559c5e | 605 | |
f99ed760 UD |
606 | # Remove trailing zeros after the decimal point |
607 | if ($number =~ /\./) { | |
608 | $number =~ s/0+$//; | |
609 | $number =~ s/\.$//; | |
610 | } | |
8847214f UD |
611 | return $number; |
612 | } | |
613 | ||
614 | # Output a file which can be read in as ulps file. | |
615 | sub print_ulps_file { | |
616 | my ($file) = @_; | |
6815fabc | 617 | my ($test, $type, $float, $eps, $fct, $last_fct); |
8847214f UD |
618 | |
619 | $last_fct = ''; | |
620 | open NEWULP, ">$file" or die ("Can't open $file: $!"); | |
621 | print NEWULP "# Begin of automatic generation\n"; | |
8847214f UD |
622 | print NEWULP "\n# Maximal error of functions:\n"; |
623 | ||
a9b5d2ee | 624 | foreach $fct (sort keys %results) { |
6815fabc UD |
625 | foreach $type ('real', 'imag', 'normal') { |
626 | if (exists $results{$fct}{$type}) { | |
627 | if ($type eq 'normal') { | |
628 | print NEWULP "Function: \"$fct\":\n"; | |
629 | } elsif ($type eq 'real') { | |
630 | print NEWULP "Function: Real part of \"$fct\":\n"; | |
631 | } elsif ($type eq 'imag') { | |
632 | print NEWULP "Function: Imaginary part of \"$fct\":\n"; | |
633 | } | |
634 | foreach $float (@all_floats) { | |
635 | if (exists $results{$fct}{$type}{'ulp'}{$float}) { | |
3a8e65a0 UD |
636 | print NEWULP "$float: ", |
637 | &clean_up_number ($results{$fct}{$type}{'ulp'}{$float}), | |
6815fabc UD |
638 | "\n"; |
639 | } | |
6815fabc UD |
640 | } |
641 | print NEWULP "\n"; | |
8847214f | 642 | } |
8847214f UD |
643 | } |
644 | } | |
645 | print NEWULP "# end of automatic generation\n"; | |
646 | close NEWULP; | |
647 | } | |
648 | ||
649 | sub get_ulps { | |
6815fabc UD |
650 | my ($test, $type, $float) = @_; |
651 | ||
3779b5b6 JM |
652 | return (exists $results{$test}{$type}{'ulp'}{$float} |
653 | ? $results{$test}{$type}{'ulp'}{$float} : "0"); | |
8847214f UD |
654 | } |
655 | ||
3779b5b6 JM |
656 | # Return the ulps value for a single test. |
657 | sub get_all_ulps_for_test { | |
658 | my ($test, $type) = @_; | |
8847214f UD |
659 | my ($ldouble, $double, $float, $ildouble, $idouble, $ifloat); |
660 | ||
6815fabc UD |
661 | if (exists $results{$test}{'has_ulps'}) { |
662 | # XXX use all_floats (change order!) | |
663 | $ldouble = &get_ulps ($test, $type, "ldouble"); | |
664 | $double = &get_ulps ($test, $type, "double"); | |
665 | $float = &get_ulps ($test, $type, "float"); | |
666 | $ildouble = &get_ulps ($test, $type, "ildouble"); | |
667 | $idouble = &get_ulps ($test, $type, "idouble"); | |
668 | $ifloat = &get_ulps ($test, $type, "ifloat"); | |
3779b5b6 JM |
669 | return "CHOOSE ($ldouble, $double, $float, $ildouble, $idouble, $ifloat)"; |
670 | } else { | |
671 | die "get_all_ulps_for_test called for \"$test\" with no ulps\n"; | |
8847214f | 672 | } |
8847214f UD |
673 | } |
674 | ||
675 | # Print include file | |
676 | sub output_ulps { | |
fe559c5e | 677 | my ($file, $ulps_filename) = @_; |
3779b5b6 | 678 | my ($i, $fct, $type, $ulp, $ulp_real, $ulp_imag); |
e6b6a857 | 679 | my (%func_ulps, %func_real_ulps, %func_imag_ulps); |
8847214f UD |
680 | |
681 | open ULP, ">$file" or die ("Can't open $file: $!"); | |
682 | ||
fe559c5e UD |
683 | print ULP "/* This file is automatically generated\n"; |
684 | print ULP " from $ulps_filename with gen-libm-test.pl.\n"; | |
8847214f UD |
685 | print ULP " Don't change it - change instead the master files. */\n\n"; |
686 | ||
3779b5b6 JM |
687 | foreach $fct (keys %results) { |
688 | $type = $results{$fct}{'type'}; | |
689 | if ($type eq 'normal') { | |
690 | $ulp = get_all_ulps_for_test ($fct, 'normal'); | |
691 | } elsif ($type eq 'complex') { | |
692 | $ulp_real = get_all_ulps_for_test ($fct, 'real'); | |
693 | $ulp_imag = get_all_ulps_for_test ($fct, 'imag'); | |
694 | } else { | |
695 | die "unknown results ($fct) type $type\n"; | |
696 | } | |
e6b6a857 JM |
697 | if ($type eq 'normal') { |
698 | $func_ulps{$fct} = $ulp; | |
3779b5b6 | 699 | } else { |
e6b6a857 JM |
700 | $func_real_ulps{$fct} = $ulp_real; |
701 | $func_imag_ulps{$fct} = $ulp_imag; | |
3779b5b6 JM |
702 | } |
703 | } | |
fe559c5e | 704 | print ULP "\n/* Maximal error of functions. */\n"; |
3779b5b6 JM |
705 | print ULP "static const struct ulp_data func_ulps[] =\n {\n"; |
706 | foreach $fct (sort keys %func_ulps) { | |
707 | print ULP " { \"$fct\", $func_ulps{$fct} },\n"; | |
708 | } | |
709 | print ULP " };\n"; | |
710 | print ULP "static const struct ulp_data func_real_ulps[] =\n {\n"; | |
711 | foreach $fct (sort keys %func_real_ulps) { | |
712 | print ULP " { \"$fct\", $func_real_ulps{$fct} },\n"; | |
713 | } | |
714 | print ULP " };\n"; | |
715 | print ULP "static const struct ulp_data func_imag_ulps[] =\n {\n"; | |
716 | foreach $fct (sort keys %func_imag_ulps) { | |
717 | print ULP " { \"$fct\", $func_imag_ulps{$fct} },\n"; | |
8847214f | 718 | } |
3779b5b6 | 719 | print ULP " };\n"; |
8847214f UD |
720 | close ULP; |
721 | } | |
ffb536d0 JM |
722 | |
723 | # Parse auto-libm-test-out. | |
724 | sub parse_auto_input { | |
725 | my ($file) = @_; | |
726 | open AUTO, $file or die ("Can't open $file: $!"); | |
727 | while (<AUTO>) { | |
728 | chop; | |
729 | next if !/^= /; | |
730 | s/^= //; | |
ae3a5dff JM |
731 | if (/^(\S+) (\S+) ([^:]*) : (.*)$/) { |
732 | $auto_tests{$1}{$2}{$3} = $4; | |
ffb536d0 JM |
733 | } else { |
734 | die ("bad automatic test line: $_\n"); | |
735 | } | |
736 | } | |
737 | close AUTO; | |
738 | } |