Makefile.am (gfor_helper_src): Add runtime/normalize.f90.

	* Makefile.am (gfor_helper_src): Add runtime/normalize.f90.
	* configure.ac: Add checks for nextafter and nextafterf.
	* Makefile.in, config.h.in, configure: Regenerate.
	* libgfortran.h (normalize_r4_i4, normalize_r8_i8): Declare.
	* intrinsics/rand.c (rand): Use normalize_r4_i4.
	* intrinsics/random.c (random_r4): Use normalize_r4_i4.
	(random_r8): Use normalize_r8_i8.
	* runtime/normalize.c: New file.
testsuite/
	* gfortran.fortran-torture/execute/random_2.f90: New test.

From-SVN: r83070

gcc/testsuite/ChangeLog

+2004-06-13  Paul Brook  <paul@codesourcery.com>
+
+	* gfortran.fortran-torture/execute/random_2.f90: New test.
+
 2004-06-13  Eric Christopher  <echristo@redhat.com>
 
 	* gcc.dg/noncompile/redecl-1.c: Fix error message.

gcc/testsuite/gfortran.fortran-torture/execute/random_2.f90

+! Check that the real(4) and real(8) random number generators return the same
+! sequence of values.
+program random_4
+  integer, dimension(:), allocatable :: seed
+  real(kind=4), dimension(10) :: r4
+  real(kind=8), dimension(10) :: r8
+  real, parameter :: delta = 0.0001
+  integer n
+
+  call random_seed (size=n)
+  allocate (seed(n))
+  call random_seed (get=seed)
+  ! Test both array valued and scalar routines.
+  call random_number(r4)
+  call random_number (r4(10))
+
+  ! Reset the seed and get the real(8) values.
+  call random_seed (put=seed)
+  call random_number(r8)
+  call random_number (r8(10))
+
+  if (any ((r4 - r8) .gt. delta)) call abort
+end program
+

libgfortran/ChangeLog

+2004-06-13  Paul Brook  <paul@codesourcery.com>
+
+	* Makefile.am (gfor_helper_src): Add runtime/normalize.f90.
+	* configure.ac: Add checks for nextafter and nextafterf.
+	* Makefile.in, config.h.in, configure: Regenerate.
+	* libgfortran.h (normalize_r4_i4, normalize_r8_i8): Declare.
+	* intrinsics/rand.c (rand): Use normalize_r4_i4.
+	* intrinsics/random.c (random_r4): Use normalize_r4_i4.
+	(random_r8): Use normalize_r8_i8.
+	* runtime/normalize.c: New file.
+
 2004-06-13  Steven G. Kargl  <kargls@comcast.net>
 	    Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
 

libgfortran/Makefile.am

@@ -58,7 +58,8 @@ intrinsics/system_clock.c \
 intrinsics/transpose_generic.c \
 intrinsics/unpack_generic.c \
 runtime/in_pack_generic.c \
-runtime/in_unpack_generic.c
+runtime/in_unpack_generic.c \
+runtime/normalize.c
 
 gfor_src= \
 runtime/environ.c \

libgfortran/Makefile.in

@@ -124,7 +124,7 @@ am__objects_33 = associated.lo abort.lo args.lo c99_functions.lo \
 	spread_generic.lo string_intrinsics.lo rand.lo random.lo \
 	reshape_generic.lo reshape_packed.lo selected_kind.lo \
 	system_clock.lo transpose_generic.lo unpack_generic.lo \
-	in_pack_generic.lo in_unpack_generic.lo
+	in_pack_generic.lo in_unpack_generic.lo normalize.lo
 am__objects_34 =
 am__objects_35 = _abs_c4.lo _abs_c8.lo _abs_i4.lo _abs_i8.lo \
 	_abs_r4.lo _abs_r8.lo _exp_r4.lo _exp_r8.lo _exp_c4.lo \
@@ -331,7 +331,8 @@ intrinsics/system_clock.c \
 intrinsics/transpose_generic.c \
 intrinsics/unpack_generic.c \
 runtime/in_pack_generic.c \
-runtime/in_unpack_generic.c
+runtime/in_unpack_generic.c \
+runtime/normalize.c
 
 gfor_src = \
 runtime/environ.c \
@@ -2177,6 +2178,15 @@ in_unpack_generic.obj: runtime/in_unpack_generic.c
 in_unpack_generic.lo: runtime/in_unpack_generic.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_generic.lo `test -f 'runtime/in_unpack_generic.c' || echo '$(srcdir)/'`runtime/in_unpack_generic.c
 
