(clean_up_number): Do not remove trailing 0s from integers.
[kopensolaris-gnu/glibc.git] / math / gen-libm-test.pl
index 275ba7b..0b0b8ca 100755 (executable)
@@ -1,38 +1,59 @@
 #!/usr/bin/perl -w
-
-# Copyright (C) 1999 Free Software Foundation, Inc.
+# Copyright (C) 1999, 2006 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 Library General Public License as
-# published by the Free Software Foundation; either version 2 of the
-# License, or (at your option) any later version.
+# 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
-# Library General Public License for more details.
+# Lesser General Public License for more details.
 
-# You should have received a copy of the GNU Library General Public
-# License along with the GNU C Library; see the file COPYING.LIB.  If not,
-# write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
+# You should have received a copy of the GNU Lesser General Public
+# License along with the GNU C Library; if not, write to the Free
+# Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+# 02111-1307 USA.
 
 # 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}{"kind"} is either "fct" or "test" and flags whether this
+# 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).
+# - $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}{"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
+
+
 use Getopt::Std;
 
 use strict;
 
 use vars qw ($input $output);
+use vars qw (%results);
 use vars qw (@tests @functions);
 use vars qw ($count);
-use vars qw (%ulps %failures);
-use vars qw (%beautify);
+use vars qw (%beautify @all_floats);
 use vars qw ($output_dir $ulps_file);
 
