diff options
Diffstat (limited to 'math/gen-libm-test.pl')
-rwxr-xr-x | math/gen-libm-test.pl | 377 |
1 files changed, 95 insertions, 282 deletions
diff --git a/math/gen-libm-test.pl b/math/gen-libm-test.pl index f50f1d9e02..c2d10d35e8 100755 --- a/math/gen-libm-test.pl +++ b/math/gen-libm-test.pl @@ -25,7 +25,6 @@ # 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 +32,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 @@ -44,8 +41,6 @@ use strict; use vars qw ($input $output); 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); @@ -106,8 +101,6 @@ $output_dir = $opt_o if ($opt_o); $input = "libm-test.inc"; $output = "${output_dir}libm-test.c"; -$count = 0; - &parse_ulps ($ulps_file); &generate_testfile ($input, $output) unless ($opt_n); &output_ulps ("${output_dir}libm-test-ulps.h", $ulps_file) unless ($opt_n); @@ -151,140 +144,68 @@ 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 ($exception) = @_; if (defined $exception) { - $rest .= ", $exception"; + return ", $exception"; } else { - $rest .= ', 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."); + return ', 0'; } - print $file " {\n"; - 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'; - - $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; - print $file " }\n"; } # Parse the arguments to TEST_x_y sub parse_args { - my ($file, $descr, $fct, $args) = @_; - my (@args, $str, $descr_args, $descr_res, @descr); + my ($file, $descr, $args) = @_; + my (@args, $descr_args, $descr_res, @descr); my ($current_arg, $cline, $i); - my ($pre, $post, @special); - my ($extra_var, $call, $c_call); + my (@special); + my ($call_args); - if ($descr eq 'extra') { - &special_functions ($file, $args); - return; - } ($descr_args, $descr_res) = split /_/,$descr, 2; @args = split /,\s*/, $args; - $call = "$fct ("; + $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]); + $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 @descr = split //,$descr_res; foreach (@descr) { if ($_ =~ /f|i|l|L/) { - $str .= &beautify ($args[$current_arg]); ++$current_arg; } elsif ($_ eq 'c') { - $str .= &build_complex_beautify ($args[$current_arg], $args[$current_arg+1]); $current_arg += 2; } elsif ($_ eq 'b') { # boolean - $str .= ($args[$current_arg] == 0) ? "false" : "true"; ++$current_arg; } elsif ($_ eq '1') { ++$current_arg; @@ -295,7 +216,7 @@ sub parse_args { # consistency check if ($current_arg == $#args) { die ("wrong number of arguments") - unless ($args[$current_arg] =~ /EXCEPTION|IGNORE_ZERO_INF_SIGN/); + unless ($args[$current_arg] =~ /EXCEPTION|ERRNO|IGNORE_ZERO_INF_SIGN/); } elsif ($current_arg < $#args) { die ("wrong number of arguments"); } elsif ($current_arg > ($#args+1)) { @@ -306,116 +227,64 @@ sub parse_args { # 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|isinf|isnan|signbit - |isgreater|isgreaterequal|isless|islessequal - |islessgreater|isunordered/x) { - $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]; + $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 .= ", $args[$current_arg], $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]; + $cline .= ", $args[$current_arg]"; $current_arg++; } elsif ($_ eq 'c') { - $cline .= "BUILD_COMPLEX ($args[$current_arg], $args[$current_arg+1])"; + $cline .= ", $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); + # Add exceptions. + $cline .= show_exceptions (($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); - } - } 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); - } - } 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); + $i = 0; + foreach (@special) { + ++$i; + my ($extra_expected) = $_; + my ($run_extra) = ($extra_expected ne "IGNORE" ? 1 : 0); + if (!$run_extra) { + $extra_expected = "0"; } + $cline .= ", $run_extra, $extra_expected"; } - - if (defined $pre or defined $post) { - print $file " {\n"; - print $file " $pre" if (defined $pre); - print $file " $cline"; - print $file " $post" if (defined $post); - print $file " }\n"; - } else { - print $file " $cline"; - } + print $file " $cline },\n"; } # Generate libm-test.c sub generate_testfile { my ($input, $output) = @_; my ($lasttext); - my (@args, $i, $str, $thisfct); + my (@args, $i); open INPUT, $input or die ("Can't open $input: $!"); open OUTPUT, ">$output" or die ("Can't open $output: $!"); @@ -428,43 +297,7 @@ sub generate_testfile { my ($descr, $args); chop; ($descr, $args) = ($_ =~ /TEST_(\w+)\s*\((.*)\)/); - &parse_args (\*OUTPUT, $descr, $thisfct, $args); - next; - } - # START (function) - if (/START/) { - ($thisfct) = ($_ =~ /START\s*\((.*)\)/); - 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; + &parse_args (\*OUTPUT, $descr, $args); next; } print OUTPUT; @@ -522,10 +355,7 @@ sub parse_ulps { if (/^i?(float|double|ldouble):/) { ($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 { @@ -591,9 +421,6 @@ sub print_ulps_file { &clean_up_number ($results{$test}{$type}{'ulp'}{$float}), "\n"; } - if (exists $results{$test}{$type}{'fail'}{$float}) { - print NEWULP "$float: fail\n"; - } } } } @@ -617,9 +444,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"; } @@ -632,61 +456,15 @@ 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); - # 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"); @@ -695,24 +473,17 @@ sub output_test { $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"; + return "CHOOSE ($ldouble, $double, $float, $ildouble, $idouble, $ifloat)"; + } 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 (%test_ulps, %func_ulps, %func_real_ulps, %func_imag_ulps); open ULP, ">$file" or die ("Can't open $file: $!"); @@ -720,14 +491,56 @@ 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"; + 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 ($results{$fct}{'kind'} eq 'fct') { + if ($type eq 'normal') { + $func_ulps{$fct} = $ulp; + } else { + $func_real_ulps{$fct} = $ulp_real; + $func_imag_ulps{$fct} = $ulp_imag; + } + } elsif ($results{$fct}{'kind'} eq 'test') { + if ($type eq 'normal') { + $test_ulps{$fct} = $ulp; + } else { + $test_ulps{"Real part of: $fct"} = $ulp_real; + $test_ulps{"Imaginary part of: $fct"} = $ulp_imag; + } + } else { + die "unknown results ($fct) kind $results{$fct}{'kind'}\n"; + } + } print ULP "\n/* Maximal error of functions. */\n"; - foreach $fct (@functions) { - output_test (\*ULP, $fct, $fct); + 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"; print ULP "\n/* Error of single function calls. */\n"; - for ($i = 0; $i < $count; $i++) { - output_test (\*ULP, $tests[$i], $i); + print ULP "static const struct ulp_data test_ulps[] =\n {\n"; + foreach $fct (sort keys %test_ulps) { + print ULP " { \"$fct\", $test_ulps{$fct} },\n"; } + print ULP " };\n"; close ULP; } |