+normalize.o: runtime/normalize.c
+	$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o normalize.o `test -f 'runtime/normalize.c' || echo '$(srcdir)/'`runtime/normalize.c
+
+normalize.obj: runtime/normalize.c
+	$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o normalize.obj `if test -f 'runtime/normalize.c'; then $(CYGPATH_W) 'runtime/normalize.c'; else $(CYGPATH_W) '$(srcdir)/runtime/normalize.c'; fi`
+
+normalize.lo: runtime/normalize.c
+	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o normalize.lo `test -f 'runtime/normalize.c' || echo '$(srcdir)/'`runtime/normalize.c
+
 trig_c4.o: generated/trig_c4.c
 	$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o trig_c4.o `test -f 'generated/trig_c4.c' || echo '$(srcdir)/'`generated/trig_c4.c
 

libgfortran/config.h.in

@@ -27,6 +27,12 @@
 /* Define to 1 if you have a working `mmap' system call. */
 #undef HAVE_MMAP
 
+/* libm includes nextafter */
+#undef HAVE_NEXTAFTER
+
+/* libm includes nextafterf */
+#undef HAVE_NEXTAFTERF
+
 /* "c99 function" */
 #undef HAVE_ROUND
 

libgfortran/configure

@@ -6538,6 +6538,149 @@ _ACEOF
 
 fi
 
