diff options
Diffstat (limited to 'math/gen-libm-test.pl')
| -rwxr-xr-x | math/gen-libm-test.pl | 846 |
1 files changed, 0 insertions, 846 deletions
diff --git a/math/gen-libm-test.pl b/math/gen-libm-test.pl deleted file mode 100755 index 664fba5909..0000000000 --- a/math/gen-libm-test.pl +++ /dev/null @@ -1,846 +0,0 @@ -#!/usr/bin/perl -w -# Copyright (C) 1999-2018 Free Software Foundation, Inc. -# This file is part of the GNU C Library. -# Contributed by Andreas Jaeger <aj@suse.de>, 1999. - -# The GNU C Library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; either -# version 2.1 of the License, or (at your option) any later version. - -# The GNU C Library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# 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; if not, see -# <http://www.gnu.org/licenses/>. - -# 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}{"type"} is the result type, e.g. normal or complex. -# $results{$test}{"has_ulps"} is set if deltas 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). -# - $float is either of float, ifloat, double, idouble, ldouble, ildouble; -# 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}{"ulp"}{$float} is defined and has a delta as value - - -use Getopt::Std; - -use strict; - -use vars qw ($input $output $auto_input); -use vars qw (%results); -use vars qw (%beautify @all_floats %all_floats_pfx); -use vars qw ($ulps_file); -use vars qw (%auto_tests); - -# all_floats is sorted and contains all recognised float types -@all_floats = ('double', 'float', 'float128', 'idouble', - 'ifloat', 'ifloat128', 'ildouble', 'ldouble'); - -# all_floats_pfx maps C types to their C like prefix for macros. -%all_floats_pfx = - ( "double" => "DBL", - "ldouble" => "LDBL", - "float" => "FLT", - "float128" => "FLT128", - ); - -%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", - "qnan_value" => "qNaN", - "snan_value" => "sNaN", - "snan_value_ld" => "sNaN", - ); - - -# get Options -# Options: -# a: auto-libm-test-out input file -# c: .inc input file -# u: ulps-file -# n: new ulps file -# C: libm-test.c output file -# H: libm-test-ulps.h output file -# h: help -use vars qw($opt_a $opt_c $opt_u $opt_n $opt_C $opt_H $opt_h); -getopts('a:c:u:n:C:H:h'); - -$ulps_file = 'libm-test-ulps'; - -if ($opt_h) { - print "Usage: gen-libm-test.pl [OPTIONS]\n"; - print " -h print this help, then exit\n"; - print " -a FILE input file with automatically generated tests\n"; - print " -c FILE input file .inc file with tests\n"; - print " -u FILE input file with ulps\n"; - print " -n FILE generate sorted file FILE from libm-test-ulps\n"; - print " -C FILE generate output C file FILE from libm-test.inc\n"; - print " -H FILE generate output ulps header FILE from libm-test-ulps\n"; - exit 0; -} - -$ulps_file = $opt_u if ($opt_u); - -$input = $opt_c if ($opt_c); -$auto_input = $opt_a if ($opt_a); -$output = $opt_C if ($opt_C); - -&parse_ulps ($ulps_file) if ($opt_H || $opt_n); -&parse_auto_input ($auto_input) if ($opt_C); -&generate_testfile ($input, $output) if ($opt_C); -&output_ulps ($opt_H, $ulps_file) if ($opt_H); -&print_ulps_file ($opt_n) if ($opt_n); - -# Return a nicer representation -sub beautify { - my ($arg) = @_; - my ($tmp); - - if (exists $beautify{$arg}) { - return $beautify{$arg}; - } - if ($arg =~ /^-/) { - $tmp = $arg; - $tmp =~ s/^-//; - if (exists $beautify{$tmp}) { - return '-' . $beautify{$tmp}; - } - } - if ($arg =~ /^-?0x[0-9a-f.]*p[-+][0-9]+f$/) { - $arg =~ s/f$//; - } - if ($arg =~ /[0-9]L$/) { - $arg =~ s/L$//; - } - return $arg; -} - -# Return a nicer representation of a complex number -sub build_complex_beautify { - my ($r, $i) = @_; - my ($str1, $str2); - - $str1 = &beautify ($r); - $str2 = &beautify ($i); - if ($str2 =~ /^-/) { - $str2 =~ s/^-//; - $str1 .= ' - ' . $str2; - } else { - $str1 .= ' + ' . $str2; - } - $str1 .= ' i'; - return $str1; -} - -# 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) { - return ", ${ignore_result}${non_finite}${test_snan}$exception"; - } else { - return ", ${ignore_result}${non_finite}${test_snan}0"; - } -} - -# Apply the LIT(x) or ARG_LIT(x) macro to a literal floating point constant -# and strip any existing suffix. -sub _apply_lit { - my ($macro, $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 "$macro (${lit})"; -} - -# Apply LIT macro to individual tokens within an expression. -# -# This function assumes the C expression follows GNU coding -# standards. Specifically, a space separates each lexical -# token. Otherwise, this post-processing may apply LIT -# incorrectly, or around an entire expression. -sub apply_lit { - my ($lit) = @_; - my @toks = split (/ /, $lit); - foreach (@toks) { - $_ = _apply_lit ("LIT", $_); - } - return join (' ', @toks); -} - -# Likewise, but apply ARG_LIT for arguments to narrowing functions. -sub apply_arglit { - my ($lit) = @_; - my @toks = split (/ /, $lit); - foreach (@toks) { - $_ = _apply_lit ("ARG_LIT", $_); - } - return join (' ', @toks); -} - -# Parse the arguments to TEST_x_y -sub parse_args { - my ($file, $descr, $args) = @_; - 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 (@xfail_rounding_ibm128_libgcc); - my ($non_finite, $test_snan); - - ($descr_args, $descr_res) = split /_/,$descr, 2; - - @args = split /,\s*/, $args; - - $call_args = ""; - - # Generate first the string that's shown to the user - $current_arg = 1; - @descr = split //,$descr_args; - for ($i = 0; $i <= $#descr; $i++) { - my $comma = ""; - if ($current_arg > 1) { - $comma = ', '; - } - # FLOAT, ARG_FLOAT, long double, int, unsigned int, long int, long long int - if ($descr[$i] =~ /f|a|j|i|u|l|L/) { - $call_args .= $comma . &beautify ($args[$current_arg]); - ++$current_arg; - next; - } - # Argument passed via pointer. - if ($descr[$i] =~ /p/) { - next; - } - # &FLOAT, &int - simplify call by not showing argument. - if ($descr[$i] =~ /F|I/) { - next; - } - # complex - if ($descr[$i] eq 'c') { - $call_args .= $comma . &build_complex_beautify ($args[$current_arg], $args[$current_arg+1]); - $current_arg += 2; - next; - } - - die ("$descr[$i] is unknown"); - } - - # Result - @args_res = @args[$current_arg .. $#args]; - $num_res = 0; - @descr = split //,$descr_res; - foreach (@descr) { - if ($_ =~ /f|i|l|L|M|U/) { - ++$num_res; - } elsif ($_ eq 'c') { - $num_res += 2; - } elsif ($_ eq 'b') { - # boolean - ++$num_res; - } elsif ($_ eq '1') { - ++$num_res; - } else { - die ("$_ is unknown"); - } - } - # consistency check - 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_res[$#args_res] =~ /EXCEPTION|ERRNO|IGNORE_ZERO_INF_SIGN|TEST_NAN_SIGN|NO_TEST_INLINE|XFAIL/); - @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"); - } - - # Put the C program line together - # Reset some variables to start again - $current_arg = 1; - $call_args =~ s/\"/\\\"/g; - $cline = "{ \"$call_args\""; - @descr = split //,$descr_args; - for ($i=0; $i <= $#descr; $i++) { - # FLOAT, ARG_FLOAT, long double, int, unsigned int, long int, long long int - if ($descr[$i] =~ /f|a|j|i|u|l|L/) { - if ($descr[$i] eq "f") { - $cline .= ", " . &apply_lit ($args[$current_arg]); - } elsif ($descr[$i] eq "a") { - $cline .= ", " . &apply_arglit ($args[$current_arg]); - } else { - $cline .= ", $args[$current_arg]"; - } - $current_arg++; - next; - } - # &FLOAT, &int, argument passed via pointer - if ($descr[$i] =~ /F|I|p/) { - next; - } - # complex - if ($descr[$i] eq 'c') { - $cline .= ", " . &apply_lit ($args[$current_arg]); - $cline .= ", " . &apply_lit ($args[$current_arg+1]); - $current_arg += 2; - next; - } - } - - @descr = split //,$descr_res; - @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); - @xfail_rounding_ibm128_libgcc = qw(XFAIL_IBM128_LIBGCC 0 - XFAIL_IBM128_LIBGCC XFAIL_IBM128_LIBGCC); - 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|M|U/ ) { - 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; - } - } - if ($ignore_result_any && !$ignore_result_all) { - die ("some but not all function results ignored\n"); - } - # 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_res =~ s/XFAIL_ROUNDING_IBM128_LIBGCC/$xfail_rounding_ibm128_libgcc[$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) { - if ($_ !~ /^arg_fmt\(/) { - s/-/_/g; - } - s/^/TEST_COND_/; - } - $ret = join " && ", @conds; - return "($ret)"; -} - -# Return text to OR a value into an accumulated flags string. -sub or_value { - my ($cond) = @_; - if ($cond eq "0") { - return ""; - } else { - return " | $cond"; - } -} - -# 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)"; - } -} - -# 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) = @_; - - open INPUT, $input or die ("Can't open $input: $!"); - open OUTPUT, ">$output" or die ("Can't open $output: $!"); - - # Replace the special macros - while (<INPUT>) { - # 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_/) { - my ($descr, $args); - chop; - ($descr, $args) = ($_ =~ /TEST_(\w+)\s*\((.*)\)/); - &parse_args (\*OUTPUT, $descr, $args); - next; - } - print OUTPUT; - } - close INPUT; - close OUTPUT; -} - - - -# Parse ulps file -sub parse_ulps { - my ($file) = @_; - 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 - # "real": Real part of complex result - # "imag": Imaginary part of complex result - open ULP, $file or die ("Can't open $file: $!"); - while (<ULP>) { - chop; - # ignore comments and empty lines - next if /^#/; - next if /^\s*$/; - if (/^Function: /) { - if (/Real part of/) { - s/Real part of //; - $type = 'real'; - } elsif (/Imaginary part of/) { - s/Imaginary part of //; - $type = 'imag'; - } else { - $type = 'normal'; - } - ($test) = ($_ =~ /^Function:\s*\"([a-zA-Z0-9_]+)\"/); - next; - } - if (/$float_regex/) { - ($float, $eps) = split /\s*:\s*/,$_,2; - - if ($eps eq "0") { - # ignore - next; - } else { - 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'; - } - next; - } - print "Skipping unknown entry: `$_'\n"; - } - close ULP; -} - - -# Clean up a floating point number -sub clean_up_number { - my ($number) = @_; - - # Remove trailing zeros after the decimal point - if ($number =~ /\./) { - $number =~ s/0+$//; - $number =~ s/\.$//; - } - return $number; -} - -# Output a file which can be read in as ulps file. -sub print_ulps_file { - my ($file) = @_; - my ($test, $type, $float, $eps, $fct, $last_fct); - - $last_fct = ''; - open NEWULP, ">$file" or die ("Can't open $file: $!"); - print NEWULP "# Begin of automatic generation\n"; - print NEWULP "\n# Maximal error of functions:\n"; - - foreach $fct (sort keys %results) { - foreach $type ('real', 'imag', 'normal') { - if (exists $results{$fct}{$type}) { - if ($type eq 'normal') { - print NEWULP "Function: \"$fct\":\n"; - } elsif ($type eq 'real') { - print NEWULP "Function: Real part of \"$fct\":\n"; - } elsif ($type eq 'imag') { - print NEWULP "Function: Imaginary part of \"$fct\":\n"; - } - foreach $float (@all_floats) { - if (exists $results{$fct}{$type}{'ulp'}{$float}) { - print NEWULP "$float: ", - &clean_up_number ($results{$fct}{$type}{'ulp'}{$float}), - "\n"; - } - } - print NEWULP "\n"; - } - } - } - print NEWULP "# end of automatic generation\n"; - close NEWULP; -} - -sub get_ulps { - my ($test, $type, $float) = @_; - - return (exists $results{$test}{$type}{'ulp'}{$float} - ? $results{$test}{$type}{'ulp'}{$float} : "0"); -} - -# 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 ($ulps_str); - - if (exists $results{$test}{'has_ulps'}) { - 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, $type, $ulp, $ulp_real, $ulp_imag); - my (%func_ulps, %func_real_ulps, %func_imag_ulps); - - open ULP, ">$file" or die ("Can't open $file: $!"); - - print ULP "/* This file is automatically generated\n"; - 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 "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"; - } - - 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 (<AUTO>) { - chop; - next if !/^= /; - s/^= //; - if (/^(\S+) (\S+) ([^: ][^ ]* [^:]*) : (.*)$/) { - $auto_tests{$1}{$2}{$3} = $4; - } else { - die ("bad automatic test line: $_\n"); - } - } - close AUTO; -} |