math/gen-libm-test.pl

   1 #!/usr/bin/perl -w
   2 # Copyright (C) 1999, 2006 Free Software Foundation, Inc.
   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
   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.
  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
  14 # Lesser General Public License for more details.
  15
  16 # You should have received a copy of the GNU Lesser General Public
  17 # License along with the GNU C Library; if not, write to the Free
  18 # Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  19 # 02111-1307 USA.
  20
  21 # This file needs to be tidied up
  22 # Note that functions and tests share the same namespace.
  23
  24 # Information about tests are stored in: %results
  25 # $results{$test}{"kind"} is either "fct" or "test" and flags whether this
  26 # is a maximal error of a function or a single test.
  27 # $results{$test}{"type"} is the result type, e.g. normal or complex.
  28 # $results{$test}{"has_ulps"} is set if deltas exist.
  29 # $results{$test}{"has_fails"} is set if exptected failures exist.
  30 # In the following description $type and $float are:
  31 # - $type is either "normal", "real" (for the real part of a complex number)
  32 #   or "imag" (for the imaginary part # of a complex number).
  33 # - $float is either of float, ifloat, double, idouble, ldouble, ildouble;
  34 #   It represents the underlying floating point type (float, double or long
  35 #   double) and if inline functions (the leading i stands for inline)
  36 #   are used.
  37 # $results{$test}{$type}{"fail"}{$float} is defined and has a 1 if
  38 # the test is expected to fail
  39 # $results{$test}{$type}{"ulp"}{$float} is defined and has a delta as value
  40
  41
  42 use Getopt::Std;
  43
  44 use strict;
  45
  46 use vars qw ($input $output);
  47 use vars qw (%results);
  48 use vars qw (@tests @functions);
  49 use vars qw ($count);
  50 use vars qw (%beautify @all_floats);
  51 use vars qw ($output_dir $ulps_file);
  52
  53 # all_floats is sorted and contains all recognised float types
  54 @all_floats = ('double', 'float', 'idouble',
  55                'ifloat', 'ildouble', 'ldouble');
  56
  57 %beautify =
  58   ( "minus_zero" => "-0",
  59     "plus_zero" => "+0",
  60     "minus_infty" => "-inf",
  61     "plus_infty" => "inf",
  62     "nan_value" => "NaN",
  63     "M_El" => "e",
  64     "M_E2l" => "e^2",
  65     "M_E3l" => "e^3",
  66     "M_LOG10El", "log10(e)",
  67     "M_PIl" => "pi",
  68     "M_PI_34l" => "3/4 pi",
  69     "M_PI_2l" => "pi/2",
  70     "M_PI_4l" => "pi/4",
  71     "M_PI_6l" => "pi/6",
  72     "M_PI_34_LOG10El" => "3/4 pi*log10(e)",
  73     "M_PI_LOG10El" => "pi*log10(e)",
  74     "M_PI2_LOG10El" => "pi/2*log10(e)",
  75     "M_PI4_LOG10El" => "pi/4*log10(e)",
  76     "M_LOG_SQRT_PIl" => "log(sqrt(pi))",
  77     "M_LOG_2_SQRT_PIl" => "log(2*sqrt(pi))",
  78     "M_2_SQRT_PIl" => "2 sqrt (pi)",
  79     "M_SQRT_PIl" => "sqrt (pi)",
  80     "INVALID_EXCEPTION" => "invalid exception",
  81     "DIVIDE_BY_ZERO_EXCEPTION" => "division by zero exception",
  82     "INVALID_EXCEPTION_OK" => "invalid exception allowed",
  83     "DIVIDE_BY_ZERO_EXCEPTION_OK" => "division by zero exception allowed",
  84     "EXCEPTIONS_OK" => "exceptions allowed",
  85     "IGNORE_ZERO_INF_SIGN" => "sign of zero/inf not specified",
  86 "INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN" => "invalid exception and sign of zero/inf not specified"
  87   );
  88
  89
  90 # get Options
  91 # Options:
  92 # u: ulps-file
  93 # h: help
  94 # o: output-directory
  95 # n: generate new ulps file
  96 use vars qw($opt_u $opt_h $opt_o $opt_n);
  97 getopts('u:o:nh');
  98
  99 $ulps_file = 'libm-test-ulps';
 100 $output_dir = '';
 101
 102 if ($opt_h) {
 103   print "Usage: gen-libm-test.pl [OPTIONS]\n";
 104   print " -h         print this help, then exit\n";
 105   print " -o DIR     directory where generated files will be placed\n";
 106   print " -n         only generate sorted file NewUlps from libm-test-ulps\n";
 107   print " -u FILE    input file with ulps\n";
 108   exit 0;
 109 }
 110
 111 $ulps_file = $opt_u if ($opt_u);
 112 $output_dir = $opt_o if ($opt_o);
 113
 114 $input = "libm-test.inc";
 115 $output = "${output_dir}libm-test.c";
 116
 117 $count = 0;
 118
 119 &parse_ulps ($ulps_file);
 120 &generate_testfile ($input, $output) unless ($opt_n);
 121 &output_ulps ("${output_dir}libm-test-ulps.h", $ulps_file) unless ($opt_n);
 122 &print_ulps_file ("${output_dir}NewUlps") if ($opt_n);
 123
 124 # Return a nicer representation
 125 sub beautify {
 126   my ($arg) = @_;
 127   my ($tmp);
 128
 129   if (exists $beautify{$arg}) {
 130     return $beautify{$arg};
 131   }
 132   if ($arg =~ /^-/) {
 133     $tmp = $arg;
 134     $tmp =~ s/^-//;
 135     if (exists $beautify{$tmp}) {
 136       return '-' . $beautify{$tmp};
 137     }
 138   }
 139   if ($arg =~ /[0-9]L$/) {
 140     $arg =~ s/L$//;
 141   }
 142   return $arg;
 143 }
 144
 145 # Return a nicer representation of a complex number
 146 sub build_complex_beautify {
 147   my ($r, $i) = @_;
 148   my ($str1, $str2);
 149
 150   $str1 = &beautify ($r);
 151   $str2 = &beautify ($i);
 152   if ($str2 =~ /^-/) {
 153     $str2 =~ s/^-//;
 154     $str1 .= ' - ' . $str2;
 155   } else {
 156     $str1 .= ' + ' . $str2;
 157   }
 158   $str1 .= ' i';
 159   return $str1;
 160 }
 161
 162 # Return name of a variable
 163 sub get_variable {
 164   my ($number) = @_;
 165
 166   return "x" if ($number == 1);
 167   return "y" if ($number == 2);
 168   return "z" if ($number == 3);
 169   # return x1,x2,...
 170   $number =-3;
 171   return "x$number";
 172 }
 173
 174 # Add a new test to internal data structures and fill in the
 175 # ulps, failures and exception information for the C line.
 176 sub new_test {
 177   my ($test, $exception) = @_;
 178   my $rest;
 179
 180   # Add ulp, xfail
 181   if (exists $results{$test}{'has_ulps'}) {
 182     $rest = ", DELTA$count";
 183   } else {
 184     $rest = ', 0';
 185   }
 186   if (exists $results{$test}{'has_fails'}) {
 187     $rest .= ", FAIL$count";
 188   } else {
 189     $rest .= ', 0';
 190   }
 191   if (defined $exception) {
 192     $rest .= ", $exception";
 193   } else {
 194     $rest .= ', 0';
 195   }
 196   $rest .= ");\n";
 197   # We must increment here to keep @tests and count in sync
 198   push @tests, $test;
 199   ++$count;
 200   return $rest;
 201 }
 202
 203 # Treat some functions especially.
 204 # Currently only sincos needs extra treatment.
 205 sub special_functions {
 206   my ($file, $args) = @_;
 207   my (@args, $str, $test, $cline);
 208
 209   @args = split /,\s*/, $args;
 210
 211   unless ($args[0] =~ /sincos/) {
 212     die ("Don't know how to handle $args[0] extra.");
 213   }
 214   print $file "  FUNC (sincos) ($args[1], &sin_res, &cos_res);\n";
 215
 216   $str = 'sincos (' . &beautify ($args[1]) . ', &sin_res, &cos_res)';
 217   # handle sin
 218   $test = $str . ' puts ' . &beautify ($args[2]) . ' in sin_res';
 219   if ($#args == 4) {
 220     $test .= " plus " . &beautify ($args[4]);
 221   }
 222
 223   $cline = "  check_float (\"$test\", sin_res, $args[2]";
 224   $cline .= &new_test ($test, $args[4]);
 225   print $file $cline;
 226
 227   # handle cos
 228   $test = $str . ' puts ' . &beautify ($args[3]) . ' in cos_res';
 229   $cline = "  check_float (\"$test\", cos_res, $args[3]";
 230   # only tests once for exception
 231   $cline .= &new_test ($test, undef);
 232   print $file $cline;
 233 }
 234
 235 # Parse the arguments to TEST_x_y
 236 sub parse_args {
 237   my ($file, $descr, $fct, $args) = @_;
 238   my (@args, $str, $descr_args, $descr_res, @descr);
 239   my ($current_arg, $cline, $i);
 240   my ($pre, $post, @special);
 241   my ($extra_var, $call, $c_call);
 242
 243   if ($descr eq 'extra') {
 244     &special_functions ($file, $args);
 245     return;
 246   }
 247   ($descr_args, $descr_res) = split /_/,$descr, 2;
 248
 249   @args = split /,\s*/, $args;
 250
 251   $call = "$fct (";
 252
 253   # Generate first the string that's shown to the user
 254   $current_arg = 1;
 255   $extra_var = 0;
 256   @descr = split //,$descr_args;
 257   for ($i = 0; $i <= $#descr; $i++) {
 258     if ($i >= 1) {
 259       $call .= ', ';
 260     }
 261     # FLOAT, int, long int, long long int
 262     if ($descr[$i] =~ /f|i|l|L/) {
 263       $call .= &beautify ($args[$current_arg]);
 264       ++$current_arg;
 265       next;
 266     }
 267     # &FLOAT, &int - argument is added here
 268     if ($descr[$i] =~ /F|I/) {
 269       ++$extra_var;
 270       $call .= '&' . &get_variable ($extra_var);
 271       next;
 272     }
 273     # complex
 274     if ($descr[$i] eq 'c') {
 275       $call .= &build_complex_beautify ($args[$current_arg], $args[$current_arg+1]);
 276       $current_arg += 2;
 277       next;
 278     }
 279
 280     die ("$descr[$i] is unknown");
 281   }
 282   $call .= ')';
 283   $str = "$call == ";
 284
 285   # Result
 286   @descr = split //,$descr_res;
 287   foreach (@descr) {
 288     if ($_ =~ /f|i|l|L/) {
 289       $str .= &beautify ($args[$current_arg]);
 290       ++$current_arg;
 291     } elsif ($_ eq 'c') {
 292       $str .= &build_complex_beautify ($args[$current_arg], $args[$current_arg+1]);
 293       $current_arg += 2;
 294     } elsif ($_ eq 'b') {
 295       # boolean
 296       $str .= ($args[$current_arg] == 0) ? "false" : "true";
 297       ++$current_arg;
 298     } elsif ($_ eq '1') {
 299       ++$current_arg;
 300     } else {
 301       die ("$_ is unknown");
 302     }
 303   }
 304   # consistency check
 305   if ($current_arg == $#args) {
 306     die ("wrong number of arguments")
 307       unless ($args[$current_arg] =~ /EXCEPTION|IGNORE_ZERO_INF_SIGN/);
 308   } elsif ($current_arg < $#args) {
 309     die ("wrong number of arguments");
 310   } elsif ($current_arg > ($#args+1)) {
 311     die ("wrong number of arguments");
 312   }
 313
 314
 315   # check for exceptions
 316   if ($current_arg <= $#args) {
 317     $str .= " plus " . &beautify ($args[$current_arg]);
 318   }
 319
 320   # Put the C program line together
 321   # Reset some variables to start again
 322   $current_arg = 1;
 323   $extra_var = 0;
 324   if (substr($descr_res,0,1) eq 'f') {
 325     $cline = 'check_float'
 326   } elsif (substr($descr_res,0,1) eq 'b') {
 327     $cline = 'check_bool';
 328   } elsif (substr($descr_res,0,1) eq 'c') {
 329     $cline = 'check_complex';
 330   } elsif (substr($descr_res,0,1) eq 'i') {
 331     $cline = 'check_int';
 332   } elsif (substr($descr_res,0,1) eq 'l') {
 333     $cline = 'check_long';
 334   } elsif (substr($descr_res,0,1) eq 'L') {
 335     $cline = 'check_longlong';
 336   }
 337   # Special handling for some macros:
 338   $cline .= " (\"$str\", ";
 339   if ($args[0] =~ /fpclassify|isnormal|isfinite|signbit/) {
 340     $c_call = "$args[0] (";
 341   } else {
 342     $c_call = " FUNC($args[0]) (";
 343   }
 344   @descr = split //,$descr_args;
 345   for ($i=0; $i <= $#descr; $i++) {
 346     if ($i >= 1) {
 347       $c_call .= ', ';
 348     }
 349     # FLOAT, int, long int, long long int
 350     if ($descr[$i] =~ /f|i|l|L/) {
 351       $c_call .= $args[$current_arg];
 352       $current_arg++;
 353       next;
 354     }
 355     # &FLOAT, &int
 356     if ($descr[$i] =~ /F|I/) {
 357       ++$extra_var;
 358       $c_call .= '&' . &get_variable ($extra_var);
 359       next;
 360     }
 361     # complex
 362     if ($descr[$i] eq 'c') {
 363       $c_call .= "BUILD_COMPLEX ($args[$current_arg], $args[$current_arg+1])";
 364       $current_arg += 2;
 365       next;
 366     }
 367   }
 368   $c_call .= ')';
 369   $cline .= "$c_call, ";
 370
 371   @descr = split //,$descr_res;
 372   foreach (@descr) {
 373     if ($_ =~ /b|f|i|l|L/ ) {
 374       $cline .= $args[$current_arg];
 375       $current_arg++;
 376     } elsif ($_ eq 'c') {
 377       $cline .= "BUILD_COMPLEX ($args[$current_arg], $args[$current_arg+1])";
 378       $current_arg += 2;
 379     } elsif ($_ eq '1') {
 380       push @special, $args[$current_arg];
 381       ++$current_arg;
 382     }
 383   }
 384   # Add ulp, xfail
 385   $cline .= &new_test ($str, ($current_arg <= $#args) ? $args[$current_arg] : undef);
 386
 387   # special treatment for some functions
 388   if ($args[0] eq 'frexp') {
 389     if (defined $special[0] && $special[0] ne "IGNORE") {
 390       my ($str) = "$call sets x to $special[0]";
 391       $post = "  check_int (\"$str\", x, $special[0]";
 392       $post .= &new_test ($str, undef);
 393     }
 394   } elsif ($args[0] eq 'gamma' || $args[0] eq 'lgamma') {
 395     $pre = "  signgam = 0;\n";
 396     if (defined $special[0] && $special[0] ne "IGNORE") {
 397       my ($str) = "$call sets signgam to $special[0]";
 398       $post = "  check_int (\"$str\", signgam, $special[0]";
 399       $post .= &new_test ($str, undef);
 400     }
 401   } elsif ($args[0] eq 'modf') {
 402     if (defined $special[0] && $special[0] ne "IGNORE") {
 403       my ($str) = "$call sets x to $special[0]";
 404       $post = "  check_float (\"$str\", x, $special[0]";
 405       $post .= &new_test ($str, undef);
 406     }
 407   } elsif ($args[0] eq 'remquo') {
 408     if (defined $special[0] && $special[0] ne "IGNORE") {
 409       my ($str) = "$call sets x to $special[0]";
 410       $post = "  check_int (\"$str\", x, $special[0]";
 411       $post .= &new_test ($str, undef);
 412     }
 413   }
 414
 415   print $file $pre if (defined $pre);
 416
 417   print $file "  $cline";
 418
 419   print $file $post if (defined $post);
 420 }
 421
 422 # Generate libm-test.c
 423 sub generate_testfile {
 424   my ($input, $output) = @_;
 425   my ($lasttext);
 426   my (@args, $i, $str, $thisfct);
 427
 428   open INPUT, $input or die ("Can't open $input: $!");
 429   open OUTPUT, ">$output" or die ("Can't open $output: $!");
 430
 431   # Replace the special macros
 432   while (<INPUT>) {
 433
 434     # TEST_...
 435     if (/^\s*TEST_/) {
 436       my ($descr, $args);
 437       chop;
 438       ($descr, $args) = ($_ =~ /TEST_(\w+)\s*\((.*)\)/);
 439       &parse_args (\*OUTPUT, $descr, $thisfct, $args);
 440       next;
 441     }
 442     # START (function)
 443     if (/START/) {
 444       ($thisfct) = ($_ =~ /START\s*\((.*)\)/);
 445       print OUTPUT "  init_max_error ();\n";
 446       next;
 447     }
 448     # END (function)
 449     if (/END/) {
 450       my ($fct, $line, $type);
 451       if (/complex/) {
 452         s/,\s*complex\s*//;
 453         $type = 'complex';
 454       } else {
 455         $type = 'normal';
 456       }
 457       ($fct) = ($_ =~ /END\s*\((.*)\)/);
 458       if ($type eq 'complex') {
 459         $line = "  print_complex_max_error (\"$fct\", ";
 460       } else {
 461         $line = "  print_max_error (\"$fct\", ";
 462       }
 463       if (exists $results{$fct}{'has_ulps'}) {
 464         $line .= "DELTA$fct";
 465       } else {
 466         $line .= '0';
 467       }
 468       if (exists $results{$fct}{'has_fails'}) {
 469         $line .= ", FAIL$fct";
 470       } else {
 471         $line .= ', 0';
 472       }
 473       $line .= ");\n";
 474       print OUTPUT $line;
 475       push @functions, $fct;
 476       next;
 477     }
 478     print OUTPUT;
 479   }
 480   close INPUT;
 481   close OUTPUT;
 482 }
 483
 484
 485
 486 # Parse ulps file
 487 sub parse_ulps {
 488   my ($file) = @_;
 489   my ($test, $type, $float, $eps, $kind);
 490
 491   # $type has the following values:
 492   # "normal": No complex variable
 493   # "real": Real part of complex result
 494   # "imag": Imaginary part of complex result
 495   open ULP, $file  or die ("Can't open $file: $!");
 496   while (<ULP>) {
 497     chop;
 498     # ignore comments and empty lines
 499     next if /^#/;
 500     next if /^\s*$/;
 501     if (/^Test/) {
 502       if (/Real part of:/) {
 503         s/Real part of: //;
 504         $type = 'real';
 505       } elsif (/Imaginary part of:/) {
 506         s/Imaginary part of: //;
 507         $type = 'imag';
 508       } else {
 509         $type = 'normal';
 510       }
 511       s/^.+\"(.*)\".*$/$1/;
 512       $test = $_;
 513       $kind = 'test';
 514       next;
 515     }
 516     if (/^Function: /) {
 517       if (/Real part of/) {
 518         s/Real part of //;
 519         $type = 'real';
 520       } elsif (/Imaginary part of/) {
 521         s/Imaginary part of //;
 522         $type = 'imag';
 523       } else {
 524         $type = 'normal';
 525       }
 526       ($test) = ($_ =~ /^Function:\s*\"([a-zA-Z0-9_]+)\"/);
 527       $kind = 'fct';
 528       next;
 529     }
 530     if (/^i?(float|double|ldouble):/) {
 531       ($float, $eps) = split /\s*:\s*/,$_,2;
 532
 533       if ($eps eq 'fail') {
 534         $results{$test}{$type}{'fail'}{$float} = 1;
 535         $results{$test}{'has_fails'} = 1;
 536       } elsif ($eps eq "0") {
 537         # ignore
 538         next;
 539       } else {
 540         $results{$test}{$type}{'ulp'}{$float} = $eps;
 541         $results{$test}{'has_ulps'} = 1;
 542       }
 543       if ($type =~ /^real|imag$/) {
 544         $results{$test}{'type'} = 'complex';
 545       } elsif ($type eq 'normal') {
 546         $results{$test}{'type'} = 'normal';
 547       }
 548       $results{$test}{'kind'} = $kind;
 549       next;
 550     }
 551     print "Skipping unknown entry: `$_'\n";
 552   }
 553   close ULP;
 554 }
 555
 556
 557 # Clean up a floating point number
 558 sub clean_up_number {
 559   my ($number) = @_;
 560
 561   # Remove trailing zeros after the decimal point
 562   if ($number =~ /\./) {
 563     $number =~ s/0+$//;
 564     $number =~ s/\.$//;
 565   }
 566   return $number;
 567 }
 568
 569 # Output a file which can be read in as ulps file.
 570 sub print_ulps_file {
 571   my ($file) = @_;
 572   my ($test, $type, $float, $eps, $fct, $last_fct);
 573
 574   $last_fct = '';
 575   open NEWULP, ">$file" or die ("Can't open $file: $!");
 576   print NEWULP "# Begin of automatic generation\n";
 577   # first the function calls
 578   foreach $test (sort keys %results) {
 579     next if ($results{$test}{'kind'} ne 'test');
 580     foreach $type ('real', 'imag', 'normal') {
 581       if (exists $results{$test}{$type}) {
 582         if (defined $results{$test}) {
 583           ($fct) = ($test =~ /^(\w+)\s/);
 584           if ($fct ne $last_fct) {
 585             $last_fct = $fct;
 586             print NEWULP "\n# $fct\n";
 587           }
 588         }
 589         if ($type eq 'normal') {
 590           print NEWULP "Test \"$test\":\n";
 591         } elsif ($type eq 'real') {
 592           print NEWULP "Test \"Real part of: $test\":\n";
 593         } elsif ($type eq 'imag') {
 594           print NEWULP "Test \"Imaginary part of: $test\":\n";
 595         }
 596         foreach $float (@all_floats) {
 597           if (exists $results{$test}{$type}{'ulp'}{$float}) {
 598             print NEWULP "$float: ",
 599             &clean_up_number ($results{$test}{$type}{'ulp'}{$float}),
 600             "\n";
 601           }
 602           if (exists $results{$test}{$type}{'fail'}{$float}) {
 603             print NEWULP "$float: fail\n";
 604           }
 605         }
 606       }
 607     }
 608   }
 609   print NEWULP "\n# Maximal error of functions:\n";
 610
 611   foreach $fct (sort keys %results) {
 612     next if ($results{$fct}{'kind'} ne 'fct');
 613     foreach $type ('real', 'imag', 'normal') {
 614       if (exists $results{$fct}{$type}) {
 615         if ($type eq 'normal') {
 616           print NEWULP "Function: \"$fct\":\n";
 617         } elsif ($type eq 'real') {
 618           print NEWULP "Function: Real part of \"$fct\":\n";
 619         } elsif ($type eq 'imag') {
 620           print NEWULP "Function: Imaginary part of \"$fct\":\n";
 621         }
 622         foreach $float (@all_floats) {
 623           if (exists $results{$fct}{$type}{'ulp'}{$float}) {
 624             print NEWULP "$float: ",
 625             &clean_up_number ($results{$fct}{$type}{'ulp'}{$float}),
 626             "\n";
 627           }
 628           if (exists $results{$fct}{$type}{'fail'}{$float}) {
 629             print NEWULP "$float: fail\n";
 630           }
 631         }
 632         print NEWULP "\n";
 633       }
 634     }
 635   }
 636   print NEWULP "# end of automatic generation\n";
 637   close NEWULP;
 638 }
 639
 640 sub get_ulps {
 641   my ($test, $type, $float) = @_;
 642
 643   if ($type eq 'complex') {
 644     my ($res);
 645     # Return 0 instead of BUILD_COMPLEX (0,0)
 646     if (!exists $results{$test}{'real'}{'ulp'}{$float} &&
 647         !exists $results{$test}{'imag'}{'ulp'}{$float}) {
 648       return "0";
 649     }
 650     $res = 'BUILD_COMPLEX (';
 651     $res .= (exists $results{$test}{'real'}{'ulp'}{$float}
 652              ? $results{$test}{'real'}{'ulp'}{$float} : "0");
 653     $res .= ', ';
 654     $res .= (exists $results{$test}{'imag'}{'ulp'}{$float}
 655              ? $results{$test}{'imag'}{'ulp'}{$float} : "0");
 656     $res .= ')';
 657     return $res;
 658   }
 659   return (exists $results{$test}{'normal'}{'ulp'}{$float}
 660           ? $results{$test}{'normal'}{'ulp'}{$float} : "0");
 661 }
 662
 663 sub get_failure {
 664   my ($test, $type, $float) = @_;
 665   if ($type eq 'complex') {
 666     # return x,y
 667     my ($res);
 668     # Return 0 instead of BUILD_COMPLEX_INT (0,0)
 669     if (!exists $results{$test}{'real'}{'ulp'}{$float} &&
 670         !exists $results{$test}{'imag'}{'ulp'}{$float}) {
 671       return "0";
 672     }
 673     $res = 'BUILD_COMPLEX_INT (';
 674     $res .= (exists $results{$test}{'real'}{'fail'}{$float}
 675              ? $results{$test}{'real'}{'fail'}{$float} : "0");
 676     $res .= ', ';
 677     $res .= (exists $results{$test}{'imag'}{'fail'}{$float}
 678              ? $results{$test}{'imag'}{'fail'}{$float} : "0");
 679     $res .= ')';
 680     return $res;
 681   }
 682   return (exists $results{$test}{'normal'}{'fail'}{$float}
 683           ? $results{$test}{'normal'}{'fail'}{$float} : "0");
 684
 685 }
 686
 687 # Output the defines for a single test
 688 sub output_test {
 689   my ($file, $test, $name) = @_;
 690   my ($ldouble, $double, $float, $ildouble, $idouble, $ifloat);
 691   my ($type);
 692
 693   # Do we have ulps/failures?
 694   if (!exists $results{$test}{'type'}) {
 695     return;
 696   }
 697   $type = $results{$test}{'type'};
 698   if (exists $results{$test}{'has_ulps'}) {
 699     # XXX use all_floats (change order!)
 700     $ldouble = &get_ulps ($test, $type, "ldouble");
 701     $double = &get_ulps ($test, $type, "double");
 702     $float = &get_ulps ($test, $type, "float");
 703     $ildouble = &get_ulps ($test, $type, "ildouble");
 704     $idouble = &get_ulps ($test, $type, "idouble");
 705     $ifloat = &get_ulps ($test, $type, "ifloat");
 706     print $file "#define DELTA$name CHOOSE($ldouble, $double, $float, $ildouble, $idouble, $ifloat)\t/* $test  */\n";
 707   }
 708
 709   if (exists $results{$test}{'has_fails'}) {
 710     $ldouble = &get_failure ($test, "ldouble");
 711     $double = &get_failure ($test, "double");
 712     $float = &get_failure ($test, "float");
 713     $ildouble = &get_failure ($test, "ildouble");
 714     $idouble = &get_failure ($test, "idouble");
 715     $ifloat = &get_failure ($test, "ifloat");
 716     print $file "#define FAIL$name CHOOSE($ldouble, $double, $float $ildouble, $idouble, $ifloat)\t/* $test  */\n";
 717   }
 718 }
 719
 720 # Print include file
 721 sub output_ulps {
 722   my ($file, $ulps_filename) = @_;
 723   my ($i, $fct);
 724
 725   open ULP, ">$file" or die ("Can't open $file: $!");
 726
 727   print ULP "/* This file is automatically generated\n";
 728   print ULP "   from $ulps_filename with gen-libm-test.pl.\n";
 729   print ULP "   Don't change it - change instead the master files.  */\n\n";
 730
 731   print ULP "\n/* Maximal error of functions.  */\n";
 732   foreach $fct (@functions) {
 733     output_test (\*ULP, $fct, $fct);
 734   }
 735
 736   print ULP "\n/* Error of single function calls.  */\n";
 737   for ($i = 0; $i < $count; $i++) {
 738     output_test (\*ULP, $tests[$i], $i);
 739   }
 740   close ULP;
 741 }