test/math/gen-libm-test.pl

   1 #!/usr/bin/perl -w
   2 # Copyright (C) 1999 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, $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 = "$args[0] (";
 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);
 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, $args);
 440       next;
 441     }
 442     # START (function)
 443     if (/START/) {
 444       print OUTPUT "  init_max_error ();\n";
 445       next;
 446     }
 447     # END (function)
 448     if (/END/) {
 449       my ($fct, $line, $type);
 450       if (/complex/) {
 451         s/,\s*complex\s*//;
 452         $type = 'complex';
 453       } else {
 454         $type = 'normal';
 455       }
 456       ($fct) = ($_ =~ /END\s*\((.*)\)/);
 457       if ($type eq 'complex') {
 458         $line = "  print_complex_max_error (\"$fct\", ";
 459       } else {
 460         $line = "  print_max_error (\"$fct\", ";
 461       }
 462       if (exists $results{$fct}{'has_ulps'}) {
 463         $line .= "DELTA$fct";
 464       } else {
 465         $line .= '0';
 466       }
 467       if (exists $results{$fct}{'has_fails'}) {
 468         $line .= ", FAIL$fct";
 469       } else {
 470         $line .= ', 0';
 471       }
 472       $line .= ");\n";
 473       print OUTPUT $line;
 474       push @functions, $fct;
 475       next;
 476     }
 477     print OUTPUT;
 478   }
 479   close INPUT;
 480   close OUTPUT;
 481 }
 482
 483
 484
 485 # Parse ulps file
 486 sub parse_ulps {
 487   my ($file) = @_;
 488   my ($test, $type, $float, $eps, $kind);
 489
 490   # $type has the following values:
 491   # "normal": No complex variable
 492   # "real": Real part of complex result
 493   # "imag": Imaginary part of complex result
 494   open ULP, $file  or die ("Can't open $file: $!");
 495   while (<ULP>) {
 496     chop;
 497     # ignore comments and empty lines
 498     next if /^#/;
 499     next if /^\s*$/;
 500     if (/^Test/) {
 501       if (/Real part of:/) {
 502         s/Real part of: //;
 503         $type = 'real';
 504       } elsif (/Imaginary part of:/) {
 505         s/Imaginary part of: //;
 506         $type = 'imag';
 507       } else {
 508         $type = 'normal';
 509       }
 510       s/^.+\"(.*)\".*$/$1/;
 511       $test = $_;
 512       $kind = 'test';
 513       next;
 514     }
 515     if (/^Function: /) {
 516       if (/Real part of/) {
 517         s/Real part of //;
 518         $type = 'real';
 519       } elsif (/Imaginary part of/) {
 520         s/Imaginary part of //;
 521         $type = 'imag';
 522       } else {
 523         $type = 'normal';
 524       }
 525       ($test) = ($_ =~ /^Function:\s*\"([a-zA-Z0-9_]+)\"/);
 526       $kind = 'fct';
 527       next;
 528     }
 529     if (/^i?(float|double|ldouble):/) {
 530       ($float, $eps) = split /\s*:\s*/,$_,2;
 531
 532       if ($eps eq 'fail') {
 533         $results{$test}{$type}{'fail'}{$float} = 1;
 534         $results{$test}{'has_fails'} = 1;
 535       } elsif ($eps eq "0") {
 536         # ignore
 537         next;
 538       } else {
 539         $results{$test}{$type}{'ulp'}{$float} = $eps;
 540         $results{$test}{'has_ulps'} = 1;
 541       }
 542       if ($type =~ /^real|imag$/) {
 543         $results{$test}{'type'} = 'complex';
 544       } elsif ($type eq 'normal') {
 545         $results{$test}{'type'} = 'normal';
 546       }
 547       $results{$test}{'kind'} = $kind;
 548       next;
 549     }
 550     print "Skipping unknown entry: `$_'\n";
 551   }
 552   close ULP;
 553 }
 554
 555
 556 # Clean up a floating point number
 557 sub clean_up_number {
 558   my ($number) = @_;
 559
 560   # Remove trailing zeros
 561   $number =~ s/0+$//;
 562   $number =~ s/\.$//;
 563   return $number;
 564 }
 565
 566 # Output a file which can be read in as ulps file.
 567 sub print_ulps_file {
 568   my ($file) = @_;
 569   my ($test, $type, $float, $eps, $fct, $last_fct);
 570
 571   $last_fct = '';
 572   open NEWULP, ">$file" or die ("Can't open $file: $!");
 573   print NEWULP "# Begin of automatic generation\n";
 574   # first the function calls
 575   foreach $test (sort keys %results) {
 576     next if ($results{$test}{'kind'} ne 'test');
 577     foreach $type ('real', 'imag', 'normal') {
 578       if (exists $results{$test}{$type}) {
 579         if (defined $results{$test}) {
 580           ($fct) = ($test =~ /^(\w+)\s/);
 581           if ($fct ne $last_fct) {
 582             $last_fct = $fct;
 583             print NEWULP "\n# $fct\n";
 584           }
 585         }
 586         if ($type eq 'normal') {
 587           print NEWULP "Test \"$test\":\n";
 588         } elsif ($type eq 'real') {
 589           print NEWULP "Test \"Real part of: $test\":\n";
 590         } elsif ($type eq 'imag') {
 591           print NEWULP "Test \"Imaginary part of: $test\":\n";
 592         }
 593         foreach $float (@all_floats) {
 594           if (exists $results{$test}{$type}{'ulp'}{$float}) {
 595             print NEWULP "$float: ",
 596             &clean_up_number ($results{$test}{$type}{'ulp'}{$float}),
 597             "\n";
 598           }
 599           if (exists $results{$test}{$type}{'fail'}{$float}) {
 600             print NEWULP "$float: fail\n";
 601           }
 602         }
 603       }
 604     }
 605   }
 606   print NEWULP "\n# Maximal error of functions:\n";
 607
 608   foreach $fct (sort keys %results) {
 609     next if ($results{$fct}{'kind'} ne 'fct');
 610     foreach $type ('real', 'imag', 'normal') {
 611       if (exists $results{$fct}{$type}) {
 612         if ($type eq 'normal') {
 613           print NEWULP "Function: \"$fct\":\n";
 614         } elsif ($type eq 'real') {
 615           print NEWULP "Function: Real part of \"$fct\":\n";
 616         } elsif ($type eq 'imag') {
 617           print NEWULP "Function: Imaginary part of \"$fct\":\n";
 618         }
 619         foreach $float (@all_floats) {
 620           if (exists $results{$fct}{$type}{'ulp'}{$float}) {
 621             print NEWULP "$float: ",
 622             &clean_up_number ($results{$fct}{$type}{'ulp'}{$float}),
 623             "\n";
 624           }
 625           if (exists $results{$fct}{$type}{'fail'}{$float}) {
 626             print NEWULP "$float: fail\n";
 627           }
 628         }
 629         print NEWULP "\n";
 630       }
 631     }
 632   }
 633   print NEWULP "# end of automatic generation\n";
 634   close NEWULP;
 635 }
 636
 637 sub get_ulps {
 638   my ($test, $type, $float) = @_;
 639
 640   if ($type eq 'complex') {
 641     my ($res);
 642     # Return 0 instead of BUILD_COMPLEX (0,0)
 643     if (!exists $results{$test}{'real'}{'ulp'}{$float} &&
 644         !exists $results{$test}{'imag'}{'ulp'}{$float}) {
 645       return "0";
 646     }
 647     $res = 'BUILD_COMPLEX (';
 648     $res .= (exists $results{$test}{'real'}{'ulp'}{$float}
 649              ? $results{$test}{'real'}{'ulp'}{$float} : "0");
 650     $res .= ', ';
 651     $res .= (exists $results{$test}{'imag'}{'ulp'}{$float}
 652              ? $results{$test}{'imag'}{'ulp'}{$float} : "0");
 653     $res .= ')';
 654     return $res;
 655   }
 656   return (exists $results{$test}{'normal'}{'ulp'}{$float}
 657           ? $results{$test}{'normal'}{'ulp'}{$float} : "0");
 658 }
 659
 660 sub get_failure {
 661   my ($test, $type, $float) = @_;
 662   if ($type eq 'complex') {
 663     # return x,y
 664     my ($res);
 665     # Return 0 instead of BUILD_COMPLEX_INT (0,0)
 666     if (!exists $results{$test}{'real'}{'ulp'}{$float} &&
 667         !exists $results{$test}{'imag'}{'ulp'}{$float}) {
 668       return "0";
 669     }
 670     $res = 'BUILD_COMPLEX_INT (';
 671     $res .= (exists $results{$test}{'real'}{'fail'}{$float}
 672              ? $results{$test}{'real'}{'fail'}{$float} : "0");
 673     $res .= ', ';
 674     $res .= (exists $results{$test}{'imag'}{'fail'}{$float}
 675              ? $results{$test}{'imag'}{'fail'}{$float} : "0");
 676     $res .= ')';
 677     return $res;
 678   }
 679   return (exists $results{$test}{'normal'}{'fail'}{$float}
 680           ? $results{$test}{'normal'}{'fail'}{$float} : "0");
 681
 682 }
 683
 684 # Output the defines for a single test
 685 sub output_test {
 686   my ($file, $test, $name) = @_;
 687   my ($ldouble, $double, $float, $ildouble, $idouble, $ifloat);
 688   my ($type);
 689
 690   # Do we have ulps/failures?
 691   if (!exists $results{$test}{'type'}) {
 692     return;
 693   }
 694   $type = $results{$test}{'type'};
 695   if (exists $results{$test}{'has_ulps'}) {
 696     # XXX use all_floats (change order!)
 697     $ldouble = &get_ulps ($test, $type, "ldouble");
 698     $double = &get_ulps ($test, $type, "double");
 699     $float = &get_ulps ($test, $type, "float");
 700     $ildouble = &get_ulps ($test, $type, "ildouble");
 701     $idouble = &get_ulps ($test, $type, "idouble");
 702     $ifloat = &get_ulps ($test, $type, "ifloat");
 703     print $file "#define DELTA$name CHOOSE($ldouble, $double, $float, $ildouble, $idouble, $ifloat)\t/* $test  */\n";
 704   }
 705
 706   if (exists $results{$test}{'has_fails'}) {
 707     $ldouble = &get_failure ($test, "ldouble");
 708     $double = &get_failure ($test, "double");
 709     $float = &get_failure ($test, "float");
 710     $ildouble = &get_failure ($test, "ildouble");
 711     $idouble = &get_failure ($test, "idouble");
 712     $ifloat = &get_failure ($test, "ifloat");
 713     print $file "#define FAIL$name CHOOSE($ldouble, $double, $float $ildouble, $idouble, $ifloat)\t/* $test  */\n";
 714   }
 715 }
 716
 717 # Print include file
 718 sub output_ulps {
 719   my ($file, $ulps_filename) = @_;
 720   my ($i, $fct);
 721
 722   open ULP, ">$file" or die ("Can't open $file: $!");
 723
 724   print ULP "/* This file is automatically generated\n";
 725   print ULP "   from $ulps_filename with gen-libm-test.pl.\n";
 726   print ULP "   Don't change it - change instead the master files.  */\n\n";
 727
 728   print ULP "\n/* Maximal error of functions.  */\n";
 729   foreach $fct (@functions) {
 730     output_test (\*ULP, $fct, $fct);
 731   }
 732
 733   print ULP "\n/* Error of single function calls.  */\n";
 734   for ($i = 0; $i < $count; $i++) {
 735     output_test (\*ULP, $tests[$i], $i);
 736   }
 737   close ULP;
 738 }