From 3384c45e66ddf18f235654b67ae34ac7dcb07534 Mon Sep 17 00:00:00 2001 From: Waldemar Brodkorb Date: Thu, 3 Nov 2016 13:03:55 +0100 Subject: math: sync with GNU libc The format of the ULPS files have changed, non-glibc architecture files needs to be updated later. Add all math tests from latest GNU libc and allow to compile and run them on uClibc-ng and GNU libc systems. --- test/math/gen-libm-test.pl | 857 ++++++++++++++++++++++++--------------------- 1 file changed, 462 insertions(+), 395 deletions(-) (limited to 'test/math/gen-libm-test.pl') diff --git a/test/math/gen-libm-test.pl b/test/math/gen-libm-test.pl index 118f352..fc56eb8 100755 --- a/test/math/gen-libm-test.pl +++ b/test/math/gen-libm-test.pl @@ -1,5 +1,5 @@ -#!/usr/bin/env perl -# Copyright (C) 1999 Free Software Foundation, Inc. +#!/usr/bin/env perl -w +# Copyright (C) 1999-2016 Free Software Foundation, Inc. # This file is part of the GNU C Library. # Contributed by Andreas Jaeger , 1999. @@ -14,18 +14,15 @@ # Lesser General Public License for more details. # You should have received a copy of the GNU Lesser General Public -# License along with the GNU C Library; see the file COPYING.LIB. If -# not, see . +# License along with the GNU C Library; if not, see +# . # This file needs to be tidied up # Note that functions and tests share the same namespace. # Information about tests are stored in: %results -# $results{$test}{"kind"} is either "fct" or "test" and flags whether this -# is a maximal error of a function or a single test. # $results{$test}{"type"} is the result type, e.g. normal or complex. # $results{$test}{"has_ulps"} is set if deltas exist. -# $results{$test}{"has_fails"} is set if exptected failures exist. # In the following description $type and $float are: # - $type is either "normal", "real" (for the real part of a complex number) # or "imag" (for the imaginary part # of a complex number). @@ -33,8 +30,6 @@ # It represents the underlying floating point type (float, double or long # double) and if inline functions (the leading i stands for inline) # are used. -# $results{$test}{$type}{"fail"}{$float} is defined and has a 1 if -# the test is expected to fail # $results{$test}{$type}{"ulp"}{$float} is defined and has a delta as value @@ -42,47 +37,37 @@ use Getopt::Std; use strict; -use vars qw ($input $output); +use vars qw ($input $output $auto_input); use vars qw (%results); -use vars qw (@tests @functions); -use vars qw ($count); -use vars qw (%beautify @all_floats); -use vars qw ($output_dir $ulps_file); +use vars qw (%beautify @all_floats %all_floats_pfx); +use vars qw ($output_dir $ulps_file $srcdir); +use vars qw (%auto_tests); # all_floats is sorted and contains all recognised float types @all_floats = ('double', 'float', 'idouble', 'ifloat', 'ildouble', 'ldouble'); +# all_floats_pfx maps C types to their C like prefix for macros. +%all_floats_pfx = + ( "double" => "DBL", + "ldouble" => "LDBL", + "float" => "FLT", + ); + %beautify = ( "minus_zero" => "-0", "plus_zero" => "+0", + "-0x0p+0f" => "-0", + "-0x0p+0" => "-0", + "-0x0p+0L" => "-0", + "0x0p+0f" => "+0", + "0x0p+0" => "+0", + "0x0p+0L" => "+0", "minus_infty" => "-inf", "plus_infty" => "inf", - "nan_value" => "NaN", - "M_El" => "e", - "M_E2l" => "e^2", - "M_E3l" => "e^3", - "M_LOG10El", "log10(e)", - "M_PIl" => "pi", - "M_PI_34l" => "3/4 pi", - "M_PI_2l" => "pi/2", - "M_PI_4l" => "pi/4", - "M_PI_6l" => "pi/6", - "M_PI_34_LOG10El" => "3/4 pi*log10(e)", - "M_PI_LOG10El" => "pi*log10(e)", - "M_PI2_LOG10El" => "pi/2*log10(e)", - "M_PI4_LOG10El" => "pi/4*log10(e)", - "M_LOG_SQRT_PIl" => "log(sqrt(pi))", - "M_LOG_2_SQRT_PIl" => "log(2*sqrt(pi))", - "M_2_SQRT_PIl" => "2 sqrt (pi)", - "M_SQRT_PIl" => "sqrt (pi)", - "INVALID_EXCEPTION" => "invalid exception", - "DIVIDE_BY_ZERO_EXCEPTION" => "division by zero exception", - "INVALID_EXCEPTION_OK" => "invalid exception allowed", - "DIVIDE_BY_ZERO_EXCEPTION_OK" => "division by zero exception allowed", - "EXCEPTIONS_OK" => "exceptions allowed", - "IGNORE_ZERO_INF_SIGN" => "sign of zero/inf not specified", -"INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN" => "invalid exception and sign of zero/inf not specified" + "qnan_value" => "qNaN", + "snan_value" => "sNaN", + "snan_value_ld" => "sNaN", ); @@ -97,6 +82,7 @@ getopts('u:o:nh'); $ulps_file = 'libm-test-ulps'; $output_dir = ''; +($srcdir = $0) =~ s{[^/]*$}{}; if ($opt_h) { print "Usage: gen-libm-test.pl [OPTIONS]\n"; @@ -111,11 +97,11 @@ $ulps_file = $opt_u if ($opt_u); $output_dir = $opt_o if ($opt_o); $input = "libm-test.inc"; +$auto_input = "${srcdir}auto-libm-test-out"; $output = "${output_dir}libm-test.c"; -$count = 0; - &parse_ulps ($ulps_file); +&parse_auto_input ($auto_input); &generate_testfile ($input, $output) unless ($opt_n); &output_ulps ("${output_dir}libm-test-ulps.h", $ulps_file) unless ($opt_n); &print_ulps_file ("${output_dir}NewUlps") if ($opt_n); @@ -135,6 +121,9 @@ sub beautify { return '-' . $beautify{$tmp}; } } + if ($arg =~ /^-?0x[0-9a-f.]*p[-+][0-9]+f$/) { + $arg =~ s/f$//; + } if ($arg =~ /[0-9]L$/) { $arg =~ s/L$//; } @@ -158,277 +147,433 @@ sub build_complex_beautify { return $str1; } -# Return name of a variable -sub get_variable { - my ($number) = @_; - - return "x" if ($number == 1); - return "y" if ($number == 2); - return "z" if ($number == 3); - # return x1,x2,... - $number =-3; - return "x$number"; -} - -# Add a new test to internal data structures and fill in the -# ulps, failures and exception information for the C line. -sub new_test { - my ($test, $exception) = @_; - my $rest; - - # Add ulp, xfail - if (exists $results{$test}{'has_ulps'}) { - $rest = ", DELTA$count"; - } else { - $rest = ', 0'; - } - if (exists $results{$test}{'has_fails'}) { - $rest .= ", FAIL$count"; - } else { - $rest .= ', 0'; - } +# Return the text to put in an initializer for a test's exception +# information. +sub show_exceptions { + my ($ignore_result, $non_finite, $test_snan, $exception) = @_; + $ignore_result = ($ignore_result ? "IGNORE_RESULT|" : ""); + $non_finite = ($non_finite ? "NON_FINITE|" : ""); + $test_snan = ($test_snan ? "TEST_SNAN|" : ""); if (defined $exception) { - $rest .= ", $exception"; + return ", ${ignore_result}${non_finite}${test_snan}$exception"; } else { - $rest .= ', 0'; + return ", ${ignore_result}${non_finite}${test_snan}0"; } - $rest .= ");\n"; - # We must increment here to keep @tests and count in sync - push @tests, $test; - ++$count; - return $rest; } -# Treat some functions especially. -# Currently only sincos needs extra treatment. -sub special_functions { - my ($file, $args) = @_; - my (@args, $str, $test, $cline); - - @args = split /,\s*/, $args; - - unless ($args[0] =~ /sincos/) { - die ("Don't know how to handle $args[0] extra."); - } - print $file " FUNC (sincos) ($args[1], &sin_res, &cos_res);\n"; - - $str = 'sincos (' . &beautify ($args[1]) . ', &sin_res, &cos_res)'; - # handle sin - $test = $str . ' puts ' . &beautify ($args[2]) . ' in sin_res'; - if ($#args == 4) { - $test .= " plus " . &beautify ($args[4]); - } - - $cline = " check_float (\"$test\", sin_res, $args[2]"; - $cline .= &new_test ($test, $args[4]); - print $file $cline; - - # handle cos - $test = $str . ' puts ' . &beautify ($args[3]) . ' in cos_res'; - $cline = " check_float (\"$test\", cos_res, $args[3]"; - # only tests once for exception - $cline .= &new_test ($test, undef); - print $file $cline; +# Apply the LIT(x) macro to a literal floating point constant +# and strip any existing suffix. +sub apply_lit { + my ($lit) = @_; + my $exp_re = "([+-])?[[:digit:]]+"; + # Don't wrap something that does not look like a: + # * Hexadecimal FP value + # * Decimal FP value without a decimal point + # * Decimal value with a fraction + return $lit if $lit !~ /([+-])?0x[[:xdigit:]\.]+[pP]$exp_re/ + and $lit !~ /[[:digit:]]+[eE]$exp_re/ + and $lit !~ /[[:digit:]]*\.[[:digit:]]*([eE]$exp_re)?/; + + # Strip any existing literal suffix. + $lit =~ s/[lLfF]$//; + + return "LIT (${lit})"; } # Parse the arguments to TEST_x_y sub parse_args { my ($file, $descr, $args) = @_; - my (@args, $str, $descr_args, $descr_res, @descr); - my ($current_arg, $cline, $i); - my ($pre, $post, @special); - my ($extra_var, $call, $c_call); - - if ($descr eq 'extra') { - &special_functions ($file, $args); - return; - } + my (@args, $descr_args, $descr_res, @descr); + my ($current_arg, $cline, $cline_res, $i); + my (@special); + my ($call_args); + my ($ignore_result_any, $ignore_result_all); + my ($num_res, @args_res, @start_rm, $rm); + my (@plus_oflow, @minus_oflow, @plus_uflow, @minus_uflow); + my (@errno_plus_oflow, @errno_minus_oflow); + my (@errno_plus_uflow, @errno_minus_uflow); + my ($non_finite, $test_snan); + ($descr_args, $descr_res) = split /_/,$descr, 2; @args = split /,\s*/, $args; - $call = "$args[0] ("; + $call_args = ""; # Generate first the string that's shown to the user $current_arg = 1; - $extra_var = 0; @descr = split //,$descr_args; for ($i = 0; $i <= $#descr; $i++) { - if ($i >= 1) { - $call .= ', '; + my $comma = ""; + if ($current_arg > 1) { + $comma = ', '; } # FLOAT, int, long int, long long int - if ($descr[$i] =~ /f|i|l|L/) { - $call .= &beautify ($args[$current_arg]); + if ($descr[$i] =~ /f|j|i|l|L/) { + $call_args .= $comma . &beautify ($args[$current_arg]); ++$current_arg; next; } - # &FLOAT, &int - argument is added here + # &FLOAT, &int - simplify call by not showing argument. if ($descr[$i] =~ /F|I/) { - ++$extra_var; - $call .= '&' . &get_variable ($extra_var); next; } # complex if ($descr[$i] eq 'c') { - $call .= &build_complex_beautify ($args[$current_arg], $args[$current_arg+1]); + $call_args .= $comma . &build_complex_beautify ($args[$current_arg], $args[$current_arg+1]); $current_arg += 2; next; } die ("$descr[$i] is unknown"); } - $call .= ')'; - $str = "$call == "; # Result + @args_res = @args[$current_arg .. $#args]; + $num_res = 0; @descr = split //,$descr_res; foreach (@descr) { if ($_ =~ /f|i|l|L/) { - $str .= &beautify ($args[$current_arg]); - ++$current_arg; + ++$num_res; } elsif ($_ eq 'c') { - $str .= &build_complex_beautify ($args[$current_arg], $args[$current_arg+1]); - $current_arg += 2; + $num_res += 2; } elsif ($_ eq 'b') { # boolean - $str .= ($args[$current_arg] == 0) ? "false" : "true"; - ++$current_arg; + ++$num_res; } elsif ($_ eq '1') { - ++$current_arg; + ++$num_res; } else { die ("$_ is unknown"); } } # consistency check - if ($current_arg == $#args) { + if ($#args_res == $num_res - 1) { + # One set of results for all rounding modes, no flags. + @start_rm = ( 0, 0, 0, 0 ); + } elsif ($#args_res == $num_res) { + # One set of results for all rounding modes, with flags. die ("wrong number of arguments") - unless ($args[$current_arg] =~ /EXCEPTION|IGNORE_ZERO_INF_SIGN/); - } elsif ($current_arg < $#args) { - die ("wrong number of arguments"); - } elsif ($current_arg > ($#args+1)) { + unless ($args_res[$#args_res] =~ /EXCEPTION|ERRNO|IGNORE_ZERO_INF_SIGN|TEST_NAN_SIGN|NO_TEST_INLINE|XFAIL_TEST/); + @start_rm = ( 0, 0, 0, 0 ); + } elsif ($#args_res == 4 * $num_res + 3) { + # One set of results per rounding mode, with flags. + @start_rm = ( 0, $num_res + 1, 2 * $num_res + 2, 3 * $num_res + 3 ); + } else { die ("wrong number of arguments"); } - - # check for exceptions - if ($current_arg <= $#args) { - $str .= " plus " . &beautify ($args[$current_arg]); - } - # Put the C program line together # Reset some variables to start again $current_arg = 1; - $extra_var = 0; - if (substr($descr_res,0,1) eq 'f') { - $cline = 'check_float' - } elsif (substr($descr_res,0,1) eq 'b') { - $cline = 'check_bool'; - } elsif (substr($descr_res,0,1) eq 'c') { - $cline = 'check_complex'; - } elsif (substr($descr_res,0,1) eq 'i') { - $cline = 'check_int'; - } elsif (substr($descr_res,0,1) eq 'l') { - $cline = 'check_long'; - } elsif (substr($descr_res,0,1) eq 'L') { - $cline = 'check_longlong'; - } - # Special handling for some macros: - $cline .= " (\"$str\", "; - if ($args[0] =~ /fpclassify|isnormal|isfinite|signbit/) { - $c_call = "$args[0] ("; - } else { - $c_call = " FUNC($args[0]) ("; - } + $cline = "{ \"$call_args\""; @descr = split //,$descr_args; for ($i=0; $i <= $#descr; $i++) { - if ($i >= 1) { - $c_call .= ', '; - } # FLOAT, int, long int, long long int - if ($descr[$i] =~ /f|i|l|L/) { - $c_call .= $args[$current_arg]; + if ($descr[$i] =~ /f|j|i|l|L/) { + if ($descr[$i] eq "f") { + $cline .= ", " . &apply_lit ($args[$current_arg]); + } else { + $cline .= ", $args[$current_arg]"; + } $current_arg++; next; } # &FLOAT, &int if ($descr[$i] =~ /F|I/) { - ++$extra_var; - $c_call .= '&' . &get_variable ($extra_var); next; } # complex if ($descr[$i] eq 'c') { - $c_call .= "BUILD_COMPLEX ($args[$current_arg], $args[$current_arg+1])"; + $cline .= ", " . &apply_lit ($args[$current_arg]); + $cline .= ", " . &apply_lit ($args[$current_arg+1]); $current_arg += 2; next; } } - $c_call .= ')'; - $cline .= "$c_call, "; @descr = split //,$descr_res; - foreach (@descr) { - if ($_ =~ /b|f|i|l|L/ ) { - $cline .= $args[$current_arg]; - $current_arg++; - } elsif ($_ eq 'c') { - $cline .= "BUILD_COMPLEX ($args[$current_arg], $args[$current_arg+1])"; - $current_arg += 2; - } elsif ($_ eq '1') { - push @special, $args[$current_arg]; - ++$current_arg; - } - } - # Add ulp, xfail - $cline .= &new_test ($str, ($current_arg <= $#args) ? $args[$current_arg] : undef); - - # special treatment for some functions - if ($args[0] eq 'frexp') { - if (defined $special[0] && $special[0] ne "IGNORE") { - my ($str) = "$call sets x to $special[0]"; - $post = " check_int (\"$str\", x, $special[0]"; - $post .= &new_test ($str, undef); - } - } elsif ($args[0] eq 'gamma' || $args[0] eq 'lgamma') { - $pre = " signgam = 0;\n"; - if (defined $special[0] && $special[0] ne "IGNORE") { - my ($str) = "$call sets signgam to $special[0]"; - $post = " check_int (\"$str\", signgam, $special[0]"; - $post .= &new_test ($str, undef); + @plus_oflow = qw(max_value plus_infty max_value plus_infty); + @minus_oflow = qw(minus_infty minus_infty -max_value -max_value); + @plus_uflow = qw(plus_zero plus_zero plus_zero min_subnorm_value); + @minus_uflow = qw(-min_subnorm_value minus_zero minus_zero minus_zero); + @errno_plus_oflow = qw(0 ERRNO_ERANGE 0 ERRNO_ERANGE); + @errno_minus_oflow = qw(ERRNO_ERANGE ERRNO_ERANGE 0 0); + @errno_plus_uflow = qw(ERRNO_ERANGE ERRNO_ERANGE ERRNO_ERANGE 0); + @errno_minus_uflow = qw(0 ERRNO_ERANGE ERRNO_ERANGE ERRNO_ERANGE); + for ($rm = 0; $rm <= 3; $rm++) { + $current_arg = $start_rm[$rm]; + $ignore_result_any = 0; + $ignore_result_all = 1; + $cline_res = ""; + @special = (); + foreach (@descr) { + if ($_ =~ /b|f|j|i|l|L/ ) { + my ($result) = $args_res[$current_arg]; + if ($result eq "IGNORE") { + $ignore_result_any = 1; + $result = "0"; + } else { + $ignore_result_all = 0; + } + if ($_ eq "f") { + $result = apply_lit ($result); + } + $cline_res .= ", $result"; + $current_arg++; + } elsif ($_ eq 'c') { + my ($result1) = $args_res[$current_arg]; + if ($result1 eq "IGNORE") { + $ignore_result_any = 1; + $result1 = "0"; + } else { + $ignore_result_all = 0; + } + my ($result2) = $args_res[$current_arg + 1]; + if ($result2 eq "IGNORE") { + $ignore_result_any = 1; + $result2 = "0"; + } else { + $ignore_result_all = 0; + } + $result1 = apply_lit ($result1); + $result2 = apply_lit ($result2); + $cline_res .= ", $result1, $result2"; + $current_arg += 2; + } elsif ($_ eq '1') { + push @special, $args_res[$current_arg]; + ++$current_arg; + } } - } elsif ($args[0] eq 'modf') { - if (defined $special[0] && $special[0] ne "IGNORE") { - my ($str) = "$call sets x to $special[0]"; - $post = " check_float (\"$str\", x, $special[0]"; - $post .= &new_test ($str, undef); + if ($ignore_result_any && !$ignore_result_all) { + die ("some but not all function results ignored\n"); } - } elsif ($args[0] eq 'remquo') { - if (defined $special[0] && $special[0] ne "IGNORE") { - my ($str) = "$call sets x to $special[0]"; - $post = " check_int (\"$str\", x, $special[0]"; - $post .= &new_test ($str, undef); + # Determine whether any arguments or results, for any rounding + # mode, are non-finite. + $non_finite = ($args =~ /qnan_value|snan_value|plus_infty|minus_infty/); + $test_snan = ($args =~ /snan_value/); + # Add exceptions. + $cline_res .= show_exceptions ($ignore_result_any, + $non_finite, + $test_snan, + ($current_arg <= $#args_res) + ? $args_res[$current_arg] + : undef); + + # special treatment for some functions + $i = 0; + foreach (@special) { + ++$i; + my ($extra_expected) = $_; + my ($run_extra) = ($extra_expected ne "IGNORE" ? 1 : 0); + if (!$run_extra) { + $extra_expected = "0"; + } else { + $extra_expected = apply_lit ($extra_expected); + } + $cline_res .= ", $run_extra, $extra_expected"; } + $cline_res =~ s/^, //; + $cline_res =~ s/plus_oflow/$plus_oflow[$rm]/g; + $cline_res =~ s/minus_oflow/$minus_oflow[$rm]/g; + $cline_res =~ s/plus_uflow/$plus_uflow[$rm]/g; + $cline_res =~ s/minus_uflow/$minus_uflow[$rm]/g; + $cline_res =~ s/ERRNO_PLUS_OFLOW/$errno_plus_oflow[$rm]/g; + $cline_res =~ s/ERRNO_MINUS_OFLOW/$errno_minus_oflow[$rm]/g; + $cline_res =~ s/ERRNO_PLUS_UFLOW/$errno_plus_uflow[$rm]/g; + $cline_res =~ s/ERRNO_MINUS_UFLOW/$errno_minus_uflow[$rm]/g; + $cline .= ", { $cline_res }"; + } + print $file " $cline },\n"; +} + +# Convert a condition from auto-libm-test-out to C form. +sub convert_condition { + my ($cond) = @_; + my (@conds, $ret); + @conds = split /:/, $cond; + foreach (@conds) { + s/-/_/g; + s/^/TEST_COND_/; } + $ret = join " && ", @conds; + return "($ret)"; +} - print $file $pre if (defined $pre); +# Return text to OR a value into an accumulated flags string. +sub or_value { + my ($cond) = @_; + if ($cond eq "0") { + return ""; + } else { + return " | $cond"; + } +} - print $file " $cline"; +# Return a conditional expression between two values. +sub cond_value { + my ($cond, $if, $else) = @_; + if ($cond eq "1") { + return $if; + } elsif ($cond eq "0") { + return $else; + } else { + return "($cond ? $if : $else)"; + } +} - print $file $post if (defined $post); +# Return text to OR a conditional expression between two values into +# an accumulated flags string. +sub or_cond_value { + my ($cond, $if, $else) = @_; + return or_value (cond_value ($cond, $if, $else)); } # Generate libm-test.c sub generate_testfile { my ($input, $output) = @_; - my ($lasttext); - my (@args, $i, $str); open INPUT, $input or die ("Can't open $input: $!"); open OUTPUT, ">$output" or die ("Can't open $output: $!"); # Replace the special macros while () { + # AUTO_TESTS (function), + if (/^\s*AUTO_TESTS_/) { + my ($descr, $func, @modes, $auto_test, $num_auto_tests); + my (@rm_tests, $rm, $i); + @modes = qw(downward tonearest towardzero upward); + ($descr, $func) = ($_ =~ /AUTO_TESTS_(\w+)\s*\((\w+)\)/); + for ($rm = 0; $rm <= 3; $rm++) { + $rm_tests[$rm] = [sort keys %{$auto_tests{$func}{$modes[$rm]}}]; + } + $num_auto_tests = scalar @{$rm_tests[0]}; + for ($rm = 1; $rm <= 3; $rm++) { + if ($num_auto_tests != scalar @{$rm_tests[$rm]}) { + die ("inconsistent numbers of tests for $func\n"); + } + for ($i = 0; $i < $num_auto_tests; $i++) { + if ($rm_tests[0][$i] ne $rm_tests[$rm][$i]) { + die ("inconsistent list of tests of $func\n"); + } + } + } + if ($num_auto_tests == 0) { + die ("no automatic tests for $func\n"); + } + foreach $auto_test (@{$rm_tests[0]}) { + my ($format, $inputs, $format_conv, $args_str); + ($format, $inputs) = split / /, $auto_test, 2; + $inputs =~ s/ /, /g; + $format_conv = convert_condition ($format); + print OUTPUT "#if $format_conv\n"; + $args_str = "$func, $inputs"; + for ($rm = 0; $rm <= 3; $rm++) { + my ($auto_test_out, $outputs, $flags); + my ($flags_conv, @flags, %flag_cond); + $auto_test_out = $auto_tests{$func}{$modes[$rm]}{$auto_test}; + ($outputs, $flags) = split / : */, $auto_test_out; + $outputs =~ s/ /, /g; + @flags = split / /, $flags; + foreach (@flags) { + if (/^([^:]*):(.*)$/) { + my ($flag, $cond); + $flag = $1; + $cond = convert_condition ($2); + if (defined ($flag_cond{$flag})) { + if ($flag_cond{$flag} ne "1") { + $flag_cond{$flag} .= " || $cond"; + } + } else { + $flag_cond{$flag} = $cond; + } + } else { + $flag_cond{$_} = "1"; + } + } + $flags_conv = ""; + if (defined ($flag_cond{"ignore-zero-inf-sign"})) { + $flags_conv .= or_cond_value ($flag_cond{"ignore-zero-inf-sign"}, + "IGNORE_ZERO_INF_SIGN", "0"); + } + if (defined ($flag_cond{"no-test-inline"})) { + $flags_conv .= or_cond_value ($flag_cond{"no-test-inline"}, + "NO_TEST_INLINE", "0"); + } + if (defined ($flag_cond{"xfail"})) { + $flags_conv .= or_cond_value ($flag_cond{"xfail"}, + "XFAIL_TEST", "0"); + } + my (@exc_list) = qw(divbyzero inexact invalid overflow underflow); + my ($exc); + foreach $exc (@exc_list) { + my ($exc_expected, $exc_ok, $no_exc, $exc_cond, $exc_ok_cond); + $exc_expected = "\U$exc\E_EXCEPTION"; + $exc_ok = "\U$exc\E_EXCEPTION_OK"; + $no_exc = "0"; + if ($exc eq "inexact") { + $exc_ok = "0"; + $no_exc = "NO_INEXACT_EXCEPTION"; + } + if (defined ($flag_cond{$exc})) { + $exc_cond = $flag_cond{$exc}; + } else { + $exc_cond = "0"; + } + if (defined ($flag_cond{"$exc-ok"})) { + $exc_ok_cond = $flag_cond{"$exc-ok"}; + } else { + $exc_ok_cond = "0"; + } + $flags_conv .= or_cond_value ($exc_cond, + cond_value ($exc_ok_cond, + $exc_ok, $exc_expected), + cond_value ($exc_ok_cond, + $exc_ok, $no_exc)); + } + my ($errno_expected, $errno_unknown_cond); + if (defined ($flag_cond{"errno-edom"})) { + if ($flag_cond{"errno-edom"} ne "1") { + die ("unexpected condition for errno-edom"); + } + if (defined ($flag_cond{"errno-erange"})) { + die ("multiple errno values expected"); + } + $errno_expected = "ERRNO_EDOM"; + } elsif (defined ($flag_cond{"errno-erange"})) { + if ($flag_cond{"errno-erange"} ne "1") { + die ("unexpected condition for errno-erange"); + } + $errno_expected = "ERRNO_ERANGE"; + } else { + $errno_expected = "ERRNO_UNCHANGED"; + } + if (defined ($flag_cond{"errno-edom-ok"})) { + if (defined ($flag_cond{"errno-erange-ok"}) + && ($flag_cond{"errno-erange-ok"} + ne $flag_cond{"errno-edom-ok"})) { + $errno_unknown_cond = "($flag_cond{\"errno-edom-ok\"} || $flag_cond{\"errno-erange-ok\"})"; + } else { + $errno_unknown_cond = $flag_cond{"errno-edom-ok"}; + } + } elsif (defined ($flag_cond{"errno-erange-ok"})) { + $errno_unknown_cond = $flag_cond{"errno-erange-ok"}; + } else { + $errno_unknown_cond = "0"; + } + $flags_conv .= or_cond_value ($errno_unknown_cond, + "0", $errno_expected); + if ($flags_conv eq "") { + $flags_conv = ", NO_EXCEPTION"; + } else { + $flags_conv =~ s/^ \|/,/; + } + $args_str .= ", $outputs$flags_conv"; + } + &parse_args (\*OUTPUT, $descr, $args_str); + print OUTPUT "#endif\n"; + } + next; + } # TEST_... if (/^\s*TEST_/) { @@ -438,41 +583,6 @@ sub generate_testfile { &parse_args (\*OUTPUT, $descr, $args); next; } - # START (function) - if (/START/) { - print OUTPUT " init_max_error ();\n"; - next; - } - # END (function) - if (/END/) { - my ($fct, $line, $type); - if (/complex/) { - s/,\s*complex\s*//; - $type = 'complex'; - } else { - $type = 'normal'; - } - ($fct) = ($_ =~ /END\s*\((.*)\)/); - if ($type eq 'complex') { - $line = " print_complex_max_error (\"$fct\", "; - } else { - $line = " print_max_error (\"$fct\", "; - } - if (exists $results{$fct}{'has_ulps'}) { - $line .= "DELTA$fct"; - } else { - $line .= '0'; - } - if (exists $results{$fct}{'has_fails'}) { - $line .= ", FAIL$fct"; - } else { - $line .= ', 0'; - } - $line .= ");\n"; - print OUTPUT $line; - push @functions, $fct; - next; - } print OUTPUT; } close INPUT; @@ -484,7 +594,14 @@ sub generate_testfile { # Parse ulps file sub parse_ulps { my ($file) = @_; - my ($test, $type, $float, $eps, $kind); + my ($test, $type, $float, $eps, $float_regex); + + # Build a basic regex to match type entries in the + # generated ULPS file. + foreach my $ftype (@all_floats) { + $float_regex .= "|" . $ftype; + } + $float_regex = "^" . substr ($float_regex, 1) . ":"; # $type has the following values: # "normal": No complex variable @@ -496,21 +613,6 @@ sub parse_ulps { # ignore comments and empty lines next if /^#/; next if /^\s*$/; - if (/^Test/) { - if (/Real part of:/) { - s/Real part of: //; - $type = 'real'; - } elsif (/Imaginary part of:/) { - s/Imaginary part of: //; - $type = 'imag'; - } else { - $type = 'normal'; - } - s/^.+\"(.*)\".*$/$1/; - $test = $_; - $kind = 'test'; - next; - } if (/^Function: /) { if (/Real part of/) { s/Real part of //; @@ -522,28 +624,26 @@ sub parse_ulps { $type = 'normal'; } ($test) = ($_ =~ /^Function:\s*\"([a-zA-Z0-9_]+)\"/); - $kind = 'fct'; next; } - if (/^i?(float|double|ldouble):/) { + if (/$float_regex/) { ($float, $eps) = split /\s*:\s*/,$_,2; - if ($eps eq 'fail') { - $results{$test}{$type}{'fail'}{$float} = 1; - $results{$test}{'has_fails'} = 1; - } elsif ($eps eq "0") { + if ($eps eq "0") { # ignore next; } else { - $results{$test}{$type}{'ulp'}{$float} = $eps; - $results{$test}{'has_ulps'} = 1; + if (!defined ($results{$test}{$type}{'ulp'}{$float}) + || $results{$test}{$type}{'ulp'}{$float} < $eps) { + $results{$test}{$type}{'ulp'}{$float} = $eps; + $results{$test}{'has_ulps'} = 1; + } } if ($type =~ /^real|imag$/) { $results{$test}{'type'} = 'complex'; } elsif ($type eq 'normal') { $results{$test}{'type'} = 'normal'; } - $results{$test}{'kind'} = $kind; next; } print "Skipping unknown entry: `$_'\n"; @@ -556,9 +656,11 @@ sub parse_ulps { sub clean_up_number { my ($number) = @_; - # Remove trailing zeros - $number =~ s/0+$//; - $number =~ s/\.$//; + # Remove trailing zeros after the decimal point + if ($number =~ /\./) { + $number =~ s/0+$//; + $number =~ s/\.$//; + } return $number; } @@ -570,42 +672,9 @@ sub print_ulps_file { $last_fct = ''; open NEWULP, ">$file" or die ("Can't open $file: $!"); print NEWULP "# Begin of automatic generation\n"; - # first the function calls - foreach $test (sort keys %results) { - next if ($results{$test}{'kind'} ne 'test'); - foreach $type ('real', 'imag', 'normal') { - if (exists $results{$test}{$type}) { - if (defined $results{$test}) { - ($fct) = ($test =~ /^(\w+)\s/); - if ($fct ne $last_fct) { - $last_fct = $fct; - print NEWULP "\n# $fct\n"; - } - } - if ($type eq 'normal') { - print NEWULP "Test \"$test\":\n"; - } elsif ($type eq 'real') { - print NEWULP "Test \"Real part of: $test\":\n"; - } elsif ($type eq 'imag') { - print NEWULP "Test \"Imaginary part of: $test\":\n"; - } - foreach $float (@all_floats) { - if (exists $results{$test}{$type}{'ulp'}{$float}) { - print NEWULP "$float: ", - &clean_up_number ($results{$test}{$type}{'ulp'}{$float}), - "\n"; - } - if (exists $results{$test}{$type}{'fail'}{$float}) { - print NEWULP "$float: fail\n"; - } - } - } - } - } print NEWULP "\n# Maximal error of functions:\n"; foreach $fct (sort keys %results) { - next if ($results{$fct}{'kind'} ne 'fct'); foreach $type ('real', 'imag', 'normal') { if (exists $results{$fct}{$type}) { if ($type eq 'normal') { @@ -621,9 +690,6 @@ sub print_ulps_file { &clean_up_number ($results{$fct}{$type}{'ulp'}{$float}), "\n"; } - if (exists $results{$fct}{$type}{'fail'}{$float}) { - print NEWULP "$float: fail\n"; - } } print NEWULP "\n"; } @@ -636,87 +702,31 @@ sub print_ulps_file { sub get_ulps { my ($test, $type, $float) = @_; - if ($type eq 'complex') { - my ($res); - # Return 0 instead of BUILD_COMPLEX (0,0) - if (!exists $results{$test}{'real'}{'ulp'}{$float} && - !exists $results{$test}{'imag'}{'ulp'}{$float}) { - return "0"; - } - $res = 'BUILD_COMPLEX ('; - $res .= (exists $results{$test}{'real'}{'ulp'}{$float} - ? $results{$test}{'real'}{'ulp'}{$float} : "0"); - $res .= ', '; - $res .= (exists $results{$test}{'imag'}{'ulp'}{$float} - ? $results{$test}{'imag'}{'ulp'}{$float} : "0"); - $res .= ')'; - return $res; - } - return (exists $results{$test}{'normal'}{'ulp'}{$float} - ? $results{$test}{'normal'}{'ulp'}{$float} : "0"); + return (exists $results{$test}{$type}{'ulp'}{$float} + ? $results{$test}{$type}{'ulp'}{$float} : "0"); } -sub get_failure { - my ($test, $type, $float) = @_; - if ($type eq 'complex') { - # return x,y - my ($res); - # Return 0 instead of BUILD_COMPLEX_INT (0,0) - if (!exists $results{$test}{'real'}{'ulp'}{$float} && - !exists $results{$test}{'imag'}{'ulp'}{$float}) { - return "0"; - } - $res = 'BUILD_COMPLEX_INT ('; - $res .= (exists $results{$test}{'real'}{'fail'}{$float} - ? $results{$test}{'real'}{'fail'}{$float} : "0"); - $res .= ', '; - $res .= (exists $results{$test}{'imag'}{'fail'}{$float} - ? $results{$test}{'imag'}{'fail'}{$float} : "0"); - $res .= ')'; - return $res; - } - return (exists $results{$test}{'normal'}{'fail'}{$float} - ? $results{$test}{'normal'}{'fail'}{$float} : "0"); - -} - -# Output the defines for a single test -sub output_test { - my ($file, $test, $name) = @_; +# Return the ulps value for a single test. +sub get_all_ulps_for_test { + my ($test, $type) = @_; my ($ldouble, $double, $float, $ildouble, $idouble, $ifloat); - my ($type); + my ($ulps_str); - # Do we have ulps/failures? - if (!exists $results{$test}{'type'}) { - return; - } - $type = $results{$test}{'type'}; if (exists $results{$test}{'has_ulps'}) { - # XXX use all_floats (change order!) - $ldouble = &get_ulps ($test, $type, "ldouble"); - $double = &get_ulps ($test, $type, "double"); - $float = &get_ulps ($test, $type, "float"); - $ildouble = &get_ulps ($test, $type, "ildouble"); - $idouble = &get_ulps ($test, $type, "idouble"); - $ifloat = &get_ulps ($test, $type, "ifloat"); - print $file "#define DELTA$name CHOOSE($ldouble, $double, $float, $ildouble, $idouble, $ifloat)\t/* $test */\n"; - } - - if (exists $results{$test}{'has_fails'}) { - $ldouble = &get_failure ($test, "ldouble"); - $double = &get_failure ($test, "double"); - $float = &get_failure ($test, "float"); - $ildouble = &get_failure ($test, "ildouble"); - $idouble = &get_failure ($test, "idouble"); - $ifloat = &get_failure ($test, "ifloat"); - print $file "#define FAIL$name CHOOSE($ldouble, $double, $float $ildouble, $idouble, $ifloat)\t/* $test */\n"; + foreach $float (@all_floats) { + $ulps_str .= &get_ulps ($test, $type, $float) . ", "; + } + return "{" . substr ($ulps_str, 0, -2) . "}"; + } else { + die "get_all_ulps_for_test called for \"$test\" with no ulps\n"; } } # Print include file sub output_ulps { my ($file, $ulps_filename) = @_; - my ($i, $fct); + my ($i, $fct, $type, $ulp, $ulp_real, $ulp_imag); + my (%func_ulps, %func_real_ulps, %func_imag_ulps); open ULP, ">$file" or die ("Can't open $file: $!"); @@ -724,14 +734,71 @@ sub output_ulps { print ULP " from $ulps_filename with gen-libm-test.pl.\n"; print ULP " Don't change it - change instead the master files. */\n\n"; - print ULP "\n/* Maximal error of functions. */\n"; - foreach $fct (@functions) { - output_test (\*ULP, $fct, $fct); + print ULP "struct ulp_data\n"; + print ULP "{\n"; + print ULP " const char *name;\n"; + print ULP " FLOAT max_ulp[" . @all_floats . "];\n"; + print ULP "};\n\n"; + + for ($i = 0; $i <= $#all_floats; $i++) { + $type = $all_floats[$i]; + print ULP "#define ULP_"; + if ($type =~ /^i/) { + print ULP "I_"; + $type = substr $type, 1; + } + print ULP "$all_floats_pfx{$type} $i\n"; } - print ULP "\n/* Error of single function calls. */\n"; - for ($i = 0; $i < $count; $i++) { - output_test (\*ULP, $tests[$i], $i); + foreach $fct (keys %results) { + $type = $results{$fct}{'type'}; + if ($type eq 'normal') { + $ulp = get_all_ulps_for_test ($fct, 'normal'); + } elsif ($type eq 'complex') { + $ulp_real = get_all_ulps_for_test ($fct, 'real'); + $ulp_imag = get_all_ulps_for_test ($fct, 'imag'); + } else { + die "unknown results ($fct) type $type\n"; + } + if ($type eq 'normal') { + $func_ulps{$fct} = $ulp; + } else { + $func_real_ulps{$fct} = $ulp_real; + $func_imag_ulps{$fct} = $ulp_imag; + } + } + print ULP "\n/* Maximal error of functions. */\n"; + print ULP "static const struct ulp_data func_ulps[] =\n {\n"; + foreach $fct (sort keys %func_ulps) { + print ULP " { \"$fct\", $func_ulps{$fct} },\n"; } + print ULP " };\n"; + print ULP "static const struct ulp_data func_real_ulps[] =\n {\n"; + foreach $fct (sort keys %func_real_ulps) { + print ULP " { \"$fct\", $func_real_ulps{$fct} },\n"; + } + print ULP " };\n"; + print ULP "static const struct ulp_data func_imag_ulps[] =\n {\n"; + foreach $fct (sort keys %func_imag_ulps) { + print ULP " { \"$fct\", $func_imag_ulps{$fct} },\n"; + } + print ULP " };\n"; close ULP; } + +# Parse auto-libm-test-out. +sub parse_auto_input { + my ($file) = @_; + open AUTO, $file or die ("Can't open $file: $!"); + while () { + chop; + next if !/^= /; + s/^= //; + if (/^(\S+) (\S+) ([^:]*) : (.*)$/) { + $auto_tests{$1}{$2}{$3} = $4; + } else { + die ("bad automatic test line: $_\n"); + } + } + close AUTO; +} -- cgit v1.2.3