math/gen-libm-test.pl

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