+# all_floats is sorted and contains all recognised float types
+@all_floats = ('double', 'float', 'idouble',
+              'ifloat', 'ildouble', 'ldouble');
+
 %beautify =
   ( "minus_zero" => "-0",
     "plus_zero" => "+0",
@@ -79,10 +100,10 @@ $ulps_file = 'libm-test-ulps';
 $output_dir = '';
 
 if ($opt_h) {
-  print "Usage: generate.pl [OPTIONS]\n";
+  print "Usage: gen-libm-test.pl [OPTIONS]\n";
   print " -h         print this help, then exit\n";
   print " -o DIR     directory where generated files will be placed\n";
-  print " -n         generate sorted file NewUlps from libm-test-ulps\n";
+  print " -n         only generate sorted file NewUlps from libm-test-ulps\n";
   print " -u FILE    input file with ulps\n";
   exit 0;
 }
@@ -96,8 +117,8 @@ $output = "${output_dir}libm-test.c";
 $count = 0;
 
 &parse_ulps ($ulps_file);
-&generate_testfile ($input, $output);
-&output_ulps ("${output_dir}libm-test-ulps.h", $ulps_file);
+&generate_testfile ($input, $output) unless ($opt_n);
+&output_ulps ("${output_dir}libm-test-ulps.h", $ulps_file) unless ($opt_n);
 &print_ulps_file ("${output_dir}NewUlps") if ($opt_n);
 
 # Return a nicer representation
@@ -157,12 +178,12 @@ sub new_test {
   my $rest;
 
   # Add ulp, xfail
-  if (exists $ulps{$test}) {
+  if (exists $results{$test}{'has_ulps'}) {
     $rest = ", DELTA$count";
   } else {
     $rest = ', 0';
   }
-  if (exists $failures{$test}) {
+  if (exists $results{$test}{'has_fails'}) {
     $rest .= ", FAIL$count";
   } else {
     $rest .= ', 0';
@@ -213,7 +234,7 @@ sub special_functions {
 
 # Parse the arguments to TEST_x_y
 sub parse_args {
-  my ($file, $descr, $args) = @_;
+  my ($file, $descr, $fct, $args) = @_;
   my (@args, $str, $descr_args, $descr_res, @descr);
   my ($current_arg, $cline, $i);
   my ($pre, $post, @special);
@@ -227,7 +248,7 @@ sub parse_args {
 
   @args = split /,\s*/, $args;
 
-  $call = "$args[0] (";
+  $call = "$fct (";
 
   # Generate first the string that's shown to the user
   $current_arg = 1;
@@ -393,7 +414,7 @@ sub parse_args {
 
   print $file $pre if (defined $pre);
 
-  print $file "  $cline\n";
+  print $file "  $cline";
 
   print $file $post if (defined $post);
 }
@@ -402,7 +423,7 @@ sub parse_args {
 sub generate_testfile {
   my ($input, $output) = @_;
   my ($lasttext);
-  my (@args, $i, $str);
+  my (@args, $i, $str, $thisfct);
 
   open INPUT, $input or die ("Can't open $input: $!");
   open OUTPUT, ">$output" or die ("Can't open $output: $!");
@@ -415,25 +436,36 @@ sub generate_testfile {
       my ($descr, $args);
       chop;
       ($descr, $args) = ($_ =~ /TEST_(\w+)\s*\((.*)\)/);
-      &parse_args (\*OUTPUT, $descr, $args);
+      &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);
+      my ($fct, $line, $type);
+      if (/complex/) {
+       s/,\s*complex\s*//;
+       $type = 'complex';
+      } else {
+       $type = 'normal';
+      }
       ($fct) = ($_ =~ /END\s*\((.*)\)/);
-      $line = "  print_max_error (\"$fct\", ";
-      if (exists $ulps{$fct}) {
+      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 $failures{$fct}) {
+      if (exists $results{$fct}{'has_fails'}) {
        $line .= ", FAIL$fct";
       } else {
        $line .= ', 0';
@@ -454,8 +486,12 @@ sub generate_testfile {
 # Parse ulps file
 sub parse_ulps {
   my ($file) = @_;
-  my ($test, $type, $eps);
+  my ($test, $type, $float, $eps, $kind);
 
+  # $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;
@@ -463,21 +499,53 @@ sub parse_ulps {
     next if /^#/;
     next if /^\s*$/;
     if (/^Test/) {
+      if (/Real part of:/) {
+       s/Real part of: //;
+       $type = 'real';
+      } elsif (/Imaginary part of:/) {
+       s/Imaginary part of: //;
+       $type = 'imag';
+      } else {
+       $type = 'normal';
+      }
       s/^.+\"(.*)\".*$/$1/;
       $test = $_;
+      $kind = 'test';
       next;
     }
-    if (/^Function/) {
-      ($test) = ($_ =~ /^Function\s*\"([a-zA-Z0-9_]+)\"/);
+    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_]+)\"/);
+      $kind = 'fct';
       next;
     }
     if (/^i?(float|double|ldouble):/) {
-      ($type, $eps) = split /\s*:\s*/,$_,2;
-      if ($eps eq "fail") {
-       $failures{$test}{$type} = 1;
+      ($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") {
+       # ignore
+       next;
       } else {
-       $ulps{$test}{$type} = $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';
+      }
+      $results{$test}{'kind'} = $kind;
       next;
     }
     print "Skipping unknown entry: `$_'\n";
@@ -485,64 +553,84 @@ sub parse_ulps {
   close ULP;
 }
 
-# Just for testing: Print all ulps
-sub print_ulps {
-  my ($test, $type, $eps);
-
-  foreach $test (keys %ulps) {
-    print "$test:\n";
-    foreach $type (keys %{$ulps{$test}}) {
-      print "$test: $type $ulps{$test}{$type}\n";
-    }
-  }
-}
 
 # Clean up a floating point number
 sub clean_up_number {
   my ($number) = @_;
 
-  # Remove trailing zeros
-  $number =~ s/0+$//;
-  $number =~ s/\.$//;
+  # 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, $eps, $fct, $last_fct);
+  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";
-  foreach $test (sort @tests) {
-    if (defined $ulps{$test} || defined $failures{$test}) {
-      ($fct) = ($test =~ /^(\w+)\s/);
-      if ($fct ne $last_fct) {
-       $last_fct = $fct;
-       print NEWULP "\n# $fct\n";
-      }
-      print NEWULP "Test \"$test\":\n";
-      foreach $type (sort keys %{$ulps{$test}}) {
-       print NEWULP "$type: ", &clean_up_number ($ulps{$test}{$type}), "\n";
-      }
-      foreach $type (sort keys %{$failures{$test}}) {
-       print NEWULP "$type: fail\n";
+  # first the function calls
+  foreach $test (sort keys %results) {
+    next if ($results{$test}{'kind'} ne 'test');
+    foreach $type ('real', 'imag', 'normal') {
+      if (exists $results{$test}{$type}) {
+       if (defined $results{$test}) {
+         ($fct) = ($test =~ /^(\w+)\s/);
+         if ($fct ne $last_fct) {
+           $last_fct = $fct;
+           print NEWULP "\n# $fct\n";
+         }
+       }
+       if ($type eq 'normal') {
+         print NEWULP "Test \"$test\":\n";
+       } elsif ($type eq 'real') {
+         print NEWULP "Test \"Real part of: $test\":\n";
+       } elsif ($type eq 'imag') {
+         print NEWULP "Test \"Imaginary part of: $test\":\n";
+       }
+       foreach $float (@all_floats) {
+         if (exists $results{$test}{$type}{'ulp'}{$float}) {
+           print NEWULP "$float: ",
+           &clean_up_number ($results{$test}{$type}{'ulp'}{$float}),
+           "\n";
+         }
+         if (exists $results{$test}{$type}{'fail'}{$float}) {
+           print NEWULP "$float: fail\n";
+         }
+       }
       }
     }
   }
   print NEWULP "\n# Maximal error of functions:\n";
 
-  foreach $fct (sort @functions) {
-    if (defined $ulps{$fct} || defined $failures{$fct}) {
-      print NEWULP "Function \"$fct\":\n";
-      foreach $type (sort keys %{$ulps{$fct}}) {
-       print NEWULP "$type: ", &clean_up_number ($ulps{$fct}{$type}), "\n";
-      }
-      foreach $type (sort keys %{$failures{$fct}}) {
-       print NEWULP "$type: fail\n";
+  foreach $fct (sort keys %results) {
+    next if ($results{$fct}{'kind'} ne 'fct');
+    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";
+         }
+         if (exists $results{$fct}{$type}{'fail'}{$float}) {
+           print NEWULP "$float: fail\n";
+         }
+       }
+       print NEWULP "\n";
       }
-      print NEWULP "\n";
     }
   }
   print NEWULP "# end of automatic generation\n";
@@ -550,30 +638,75 @@ sub print_ulps_file {
 }
 
 sub get_ulps {
-  my ($test, $float) = @_;
-  return exists $ulps{$test}{$float} ? $ulps{$test}{$float} : "0";
+  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");
 }
 
 sub get_failure {
-  my ($test, $float) = @_;
-  return exists $failures{$test}{$float} ? $failures{$test}{$float} : "0";
+  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) = @_;
   my ($ldouble, $double, $float, $ildouble, $idouble, $ifloat);
+  my ($type);
 
-  if (exists $ulps{$test}) {
-    $ldouble = &get_ulps ($test, "ldouble");
-    $double = &get_ulps ($test, "double");
-    $float = &get_ulps ($test, "float");
-    $ildouble = &get_ulps ($test, "ildouble");
-    $idouble = &get_ulps ($test, "idouble");
-    $ifloat = &get_ulps ($test, "ifloat");
+  # 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");
+    $double = &get_ulps ($test, $type, "double");
+    $float = &get_ulps ($test, $type, "float");
+    $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 $failures{$test}) {
+
+  if (exists $results{$test}{'has_fails'}) {
     $ldouble = &get_failure ($test, "ldouble");
     $double = &get_failure ($test, "double");
     $float = &get_failure ($test, "float");