+# And other IEEE math functions
+echo "$as_me:$LINENO: checking for nextafter in -lm" >&5
+echo $ECHO_N "checking for nextafter in -lm... $ECHO_C" >&6
+if test "${ac_cv_lib_m_nextafter+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm  $LIBS"
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+/* Override any gcc2 internal prototype to avoid an error.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+   builtin and then its argument prototype would still apply.  */
+char nextafter ();
+int
+main ()
+{
+nextafter ();
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+  (eval $ac_link) 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } &&
+	 { ac_try='test -z "$ac_c_werror_flag"			 || test ! -s conftest.err'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; } &&
+	 { ac_try='test -s conftest$ac_exeext'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+  ac_cv_lib_m_nextafter=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_lib_m_nextafter=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+      conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_m_nextafter" >&5
+echo "${ECHO_T}$ac_cv_lib_m_nextafter" >&6
+if test $ac_cv_lib_m_nextafter = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_NEXTAFTER 1
+_ACEOF
+
+fi
+
+echo "$as_me:$LINENO: checking for nextafterf in -lm" >&5
+echo $ECHO_N "checking for nextafterf in -lm... $ECHO_C" >&6
+if test "${ac_cv_lib_m_nextafterf+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm  $LIBS"
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+/* Override any gcc2 internal prototype to avoid an error.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+   builtin and then its argument prototype would still apply.  */
+char nextafterf ();
+int
+main ()
+{
+nextafterf ();
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+  (eval $ac_link) 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } &&
+	 { ac_try='test -z "$ac_c_werror_flag"			 || test ! -s conftest.err'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; } &&
+	 { ac_try='test -s conftest$ac_exeext'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+  ac_cv_lib_m_nextafterf=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_lib_m_nextafterf=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+      conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_m_nextafterf" >&5
+echo "${ECHO_T}$ac_cv_lib_m_nextafterf" >&6
+if test $ac_cv_lib_m_nextafterf = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_NEXTAFTERF 1
+_ACEOF
+
+fi
+
 
 # Let the user override this
 # Check whether --enable-cmath or --disable-cmath was given.

libgfortran/configure.ac

@@ -169,6 +169,9 @@ AC_CHECK_FUNCS(getrusage times)
 # Check for some C99 functions
 AC_CHECK_LIB([m],[round],[AC_DEFINE([HAVE_ROUND],[1],["c99 function"])])
 AC_CHECK_LIB([m],[roundf],[AC_DEFINE([HAVE_ROUNDF],[1],["c99 function"])])
+# And other IEEE math functions
+AC_CHECK_LIB([m],[nextafter],[AC_DEFINE([HAVE_NEXTAFTER],[1],[libm includes nextafter])])
+AC_CHECK_LIB([m],[nextafterf],[AC_DEFINE([HAVE_NEXTAFTERF],[1],[libm includes nextafterf])])
 
 # Let the user override this
 AC_ARG_ENABLE(cmath,

libgfortran/intrinsics/rand.c

@@ -77,17 +77,10 @@ prefix(irand) (GFC_INTEGER_4 *i)
 }
 
 
-/*  Return a REAL in the range [0,1).  Cast to double to use the full
-    range of pseudo-random numbers returned by irand().  */
+/*  Return a random REAL in the range [0,1).  */
 
 GFC_REAL_4
 prefix(rand) (GFC_INTEGER_4 *i)
 {
-  GFC_REAL_4 val;
-
-  do 
-    val = (GFC_REAL_4)((double)(prefix(irand) (i) - 1) / (double) GFC_RAND_M1);
-  while (val == 1.0);
-
-  return val;
+  return normalize_r4_i4 (i - 1, GFC_RAND_M1);
 }

libgfortran/intrinsics/random.c

@@ -458,16 +458,11 @@ prefix(random_r4) (GFC_REAL_4 *x)
 
   GFC_UINTEGER_4 kiss;
 
-  do
-    {
-      kiss = kiss_random_kernel ();
-      *x = (GFC_REAL_4)kiss / (GFC_REAL_4)(~(GFC_UINTEGER_4) 0);
-      /* Burn a random number, so the REAL*4 and REAL*8 functions
-         produce similar sequences of random numbers.  */
-      kiss = kiss_random_kernel ();
-    }
-  while (*x == 1.0);
-
+  kiss = kiss_random_kernel ();
+  /* Burn a random number, so the REAL*4 and REAL*8 functions
+     produce similar sequences of random numbers.  */
+  kiss_random_kernel ();
+  *x = normalize_r4_i4 (kiss, ~(GFC_UINTEGER_4) 0);
 }
 
 /*  This function produces a REAL(8) value from the uniform distribution
@@ -479,14 +474,9 @@ prefix(random_r8) (GFC_REAL_8 *x)
 
   GFC_UINTEGER_8 kiss;
 
-  do
-    {
-      kiss = (((GFC_UINTEGER_8)kiss_random_kernel ()) << 32)
-	     + kiss_random_kernel ();
-      *x = (GFC_REAL_8)kiss / (GFC_REAL_8)(~(GFC_UINTEGER_8) 0);
-    }
-  while (*x == 1.0);
-
+  kiss = ((GFC_UINTEGER_8)kiss_random_kernel ()) << 32;
+  kiss += kiss_random_kernel ();
+  *x = normalize_r8_i8 (kiss, ~(GFC_UINTEGER_8) 0);
 }
 
 /*  This function fills a REAL(4) array with values from the uniform

libgfortran/libgfortran.h

@@ -408,5 +408,13 @@ GFC_INTEGER_4 compare_string (GFC_INTEGER_4, const char *,
 void random_seed (GFC_INTEGER_4 * size, gfc_array_i4 * put,
 		  gfc_array_i4 * get);
 
+/* normalize.c */
+
+#define normalize_r4_i4 prefix(normalize_r4_i4)
+GFC_REAL_4 normalize_r4_i4 (GFC_UINTEGER_4, GFC_UINTEGER_4);
+
+#define normalize_r8_i8 prefix(normalize_r8_i8)
+GFC_REAL_8 normalize_r8_i8 (GFC_UINTEGER_8, GFC_UINTEGER_8);
+
 #endif
 

libgfortran/runtime/normalize.c

+/* Nelper routines to convert from integer to real.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+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.
+
+Ligbfortran 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 Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with libgfor; see the file COPYING.LIB.  If not,
+write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+#include <math.h>
+#include "libgfortran.h"
+
+/* These routines can be sensitive to excess precision, so should really be
+   compiled with -ffloat-store.  */
+
+/* Return the largest value less than one representable in a REAL*4.  */
+
+static inline GFC_REAL_4
+almostone_r4 ()
+{
+#ifdef HAVE_NEXTAFTERF
+  return nextafterf (1.0f, 0.0f);
+#else
+  /* The volatile is a hack to prevent excess precision on x86.  */
+  static volatile GFC_REAL_4 val = 0.0f;
+  GFC_REAL_4 x;
+
+  if (val != 0.0f)
+    return val;
+
+  val = 0.9999f;
+  do
+    {
+      x = val;
+      val = (val + 1.0f) / 2.0f;
+    }
+  while (val > x && val < 1.0f);
+  if (val == 1.0f)
+    val = x;
+  return val;
+#endif
+}
+
+
+/* Return the largest value less than one representable in a REAL*8.  */
+
+static inline GFC_REAL_8
+almostone_r8 ()
+{
+#ifdef HAVE_NEXTAFTER
+  return nextafter (1.0, 0.0);
+#else
+  static volatile GFC_REAL_8 val = 0.0;
+  GFC_REAL_8 x;
+
+  if (val != 0.0)
+    return val;
+
+  val = 0.9999;
+  do
+    {
+      x = val;
+      val = (val + 1.0) / 2.0;
+    }
+  while (val > x && val < 1.0);
+  if (val == 1.0)
+    val = x;
+  return val;
+#endif
+}
+
+
+/* Convert an unsigned integer in the range [0..x) into a
+   real the range [0..1).  */
+
+GFC_REAL_4
+normalize_r4_i4 (GFC_UINTEGER_4 i, GFC_UINTEGER_4 x)
+{
+  GFC_REAL_4 r;
+
+  r = (GFC_REAL_4) i / (GFC_REAL_4) x;
+  if (r == 1.0f)
+    r = almostone_r4 ();
+  return r;
+}
+
+
+/* Convert an unsigned integer in the range [0..x) into a
+   real the range [0..1).  */
+
+GFC_REAL_8
+normalize_r8_i8 (GFC_UINTEGER_8 i, GFC_UINTEGER_8 x)
+{
+  GFC_REAL_8 r;
+
+  r = (GFC_REAL_8) i / (GFC_REAL_8) x;
+  if (r == 1.0)
+    r = almostone_r8 ();
+  return r;
+}