svn merge -r116389:116498 svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_1-branch

git-svn-id: https://gcc.gnu.org/svn/gcc/branches/redhat/gcc-4_1-branch@116525 138bc75d-0d04-0410-961f-82ee72b054a4

43 files changed, 752 insertions, 207 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 120d3f58552..d3c12de286f 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,36 @@
+2006-08-25  Joseph S. Myers  <joseph@codesourcery.com>
+
+	PR c/27893
+	* gimplify.c (gimplify_decl_expr, gimplify_init_ctor_preeval):
+	Treat sizes as variable whenever not INTEGER_CST.
+
+2006-08-25  Fariborz Jahanian  <fjahanian@apple.com>
+
+	PR c/28418
+	* c-gimplify.c (gimplify_compound_literal_expr): Don't add
+	variable again if DECL_SEEN_IN_BIND_EXPR_P.
+
+2006-08-25  Joseph S. Myers  <joseph@codesourcery.com>
+
+	PR c/28299
+	* c-decl.c (start_function): Don't try to process prototype
+	information from old declaration that isn't a function.
+
+2006-08-25  Joseph Myers  <joseph@codesourcery.com>
+
+	PR c/27558
+	Backport:
+	2006-04-20  Jakub Jelinek  <jakub@redhat.com>
+	* c-pretty-print.c (pp_c_direct_abstract_declarator): Print
+	TYPE_MAX_VALUE (TYPE_DOMAIN (t)) + 1 for ARRAY_TYPE rather
+	than plain TYPE_MAX_VALUE (TYPE_DOMAIN (t)).
+
+2006-08-25  Alan Modra  <amodra@bigpond.net.au>
+
+	PR target/27075
+	* config/rs6000/rs6000.c (print_operand): Only use e500 %y syntax
+	for 8 byte objects.
+
 2006-07-20  Jason Merrill  <jason@redhat.com>
 
 	* tree.c (remove_attribute): New fn.
@@ -1100,12 +1133,6 @@
 	* config/i386/sse.md (*vec_extractv2di_1_sse2): New.
 	(*vec_extractv2di_1_sse): New.
 
-2006-04-20  Jakub Jelinek  <jakub@redhat.com>
-
-	* c-pretty-print.c (pp_c_direct_abstract_declarator): Print
-	TYPE_MAX_VALUE (TYPE_DOMAIN (t)) + 1 for ARRAY_TYPE rather
-	than plain TYPE_MAX_VALUE (TYPE_DOMAIN (t)).
-
 2006-05-08  Alan Modra  <amodra@bigpond.net.au>
 
 	PR middle-end/27260
diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP
index cb46de17cf2..3173ae01a74 100644
--- a/gcc/DATESTAMP
+++ b/gcc/DATESTAMP
@@ -1 +1 @@
-20060825
+20060828
diff --git a/gcc/c-decl.c b/gcc/c-decl.c
index 44a9b6f87da..9248cc6c911 100644
--- a/gcc/c-decl.c
+++ b/gcc/c-decl.c
@@ -5940,6 +5940,8 @@ start_function (struct c_declspecs *declspecs, struct c_declarator *declarator,
   /* If this definition isn't a prototype and we had a prototype declaration
      before, copy the arg type info from that prototype.  */
   old_decl = lookup_name_in_scope (DECL_NAME (decl1), current_scope);
+  if (old_decl && TREE_CODE (old_decl) != FUNCTION_DECL)
+    old_decl = 0;
   current_function_prototype_locus = UNKNOWN_LOCATION;
   current_function_prototype_built_in = false;
   current_function_prototype_arg_types = NULL_TREE;
diff --git a/gcc/c-gimplify.c b/gcc/c-gimplify.c
index 15d6705d744..dec957f3a33 100644
--- a/gcc/c-gimplify.c
+++ b/gcc/c-gimplify.c
@@ -187,7 +187,7 @@ gimplify_compound_literal_expr (tree *expr_p, tree *pre_p)
   /* This decl isn't mentioned in the enclosing block, so add it to the
      list of temps.  FIXME it seems a bit of a kludge to say that
      anonymous artificial vars aren't pushed, but everything else is.  */
-  if (DECL_NAME (decl) == NULL_TREE)
+  if (DECL_NAME (decl) == NULL_TREE && !DECL_SEEN_IN_BIND_EXPR_P (decl))
     gimple_add_tmp_var (decl);
 
   gimplify_and_add (decl_s, pre_p);
diff --git a/gcc/config/rs6000/rs6000.c b/gcc/config/rs6000/rs6000.c
index ef142f74d88..9e8c5ff69e0 100644
--- a/gcc/config/rs6000/rs6000.c
+++ b/gcc/config/rs6000/rs6000.c
@@ -10709,7 +10709,8 @@ print_operand (FILE *file, rtx x, int code)
 
 	tmp = XEXP (x, 0);
 
-	if (TARGET_E500)
+	/* Ugly hack because %y is overloaded.  */
+	if (TARGET_E500 && GET_MODE_SIZE (GET_MODE (x)) == 8)
 	  {
 	    /* Handle [reg].  */
 	    if (GET_CODE (tmp) == REG)
diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog
index 4a6b67f7a23..534e450bca7 100644
--- a/gcc/cp/ChangeLog
+++ b/gcc/cp/ChangeLog
@@ -1,3 +1,30 @@
+2006-08-27  Mark Mitchell  <mark@codesourcery.com>
+
+	PR c++/28058
+	* pt.c (register_specialization): Return error_mark_node for
+	specialization-after-instantiation.
+	* decl2.c (mark_used): Mark the main function used when one of its
+	clones is used.
+	
+2006-08-26  Mark Mitchell  <mark@codesourcery.com>
+
+	PR c++/28595
+	* pt.c (tsubst): Issue errors about attempts to create VLAs at
+	template-instantiation time.
+
+2006-08-25  Volker Reichelt  <reichelt@igpm.rwth-aachen.de>
+
+	PR c++/28853
+	* typeck2.c (cxx_incomplete_type_diagnostic): Handle template
+	template parameters.  Improve error message for template type
+	parameters.
+
+2006-08-25  Mark Mitchell  <mark@codesourcery.com>
+
+	PR c++/28056
+	* decl.c (grokdeclarator): Disallow declarations with qualified
+	names in local scopes.
+
 2006-07-20  Jason Merrill  <jason@redhat.com>
 
 	PR c++/28407
diff --git a/gcc/cp/decl.c b/gcc/cp/decl.c
index 45316c46bd1..42a5060521f 100644
--- a/gcc/cp/decl.c
+++ b/gcc/cp/decl.c
@@ -6943,7 +6943,27 @@ grokdeclarator (const cp_declarator *declarator,
 	      break;
 	    if (qualifying_scope)
 	      {
-		if (TYPE_P (qualifying_scope))
+		if (at_function_scope_p ())
+		  {
+		    /* [dcl.meaning] 
+
+		       A declarator-id shall not be qualified except
+		       for ... 
+
+		       None of the cases are permitted in block
+		       scope.  */
+		    if (qualifying_scope == global_namespace)
+		      error ("invalid use of qualified-name %<::%D%>",
+			     decl);
+		    else if (TYPE_P (qualifying_scope))
+		      error ("invalid use of qualified-name %<%T::%D%>",
+			     qualifying_scope, decl);
+		    else 
+		      error ("invalid use of qualified-name %<%D::%D%>",
+			     qualifying_scope, decl);
+		    return error_mark_node;
+		  }
+		else if (TYPE_P (qualifying_scope))
 		  {
 		    ctype = qualifying_scope;
 		    if (innermost_code != cdk_function
diff --git a/gcc/cp/decl2.c b/gcc/cp/decl2.c
index d90e393cb8d..3d61122afc1 100644
--- a/gcc/cp/decl2.c
+++ b/gcc/cp/decl2.c
@@ -3501,6 +3501,8 @@ mark_used (tree decl)
     }
 
   TREE_USED (decl) = 1;
+  if (DECL_CLONED_FUNCTION_P (decl))
+    TREE_USED (DECL_CLONED_FUNCTION (decl)) = 1;
   /* If we don't need a value, then we don't need to synthesize DECL.  */ 
   if (skip_evaluation)
     return;
diff --git a/gcc/cp/pt.c b/gcc/cp/pt.c
index ab7240de7a0..be9602a25ae 100644
--- a/gcc/cp/pt.c
+++ b/gcc/cp/pt.c
@@ -1177,7 +1177,7 @@ register_specialization (tree spec, tree tmpl, tree args, bool is_friend)
 	    {
 	      error ("specialization of %qD after instantiation",
 		     fn);
-	      return spec;
+	      return error_mark_node;
 	    }
 	  else
 	    {
@@ -7151,6 +7151,15 @@ tsubst (tree t, tree args, tsubst_flags_t complain, tree in_decl)
 	max = tsubst_template_arg (omax, args, complain, in_decl);
 	max = fold_decl_constant_value (max);
 
+	if (TREE_CODE (max) != INTEGER_CST 
+	    && TREE_CODE (max) != TEMPLATE_PARM_INDEX
+	    && !at_function_scope_p ())
+	  {
+	    if (complain & tf_error)
+	      error ("array bound is not an integer constant");
+	    return error_mark_node;
+	  }
+
 	/* [temp.deduct]
 
 	   Type deduction may fail for any of the following
@@ -7163,7 +7172,6 @@ tsubst (tree t, tree args, tsubst_flags_t complain, tree in_decl)
 	     indicated by the state of complain), so that
 	     another substitution can be found.  */
 	  return error_mark_node;
-
 	else if (TREE_CODE (max) == INTEGER_CST
 		 && INT_CST_LT (max, integer_zero_node))
 	  {
diff --git a/gcc/cp/typeck2.c b/gcc/cp/typeck2.c
index 72cce3e3ef0..e5a0942b92b 100644
--- a/gcc/cp/typeck2.c
+++ b/gcc/cp/typeck2.c
@@ -401,7 +401,12 @@ cxx_incomplete_type_diagnostic (tree value, tree type, int diag_type)
       break;
 
     case TEMPLATE_TYPE_PARM:
-      p_msg ("invalid use of template type parameter");
+      p_msg ("invalid use of template type parameter %qT", type);
+      break;
+
+    case BOUND_TEMPLATE_TEMPLATE_PARM:
+      p_msg ("invalid use of template template parameter %qT",
+            TYPE_NAME (type));
       break;
 
     case UNKNOWN_TYPE:
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index b9fa9cf520f..650b5dcc1c6 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -1167,7 +1167,7 @@ gimplify_decl_expr (tree *stmt_p)
     {
       tree init = DECL_INITIAL (decl);
 
-      if (!TREE_CONSTANT (DECL_SIZE (decl)))
+      if (TREE_CODE (DECL_SIZE (decl)) != INTEGER_CST)
 	{
 	  /* This is a variable-sized decl.  Simplify its size and mark it
 	     for deferred expansion.  Note that mudflap depends on the format
@@ -2628,7 +2628,7 @@ gimplify_init_ctor_preeval (tree *expr_p, tree *pre_p, tree *post_p,
 
   /* If this is of variable size, we have no choice but to assume it doesn't
      overlap since we can't make a temporary for it.  */
-  if (!TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (*expr_p))))
+  if (TREE_CODE (TYPE_SIZE (TREE_TYPE (*expr_p))) != INTEGER_CST)
     return;
 
   /* Otherwise, we must search for overlap ...  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e89e331a394..ec57b53563a 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,56 @@
+2006-08-27  Mark Mitchell  <mark@codesourcery.com>
+
+	PR c++/28058
+	* g++.dg/template/spec31.C: New test.
+	* g++.old-deja/g++.pt/spec9.C: Adjust error markers.
+
+2006-08-28  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR libfortran/28452
+	* gfortran.dg/random_3.f90:  New test.
+
+2006-08-26  Mark Mitchell  <mark@codesourcery.com>
+
+	PR c++/28595
+	* g++.dg/template/array15.C: New test.
+	* g++.dg/template/crash2.C: Tweak error markers.
+
+2006-08-25  Volker Reichelt  <reichelt@igpm.rwth-aachen.de>
+
+	PR c++/28853
+	* g++.dg/template/ttp21.C: New test.
+
+2006-08-25  Joseph S. Myers  <joseph@codesourcery.com>
+
+	PR c/27893
+	* gcc.c-torture/compile/vla-const-1.c,
+	gcc.c-torture/compile/vla-const-2.c: New tests.
+
+2006-08-25  Joseph S. Myers  <joseph@codesourcery.com>
+
+	PR c/28418
+	* gcc.c-torture/compile/compound-literal-1.c: New test.
+
+2006-08-25  Joseph S. Myers  <joseph@codesourcery.com>
+
+	PR c/28299
+	* gcc.dg/funcdef-var-1.c, gcc.dg/funcdef-var-2.c: New tests.
+	* gcc.dg/pr20368-1.c, gcc.dg/pr20368-2.c, gcc.dg/pr20368-3.c:
+	Expect extra diagnostics.
+
+2006-08-25  Joseph Myers  <joseph@codesourcery.com>
+
+	PR c/27558
+	Backport:
+	2006-04-20  Jakub Jelinek  <jakub@redhat.com>
+	* gcc.dg/20060419-1.c: New test.
+
+2006-08-25  Mark Mitchell  <mark@codesourcery.com>
+
+	PR c++/28056
+	* g++.dg/parse/local1.C: New test.
+	* g++.dg/other/qual1.C: Tweak error marker.
+
 2006-07-15  Jakub Jelinek  <jakub@redhat.com>
 
 	PR c++/28370
@@ -1167,10 +1220,6 @@
 	PR c++/27359
 	* g++.dg/gomp/pr27359.C: New test.
 
-2006-04-20  Jakub Jelinek  <jakub@redhat.com>
-
-	* gcc.dg/20060419-1.c: New test.
-
 2006-05-08  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/24813
diff --git a/gcc/testsuite/g++.dg/other/qual1.C b/gcc/testsuite/g++.dg/other/qual1.C
index bd6f234931c..e4bae2315c2 100644
--- a/gcc/testsuite/g++.dg/other/qual1.C
+++ b/gcc/testsuite/g++.dg/other/qual1.C
@@ -6,6 +6,6 @@ struct A
   int i;
   void foo()
   {
-    int A::i = i;  // { dg-error "extra qualification|not a static member" }
+    int A::i = i;  // { dg-error "qualified" }
   }
 };
diff --git a/gcc/testsuite/g++.dg/parse/local1.C b/gcc/testsuite/g++.dg/parse/local1.C
new file mode 100644
index 00000000000..cfcffc90864
--- /dev/null
+++ b/gcc/testsuite/g++.dg/parse/local1.C
@@ -0,0 +1,18 @@
+// PR c++/28056
+
+void f1();
+
+namespace N {
+  void f2();
+}
+
+class C {
+  static void f3();
+};
+
+void foo() { 
+  void ::f1();  // { dg-error "qualified" }
+  void N::f2(); // { dg-error "qualified" }
+  void C::f3(); // { dg-error "qualified" }
+  void ::f4();  // { dg-error "qualified" }
+}
diff --git a/gcc/testsuite/g++.dg/template/array15.C b/gcc/testsuite/g++.dg/template/array15.C
new file mode 100644
index 00000000000..b1e047d1d00
--- /dev/null
+++ b/gcc/testsuite/g++.dg/template/array15.C
@@ -0,0 +1,13 @@
+// PR c++/28595
+
+template<int> struct A
+{
+  static const int i;
+};
+
+template<int N> struct B
+{
+  char c[A<N>::i], d; // { dg-error "constant" }
+};
+
+B<0> b;
diff --git a/gcc/testsuite/g++.dg/template/crash2.C b/gcc/testsuite/g++.dg/template/crash2.C
index a02787a46fa..47c95ab067f 100644
--- a/gcc/testsuite/g++.dg/template/crash2.C
+++ b/gcc/testsuite/g++.dg/template/crash2.C
@@ -5,7 +5,7 @@ class A
 {
 public:
   static const EnumType size = max; // { dg-error "" }
-  int table[size];
+  int table[size]; // { dg-error "constant" }
 };
 template <class EnumType>
 const EnumType A<EnumType>::size;
diff --git a/gcc/testsuite/g++.dg/template/spec31.C b/gcc/testsuite/g++.dg/template/spec31.C
new file mode 100644
index 00000000000..e2164db6ef4
--- /dev/null
+++ b/gcc/testsuite/g++.dg/template/spec31.C
@@ -0,0 +1,10 @@
+// PR c++/28058
+
+template<int> struct A
+{
+  A() {}
+};
+
+A<0> a;
+
+template<> A<0>::A() {} // { dg-error "specialization|invalid" } 
diff --git a/gcc/testsuite/g++.dg/template/ttp21.C b/gcc/testsuite/g++.dg/template/ttp21.C
new file mode 100644
index 00000000000..f0bda99d157
--- /dev/null
+++ b/gcc/testsuite/g++.dg/template/ttp21.C
@@ -0,0 +1,5 @@
+// PR c++/28853
+// { dg-do compile }
+
+template<template<int> class A>
+int A<0>::i;  // { dg-error "template template parameter" }
diff --git a/gcc/testsuite/g++.old-deja/g++.pt/spec9.C b/gcc/testsuite/g++.old-deja/g++.pt/spec9.C
index e2c5b4e5296..96af5622c13 100644
--- a/gcc/testsuite/g++.old-deja/g++.pt/spec9.C
+++ b/gcc/testsuite/g++.old-deja/g++.pt/spec9.C
@@ -14,7 +14,7 @@ int main()
 }
 
 template <>
-int f(int i)   // { dg-error "specialization\[^\n\]*after instantiation" }
+int f(int i)   // { dg-error "specialization\[^\n\]*after instantiation|declaration" }
 {
   return 1;
 }
diff --git a/gcc/testsuite/gcc.c-torture/compile/compound-literal-1.c b/gcc/testsuite/gcc.c-torture/compile/compound-literal-1.c
new file mode 100644
index 00000000000..968bb450a71
--- /dev/null
+++ b/gcc/testsuite/gcc.c-torture/compile/compound-literal-1.c
@@ -0,0 +1,9 @@
+/* ICE incrementing compound literal: bug 28418 from Volker Reichelt
+   <reichelt@gcc.gnu.org>.  */
+
+struct A { int i; };
+
+void foo()
+{
+    ((struct A) { 0 }).i += 1;
+}
diff --git a/gcc/testsuite/gcc.c-torture/compile/vla-const-1.c b/gcc/testsuite/gcc.c-torture/compile/vla-const-1.c
new file mode 100644
index 00000000000..6acc3d83050
--- /dev/null
+++ b/gcc/testsuite/gcc.c-torture/compile/vla-const-1.c
@@ -0,0 +1,5 @@
+/* Test TREE_CONSTANT VLA size: bug 27893.  */
+/* Origin: Joseph Myers <joseph@codesourcery.com> */
+int a;
+void g(void *);
+void f(void) { int b[(__SIZE_TYPE__)&a]; g(b); }
diff --git a/gcc/testsuite/gcc.c-torture/compile/vla-const-2.c b/gcc/testsuite/gcc.c-torture/compile/vla-const-2.c
new file mode 100644
index 00000000000..913a730b458
--- /dev/null
+++ b/gcc/testsuite/gcc.c-torture/compile/vla-const-2.c
@@ -0,0 +1,4 @@
+/* Test TREE_CONSTANT VLA size: bug 27893.  */
+/* Origin: Joseph Myers <joseph@codesourcery.com> */
+void g(void *);
+void f(void) { int b[1/0]; g(b); }
diff --git a/gcc/testsuite/gcc.dg/funcdef-var-1.c b/gcc/testsuite/gcc.dg/funcdef-var-1.c
new file mode 100644
index 00000000000..a685af7ac1c
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/funcdef-var-1.c
@@ -0,0 +1,10 @@
+/* Test ICE on defining function with a name previously declared as a
+   nonfunction.  Bug 28299 from Bernhard Fischer
+   <aldot@gcc.gnu.org>.  */
+/* { dg-do compile } */
+/* { dg-options "-Wmissing-prototypes" } */
+
+extern __typeof(foo) foo __asm__(""); /* { dg-error "undeclared" } */
+/* { dg-error "previous declaration" "previous declaration" { target *-*-* } 7 } */
+void *foo (void) {} /* { dg-error "redeclared as different kind of symbol" } */
+/* { dg-warning "no previous prototype" "no previous prototype" { target *-*-* } 9 } */
diff --git a/gcc/testsuite/gcc.dg/funcdef-var-2.c b/gcc/testsuite/gcc.dg/funcdef-var-2.c
new file mode 100644
index 00000000000..744987ebf3b
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/funcdef-var-2.c
@@ -0,0 +1,11 @@
+/* Test ICE on defining function with a name previously declared as a
+   nonfunction.  Bug 28299 from Bernhard Fischer <aldot@gcc.gnu.org>.
+   Reduced testcase from Volker Reichelt <reichelt@gcc.gnu.org>.  */
+
+/* { dg-do compile } */
+/* { dg-options "-Wmissing-prototypes" } */
+
+int foo;
+/* { dg-error "previous declaration" "previous declaration" { target *-*-* } 8 } */
+void foo () {} /* { dg-error "redeclared as different kind of symbol" } */
+/* { dg-warning "no previous prototype" "no previous prototype" { target *-*-* } 10 } */
diff --git a/gcc/testsuite/gcc.dg/pr20368-1.c b/gcc/testsuite/gcc.dg/pr20368-1.c
index a88c7f803b7..40ef9fe90be 100644
--- a/gcc/testsuite/gcc.dg/pr20368-1.c
+++ b/gcc/testsuite/gcc.dg/pr20368-1.c
@@ -7,6 +7,6 @@ extern __typeof (f) g; /* { dg-error "error: 'f' undeclared here \\(not in a fun
 
 int
 f (x)
-     float x;
+     float x; /* { dg-warning "warning: function declaration isn't a prototype" } */
 {
 }
diff --git a/gcc/testsuite/gcc.dg/pr20368-2.c b/gcc/testsuite/gcc.dg/pr20368-2.c
index e3c8396233e..07bcbcec16d 100644
--- a/gcc/testsuite/gcc.dg/pr20368-2.c
+++ b/gcc/testsuite/gcc.dg/pr20368-2.c
@@ -7,6 +7,6 @@ extern __typeof (f) g; /* { dg-error "error: 'f' undeclared here \\(not in a fun
 
 int
 f (x)
-     float x;
+     float x; /* { dg-warning "warning: no previous prototype for 'f'" } */
 {
 }
diff --git a/gcc/testsuite/gcc.dg/pr20368-3.c b/gcc/testsuite/gcc.dg/pr20368-3.c
index 32095999676..69c0bc81ce6 100644
--- a/gcc/testsuite/gcc.dg/pr20368-3.c
+++ b/gcc/testsuite/gcc.dg/pr20368-3.c
@@ -7,6 +7,6 @@ extern __typeof (f) g; /* { dg-error "error: 'f' undeclared here \\(not in a fun
 
 int
 f (x)
-     float x;
+     float x; /* { dg-warning "warning: no previous declaration for 'f'" } */
 {
 }
diff --git a/gcc/testsuite/gfortran.dg/random_3.f90 b/gcc/testsuite/gfortran.dg/random_3.f90
new file mode 100644
index 00000000000..8e087c48267
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/random_3.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+! Check that the random_seed for real(10) or real(16) exists and that
+! real(8) and real(10) or real(16) random number generators
+! return the same sequence of values.
+! Mostly copied from random_2.f90
+program random_4
+  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+
+  integer, dimension(:), allocatable :: seed
+  real(kind=8), dimension(10) :: r8
+  real(kind=k), dimension(10) :: r10
+  real, parameter :: delta = 1.d-10
+  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(r8)
+  call random_number (r8(10))
+
+  ! Reset the seed and get the real(8) values.
+  call random_seed (put=seed)
+  call random_number(r10)
+  call random_number (r10(10))
+
+  if (any ((r8 - r10) .gt. delta)) call abort
+end program random_4
diff --git a/gcc/version.c b/gcc/version.c
index 7e5800efbb2..cb865d29100 100644
--- a/gcc/version.c
+++ b/gcc/version.c
@@ -8,7 +8,7 @@
    in parentheses.  You may also wish to include a number indicating
    the revision of your modified compiler.  */
 
-#define VERSUFFIX " (Red Hat 4.1.1-18)"
+#define VERSUFFIX " (Red Hat 4.1.1-20)"
 
 /* This is the location of the online document giving instructions for
    reporting bugs.  If you distribute a modified version of GCC,
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index acb24d4f512..755b7d74d8c 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,37 @@
+2006-08-26  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR libfortran/28542
+	* Makefile.am:  Remove normalize.c.
+	* aclocal.m4:  Regenerate.
+	* Makefile.in:  Regenerate.
+	* libgfortran.h:  #include <float.h>.
+	Define GFC_REAL_*_DIGITS and GFC_REAL_*_RADIX.
+	Remove prototypes for normalize_r4_i4 and normalize_r8_i8.
+	* intrinsics/random.c (top level): Add prototypes for
+	random_r10, arandom_r10, random_r16 and arandom_r16.
+	(rnumber_4):  New static function.
+	(rnumber_8):  New static function.
+	(rnumber_10): New static function.
+	(rnumber_16): New static function.
+	(top level):  Set to kiss_size to 12 if we have
+	REAL(KIND=16), to 8 otherwise.
+	Define KISS_DEFAULT_SEED_1, KISS_DEFAULT_SEED_2 and
+	KISS_DEFAULT_SEED_3.
+	(kiss_random_kernel):  Take argument to differentiate
+	between different random number generators.
+	(random_r4):  Add argument to call to kiss_random_kernel,
+	use rnumber_*.
+	(random_r8):  Likewise.
+	(random_r10):  New function.
+	(random_r16):  New function.
+	(arandom_r4):  Add argument to call to kiss_random_kernel,
+	use_rnumber_*.
+	(arandom_r8):  Likewise.
+	(arandom_r10):  New function.
+	(arandom_r16):  New function.
+	* intrinsics/rand.c (rand):  Use shift and mask.
+	* runtime/normalize.c:  Remove.
+
 2006-07-30  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libgfortran/28335
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index c179c7b2aec..56c33dfc6ee 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -96,8 +96,7 @@ intrinsics/umask.c \
 intrinsics/unlink.c \
 intrinsics/unpack_generic.c \
 runtime/in_pack_generic.c \
-runtime/in_unpack_generic.c \
-runtime/normalize.c
+runtime/in_unpack_generic.c
 
 gfor_src= \
 runtime/compile_options.c \
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index 51a6466611e..0634814a68c 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -179,7 +179,7 @@ am__objects_33 = associated.lo abort.lo args.lo bessel.lo \
 	selected_int_kind.lo selected_real_kind.lo stat.lo symlnk.lo \
 	system_clock.lo time.lo transpose_generic.lo tty.lo umask.lo \
 	unlink.lo unpack_generic.lo in_pack_generic.lo \
-	in_unpack_generic.lo normalize.lo
+	in_unpack_generic.lo
 am__objects_34 =
 am__objects_35 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
 	_abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \
@@ -445,8 +445,7 @@ intrinsics/umask.c \
 intrinsics/unlink.c \
 intrinsics/unpack_generic.c \
 runtime/in_pack_generic.c \
-runtime/in_unpack_generic.c \
-runtime/normalize.c
+runtime/in_unpack_generic.c
 
 gfor_src = \
 runtime/compile_options.c \
@@ -2416,9 +2415,6 @@ in_pack_generic.lo: runtime/in_pack_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.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
-
 .f90.o:
 	$(FCCOMPILE) -c -o $@ $<
 
diff --git a/libgfortran/intrinsics/rand.c b/libgfortran/intrinsics/rand.c
index 7af525e7d2a..fcd796e83a4 100644
--- a/libgfortran/intrinsics/rand.c
+++ b/libgfortran/intrinsics/rand.c
@@ -122,7 +122,15 @@ export_proto_np(PREFIX(rand));
 GFC_REAL_4
 PREFIX(rand) (GFC_INTEGER_4 *i)
 {
-  return normalize_r4_i4 (irand (i) - 1, GFC_RAND_M1 - 1);
+  GFC_UINTEGER_4 mask;
+#if GFC_REAL_4_RADIX == 2
+  mask = ~ (GFC_UINTEGER_4) 0u << (32 - GFC_REAL_4_DIGITS + 1);
+#elif GFC_REAL_4_RADIX == 16
+  mask = ~ (GFC_UINTEGER_4) 0u << ((8 - GFC_REAL_4_DIGITS) * 4 + 1);
+#else
+#error "GFC_REAL_4_RADIX has unknown value"
+#endif
+  return ((GFC_UINTEGER_4) (irand(i) -1) & mask) * (GFC_REAL_4) 0x1.p-31f;
 }
 
 #ifndef __GTHREAD_MUTEX_INIT
diff --git a/libgfortran/intrinsics/random.c b/libgfortran/intrinsics/random.c
index d77a381583c..066a7ce92b8 100644
--- a/libgfortran/intrinsics/random.c
+++ b/libgfortran/intrinsics/random.c
@@ -45,13 +45,108 @@ export_proto(arandom_r4);
 extern void arandom_r8 (gfc_array_r8 *);
 export_proto(arandom_r8);
 
+#ifdef HAVE_GFC_REAL_10
+
+extern void random_r10 (GFC_REAL_10 *);
+iexport_proto(random_r10);
+
+extern void arandom_r10 (gfc_array_r10 *);
+export_proto(arandom_r10);
+
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+
+extern void random_r16 (GFC_REAL_16 *);
+iexport_proto(random_r16);
+
+extern void arandom_r16 (gfc_array_r16 *);
+export_proto(arandom_r16);
+
+#endif
+
 #ifdef __GTHREAD_MUTEX_INIT
 static __gthread_mutex_t random_lock = __GTHREAD_MUTEX_INIT;
 #else
 static __gthread_mutex_t random_lock;
 #endif
 
+/* Helper routines to map a GFC_UINTEGER_* to the corresponding
+   GFC_REAL_* types in the range of [0,1).  If GFC_REAL_*_RADIX are 2
+   or 16, respectively, we mask off the bits that don't fit into the
+   correct GFC_REAL_*, convert to the real type, then multiply by the
+   correct offset.
+*/
+
+
+static inline void
+rnumber_4 (GFC_REAL_4 *f, GFC_UINTEGER_4 v)
+{
+  GFC_UINTEGER_4 mask;
+#if GFC_REAL_4_RADIX == 2
+  mask = ~ (GFC_UINTEGER_4) 0u << (32 - GFC_REAL_4_DIGITS);
+#elif GFC_REAL_4_RADIX == 16
+  mask = ~ (GFC_UINTEGER_4) 0u << ((8 - GFC_REAL_4_DIGITS) * 4);
+#else
+#error "GFC_REAL_4_RADIX has unknown value"
+#endif
+  v = v & mask;
+  *f = (GFC_REAL_4) v * (GFC_REAL_4) 0x1.p-32f;
+}
+
+static inline void
+rnumber_8 (GFC_REAL_8 *f, GFC_UINTEGER_8 v)
+{
+  GFC_UINTEGER_8 mask;
+#if GFC_REAL_8_RADIX == 2
+  mask = ~ (GFC_UINTEGER_8) 0u << (64 - GFC_REAL_8_DIGITS);
+#elif GFC_REAL_8_RADIX == 16
+  mask = ~ (GFC_UINTEGER_8) 0u << (16 - GFC_REAL_8_DIGITS) * 4);
+#else
+#error "GFC_REAL_8_RADIX has unknown value"
+#endif
+  v = v & mask;
+  *f = (GFC_REAL_8) v * (GFC_REAL_8) 0x1.p-64;
+}
+
+#ifdef HAVE_GFC_REAL_10
 
+static inline void
+rnumber_10 (GFC_REAL_10 *f, GFC_UINTEGER_8 v)
+{
+  GFC_UINTEGER_8 mask;
+#if GFC_REAL_10_RADIX == 2
+  mask = ~ (GFC_UINTEGER_8) 0u << (64 - GFC_REAL_10_DIGITS);
+#elif GFC_REAL_10_RADIX == 16
+  mask = ~ (GFC_UINTEGER_10) 0u << ((16 - GFC_REAL_10_DIGITS) * 4);
+#else
+#error "GFC_REAL_10_RADIX has unknown value"
+#endif
+  v = v & mask;
+  *f = (GFC_REAL_10) v * (GFC_REAL_10) 0x1.p-64;
+}
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+
+/* For REAL(KIND=16), we only need to mask off the lower bits.  */
+
+static inline void
+rnumber_16 (GFC_REAL_16 *f, GFC_UINTEGER_8 v1, GFC_UINTEGER_8 v2)
+{
+  GFC_UINTEGER_8 mask;
+#if GFC_REAL_16_RADIX == 2
+  mask = ~ (GFC_UINTEGER_8) 0u << (128 - GFC_REAL_16_DIGITS);
+#elif GFC_REAL_16_RADIX == 16
+  mask = ~ (GFC_UINTEGER_8) 0u << ((32 - GFC_REAL_16_DIGITS) * 4);
+#else
+#error "GFC_REAL_16_RADIX has unknown value"
+#endif
+  v2 = v2 & mask;
+  *f = (GFC_REAL_16) v1 * (GFC_REAL_16) 0x1.p-64
+    + (GFC_REAL_16) v2 * (GFC_REAL_16) 0x1.p-128;
+}
+#endif
 /* libgfortran previously had a Mersenne Twister, taken from the paper:
   
 	Mersenne Twister:	623-dimensionally equidistributed
@@ -111,28 +206,77 @@ static __gthread_mutex_t random_lock;
 "There is no copyright on the code below." included the original
 KISS algorithm.  */
 
+/* We use three KISS random number generators, with different
+   seeds.
+   As a matter of Quality of Implementation, the random numbers
+   we generate for different REAL kinds, starting from the same
+   seed, are always the same up to the precision of these types.
+   We do this by using three generators with different seeds, the
+   first one always for the most significant bits, the second one
+   for bits 33..64 (if present in the REAL kind), and the third one
+   (called twice) for REAL(16).
+*/
+
 #define GFC_SL(k, n)	((k)^((k)<<(n)))
 #define GFC_SR(k, n)	((k)^((k)>>(n)))
 
-static const GFC_INTEGER_4 kiss_size = 4;
-#define KISS_DEFAULT_SEED {123456789, 362436069, 521288629, 916191069}
-static const GFC_UINTEGER_4 kiss_default_seed[4] = KISS_DEFAULT_SEED;
-static GFC_UINTEGER_4 kiss_seed[4] = KISS_DEFAULT_SEED;
+/*   Reference for the seed:
+   From: "George Marsaglia" <g...@stat.fsu.edu>
+   Newsgroups: sci.math
+   Message-ID: <e7CcnWxczriWssCjXTWc3A@comcast.com>
+  
+   The KISS RNG uses four seeds, x, y, z, c,
+   with 0<=x<2^32, 0<y<2^32, 0<=z<2^32, 0<=c<698769069
+   except that the two pairs
+   z=0,c=0 and z=2^32-1,c=698769068
+   should be avoided.
+*/
+
+#define KISS_DEFAULT_SEED_1 123456789, 362436069, 521288629, 316191069
+#define KISS_DEFAULT_SEED_2 987654321, 458629013, 582859209, 438195021
+#ifdef HAVE_GFC_REAL_16
+#define KISS_DEFAULT_SEED_3 573658661, 185639104, 582619469, 296736107
+#endif
+
+static GFC_UINTEGER_4 kiss_seed[] = {
+  KISS_DEFAULT_SEED_1,
+  KISS_DEFAULT_SEED_2,
+#ifdef HAVE_GFC_REAL_16
+  KISS_DEFAULT_SEED_3
+#endif
+};
+
+static GFC_UINTEGER_4 kiss_default_seed[] = {
+  KISS_DEFAULT_SEED_1,
+  KISS_DEFAULT_SEED_2,
+#ifdef HAVE_GFC_REAL_16
+  KISS_DEFAULT_SEED_3
+#endif
+};
+
+static const GFC_INTEGER_4 kiss_size = sizeof(kiss_seed)/sizeof(kiss_seed[0]);
+
+static GFC_UINTEGER_4 * const kiss_seed_1 = kiss_seed;
+static GFC_UINTEGER_4 * const kiss_seed_2 = kiss_seed + 4;
+
+#ifdef HAVE_GFC_REAL_16
+static GFC_UINTEGER_4 * const kiss_seed_3 = kiss_seed + 8;
+#endif
 
 /* kiss_random_kernel() returns an integer value in the range of
    (0, GFC_UINTEGER_4_HUGE].  The distribution of pseudorandom numbers
    should be uniform.  */
 
 static GFC_UINTEGER_4
-kiss_random_kernel(void)
+kiss_random_kernel(GFC_UINTEGER_4 * seed)
 {
   GFC_UINTEGER_4 kiss;
 
-  kiss_seed[0] = 69069 * kiss_seed[0] + 1327217885;
-  kiss_seed[1] = GFC_SL(GFC_SR(GFC_SL(kiss_seed[1],13),17),5);
-  kiss_seed[2] = 18000 * (kiss_seed[2] & 65535) + (kiss_seed[2] >> 16);
-  kiss_seed[3] = 30903 * (kiss_seed[3] & 65535) + (kiss_seed[3] >> 16);
-  kiss = kiss_seed[0] + kiss_seed[1] + (kiss_seed[2] << 16) + kiss_seed[3];
+  seed[0] = 69069 * seed[0] + 1327217885;
+  seed[1] = GFC_SL(GFC_SR(GFC_SL(seed[1],13),17),5);
+  seed[2] = 18000 * (seed[2] & 65535) + (seed[2] >> 16);
+  seed[3] = 30903 * (seed[3] & 65535) + (seed[3] >> 16);
+  kiss = seed[0] + seed[1] + (seed[2] << 16) + seed[3];
 
   return kiss;
 }
@@ -146,11 +290,8 @@ random_r4 (GFC_REAL_4 *x)
   GFC_UINTEGER_4 kiss;
 
   __gthread_mutex_lock (&random_lock);
-  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);
+  kiss = kiss_random_kernel (kiss_seed_1);
+  rnumber_4 (x, kiss);
   __gthread_mutex_unlock (&random_lock);
 }
 iexport(random_r4);
@@ -164,13 +305,57 @@ random_r8 (GFC_REAL_8 *x)
   GFC_UINTEGER_8 kiss;
 
   __gthread_mutex_lock (&random_lock);
-  kiss = ((GFC_UINTEGER_8)kiss_random_kernel ()) << 32;
-  kiss += kiss_random_kernel ();
-  *x = normalize_r8_i8 (kiss, ~(GFC_UINTEGER_8) 0);
+  kiss = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
+  kiss += kiss_random_kernel (kiss_seed_2);
+  rnumber_8 (x, kiss);
   __gthread_mutex_unlock (&random_lock);
 }
 iexport(random_r8);
 
+#ifdef HAVE_GFC_REAL_10
+
+/*  This function produces a REAL(10) value from the uniform distribution
+    with range [0,1).  */
+
+void
+random_r10 (GFC_REAL_10 *x)
+{
+  GFC_UINTEGER_8 kiss;
+
+  __gthread_mutex_lock (&random_lock);
+  kiss = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
+  kiss += kiss_random_kernel (kiss_seed_2);
+  rnumber_10 (x, kiss);
+  __gthread_mutex_unlock (&random_lock);
+}
+iexport(random_r10);
+
+#endif
+
+/*  This function produces a REAL(16) value from the uniform distribution
+    with range [0,1).  */
+
+#ifdef HAVE_GFC_REAL_16
+
+void
+random_r16 (GFC_REAL_16 *x)
+{
+  GFC_UINTEGER_8 kiss1, kiss2;
+
+  __gthread_mutex_lock (&random_lock);
+  kiss1 = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
+  kiss1 += kiss_random_kernel (kiss_seed_2);
+
+  kiss2 = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_3)) << 32;
+  kiss2 += kiss_random_kernel (kiss_seed_3);
+
+  rnumber_16 (x, kiss1, kiss2);
+  __gthread_mutex_unlock (&random_lock);
+}
+iexport(random_r16);
+
+
+#endif
 /*  This function fills a REAL(4) array with values from the uniform
     distribution with range [0,1).  */
 
@@ -209,11 +394,8 @@ arandom_r4 (gfc_array_r4 *x)
   while (dest)
     {
       /* random_r4 (dest); */
-      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 ();
-      *dest = normalize_r4_i4 (kiss, ~(GFC_UINTEGER_4) 0);
+      kiss = kiss_random_kernel (kiss_seed_1);
+      rnumber_4 (dest, kiss);
 
       /* Advance to the next element.  */
       dest += stride0;
@@ -282,9 +464,155 @@ arandom_r8 (gfc_array_r8 *x)
   while (dest)
     {
       /* random_r8 (dest); */
-      kiss = ((GFC_UINTEGER_8)kiss_random_kernel ()) << 32;
-      kiss += kiss_random_kernel ();
-      *dest = normalize_r8_i8 (kiss, ~(GFC_UINTEGER_8) 0);
+      kiss = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
+      kiss += kiss_random_kernel (kiss_seed_2);
+      rnumber_8 (dest, kiss);
+
+      /* Advance to the next element.  */
+      dest += stride0;
+      count[0]++;
+      /* Advance to the next source element.  */
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so probably not worth it.  */
+          dest -= stride[n] * extent[n];
+          n++;
+          if (n == dim)
+            {
+              dest = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              dest += stride[n];
+            }
+        }
+    }
+  __gthread_mutex_unlock (&random_lock);
+}
+
+#ifdef HAVE_GFC_REAL_10
+
+/*  This function fills a REAL(10) array with values from the uniform
+    distribution with range [0,1).  */
+
+void
+arandom_r10 (gfc_array_r10 *x)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type stride[GFC_MAX_DIMENSIONS];
+  index_type stride0;
+  index_type dim;
+  GFC_REAL_10 *dest;
+  GFC_UINTEGER_8 kiss;
+  int n;
+
+  dest = x->data;
+
+  dim = GFC_DESCRIPTOR_RANK (x);
+
+  for (n = 0; n < dim; n++)
+    {
+      count[n] = 0;
+      stride[n] = x->dim[n].stride;
+      extent[n] = x->dim[n].ubound + 1 - x->dim[n].lbound;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  stride0 = stride[0];
+
+  __gthread_mutex_lock (&random_lock);
+
+  while (dest)
+    {
+      /* random_r10 (dest); */
+      kiss = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
+      kiss += kiss_random_kernel (kiss_seed_2);
+      rnumber_10 (dest, kiss);
+
+      /* Advance to the next element.  */
+      dest += stride0;
+      count[0]++;
+      /* Advance to the next source element.  */
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so probably not worth it.  */
+          dest -= stride[n] * extent[n];
+          n++;
+          if (n == dim)
+            {
+              dest = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              dest += stride[n];
+            }
+        }
+    }
+  __gthread_mutex_unlock (&random_lock);
+}
+
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+
+/*  This function fills a REAL(16) array with values from the uniform
+    distribution with range [0,1).  */
+
+void
+arandom_r16 (gfc_array_r16 *x)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type stride[GFC_MAX_DIMENSIONS];
+  index_type stride0;
+  index_type dim;
+  GFC_REAL_16 *dest;
+  GFC_UINTEGER_8 kiss1, kiss2;
+  int n;
+
+  dest = x->data;
+
+  dim = GFC_DESCRIPTOR_RANK (x);
+
+  for (n = 0; n < dim; n++)
+    {
+      count[n] = 0;
+      stride[n] = x->dim[n].stride;
+      extent[n] = x->dim[n].ubound + 1 - x->dim[n].lbound;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  stride0 = stride[0];
+
+  __gthread_mutex_lock (&random_lock);
+
+  while (dest)
+    {
+      /* random_r16 (dest); */
+      kiss1 = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
+      kiss1 += kiss_random_kernel (kiss_seed_2);
+
+      kiss2 = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_3)) << 32;
+      kiss2 += kiss_random_kernel (kiss_seed_3);
+
+      rnumber_16 (dest, kiss1, kiss2);
 
       /* Advance to the next element.  */
       dest += stride0;
@@ -315,6 +643,8 @@ arandom_r8 (gfc_array_r8 *x)
   __gthread_mutex_unlock (&random_lock);
 }
 
+#endif
+
 /* random_seed is used to seed the PRNG with either a default
    set of seeds or user specified set of seeds.  random_seed
    must be called with no argument or exactly one argument.  */
@@ -330,10 +660,10 @@ random_seed (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)
     {
       /* From the standard: "If no argument is present, the processor assigns
          a processor-dependent value to the seed."  */
-      kiss_seed[0] = kiss_default_seed[0];
-      kiss_seed[1] = kiss_default_seed[1];
-      kiss_seed[2] = kiss_default_seed[2];
-      kiss_seed[3] = kiss_default_seed[3];
+
+      for (i=0; i<kiss_size; i++)
+	kiss_seed[i] = kiss_default_seed[i];
+
     }
 
   if (size != NULL)
@@ -354,7 +684,7 @@ random_seed (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)
 
       /*  This code now should do correct strides.  */
       for (i = 0; i < kiss_size; i++)
-        kiss_seed[i] =(GFC_UINTEGER_4) put->data[i * put->dim[0].stride];
+	kiss_seed[i] =(GFC_UINTEGER_4) put->data[i * put->dim[0].stride];
     }
 
   /* Return the seed to GET data.  */
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 8a57bfaf17c..cd25cdf30cf 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -33,6 +33,7 @@ Boston, MA 02110-1301, USA.  */
 
 #include <math.h>
 #include <stddef.h>
+#include <float.h>
 
 #ifndef M_PI
 #define M_PI 3.14159265358979323846264338327
@@ -228,6 +229,24 @@ internal_proto(l8_to_l4_offset);
 #define GFC_REAL_16_HUGE LDBL_MAX
 #endif
 
+#define GFC_REAL_4_DIGITS FLT_MANT_DIG
+#define GFC_REAL_8_DIGITS DBL_MANT_DIG
+#ifdef HAVE_GFC_REAL_10
+#define GFC_REAL_10_DIGITS LDBL_MANT_DIG
+#endif
+#ifdef HAVE_GFC_REAL_16
+#define GFC_REAL_16_DIGITS LDBL_MANT_DIG
+#endif
+
+#define GFC_REAL_4_RADIX FLT_RADIX
+#define GFC_REAL_8_RADIX FLT_RADIX
+#ifdef HAVE_GFC_REAL_10
+#define GFC_REAL_10_RADIX FLT_RADIX
+#endif
+#ifdef HAVE_GFC_REAL_16
+#define GFC_REAL_16_RADIX FLT_RADIX
+#endif
+
 #ifndef GFC_MAX_DIMENSIONS
 #define GFC_MAX_DIMENSIONS 7
 #endif
@@ -616,14 +635,6 @@ extern void random_seed (GFC_INTEGER_4 * size, gfc_array_i4 * put,
 			 gfc_array_i4 * get);
 iexport_proto(random_seed);
 
-/* normalize.c */
-
-extern GFC_REAL_4 normalize_r4_i4 (GFC_UINTEGER_4, GFC_UINTEGER_4);
-internal_proto(normalize_r4_i4);
-
-extern GFC_REAL_8 normalize_r8_i8 (GFC_UINTEGER_8, GFC_UINTEGER_8);
-internal_proto(normalize_r8_i8);
-
 /* size.c */
 
 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) array_t;
diff --git a/libgfortran/runtime/normalize.c b/libgfortran/runtime/normalize.c
deleted file mode 100644
index 7bc90033ef3..00000000000
--- a/libgfortran/runtime/normalize.c
+++ /dev/null
@@ -1,120 +0,0 @@
-/* Nelper routines to convert from integer to real.
-   Copyright 2004, 2005 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 General Public
-License as published by the Free Software Foundation; either
-version 2 of the License, or (at your option) any later version.
-
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file.  (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
-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 General Public License for more details.
-
-You should have received a copy of the GNU General Public
-License along with libgfortran; see the file COPYING.  If not,
-write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, 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 (void)
-{
-#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 (void)
-{
-#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;
-}
diff --git a/libiberty/ChangeLog b/libiberty/ChangeLog
index df6e8bfc310..e72439c0a8a 100644
--- a/libiberty/ChangeLog
+++ b/libiberty/ChangeLog
@@ -1,3 +1,15 @@
+2006-08-27  Ian Lance Taylor  <ian@airs.com>
+
+	PR driver/27622
+	* pex-common.h (struct pex_funcs): Add toclose parameter to
+	exec_child field.
+	* pex-common.c (pex_run_in_environment): Pass toclose to
+	exec_child.
+	* pex-djgpp.c (pex_djgpp_exec_child): Add toclose parameter.
+	* pex-unix.c (pex_unix_exec_child): Likewise.
+	* pex-msdos.c (pex_msdos_exec_child): Likewise.
+	* pex-win32.c (pex_win32_exec_child): Likewise.
+
 2005-12-10  Terry Laurenzo  <tlaurenzo@gmail.com>
 
 	PR java/9861
diff --git a/libiberty/pex-common.c b/libiberty/pex-common.c
index b2ca6e08ce2..c293ee55641 100644
--- a/libiberty/pex-common.c
+++ b/libiberty/pex-common.c
@@ -103,6 +103,7 @@ pex_run (struct pex_obj *obj, int flags, const char *executable,
   char *outname;
   int outname_allocated;
   int p[2];
+  int toclose;
   long pid;
 
   in = -1;
@@ -272,10 +273,18 @@ pex_run (struct pex_obj *obj, int flags, const char *executable,
 	}
     }
 
+  /* If we are using pipes, the child process has to close the next
+     input pipe.  */
+
+  if ((obj->flags & PEX_USE_PIPES) == 0)
+    toclose = -1;
+  else
+    toclose = obj->next_input;
+
   /* Run the program.  */
 
   pid = obj->funcs->exec_child (obj, flags, executable, argv, in, out, errdes,
-				&errmsg, err);
+				toclose, &errmsg, err);
   if (pid < 0)
     goto error_exit;
 
diff --git a/libiberty/pex-common.h b/libiberty/pex-common.h
index bd4f908769f..6e47749bfcf 100644
--- a/libiberty/pex-common.h
+++ b/libiberty/pex-common.h
@@ -93,15 +93,17 @@ struct pex_funcs
      binary mode.  Return >= 0 on success, -1 on error.  */
   int (*open_write) (struct pex_obj *, const char *name, int binary);
   /* Execute a child process.  FLAGS, EXECUTABLE, ARGV, ERR are from
-     pex_run.  IN, OUT, ERRDES are each a descriptor, from open_read,
-     open_write, or pipe, or they are one of STDIN_FILE_NO,
+     pex_run.  IN, OUT, ERRDES, TOCLOSE are each a descriptor, from
+     open_read, open_write, or pipe, or they are one of STDIN_FILE_NO,
      STDOUT_FILE_NO or STDERR_FILE_NO; if not STD*_FILE_NO, they
-     should be closed.  The function should handle the
-     PEX_STDERR_TO_STDOUT flag.  Return >= 0 on success, or -1 on
-     error and set *ERRMSG and *ERR.  */
+     should be closed.  If the descriptor TOCLOSE is not -1, and the
+     system supports pipes, TOCLOSE should be closed in the child
+     process.  The function should handle the PEX_STDERR_TO_STDOUT
+     flag.  Return >= 0 on success, or -1 on error and set *ERRMSG and
+     *ERR.  */
   long (*exec_child) (struct pex_obj *, int flags, const char *executable,
 		      char * const * argv, int in, int out, int errdes,
-		      const char **errmsg, int *err);
+		      int /* toclose */, const char **errmsg, int *err);
   /* Close a descriptor.  Return 0 on success, -1 on error.  */
   int (*close) (struct pex_obj *, int);
   /* Wait for a child to complete, returning exit status in *STATUS
diff --git a/libiberty/pex-djgpp.c b/libiberty/pex-djgpp.c
index 6e58e3fd8dc..b7745307336 100644
--- a/libiberty/pex-djgpp.c
+++ b/libiberty/pex-djgpp.c
@@ -45,7 +45,7 @@ extern int errno;
 static int pex_djgpp_open_read (struct pex_obj *, const char *, int);
 static int pex_djgpp_open_write (struct pex_obj *, const char *, int);
 static long pex_djgpp_exec_child (struct pex_obj *, int, const char *,
-				  char * const *, int, int, int,
+				  char * const *, int, int, int, int,
 				  const char **, int *);
 static int pex_djgpp_close (struct pex_obj *, int);
 static int pex_djgpp_wait (struct pex_obj *, long, int *, struct pex_time *,
@@ -111,6 +111,7 @@ pex_djgpp_close (struct pex_obj *obj ATTRIBUTE_UNUSED, int fd)
 static long
 pex_djgpp_exec_child (struct pex_obj *obj, int flags, const char *executable,
 		      char * const * argv, int in, int out, int errdes,
+		      int toclose ATTRIBUTE_UNUSED,
 		      const char **errmsg, int *err)
 {
   int org_in, org_out, org_errdes;
diff --git a/libiberty/pex-msdos.c b/libiberty/pex-msdos.c
index 2256117d1bb..eeabc306dcc 100644
--- a/libiberty/pex-msdos.c
+++ b/libiberty/pex-msdos.c
@@ -55,7 +55,7 @@ static int pex_msdos_open (struct pex_obj *, const char *, int);
 static int pex_msdos_open (struct pex_obj *, const char *, int);
 static int pex_msdos_fdindex (struct pex_msdos *, int);
 static long pex_msdos_exec_child (struct pex_obj *, int, const char *,
-				  char * const *, int, int, int,
+				  char * const *, int, int, int, int,
 				  const char **, int *);
 static int pex_msdos_close (struct pex_obj *, int);
 static int pex_msdos_wait (struct pex_obj *, long, int *, struct pex_time *,
@@ -153,6 +153,7 @@ pex_msdos_close (struct pex_obj *obj, int fd)
 static long
 pex_msdos_exec_child (struct pex_obj *obj, int flags, const char *executable,
 		      char * const * argv, int in, int out,
+		      int toclose ATTRIBUTE_UNUSED,
 		      int errdes ATTRIBUTE_UNUSED, const char **errmsg,
 		      int *err)
 {
diff --git a/libiberty/pex-unix.c b/libiberty/pex-unix.c
index 35a545cb17b..e4db3b0c16a 100644
--- a/libiberty/pex-unix.c
+++ b/libiberty/pex-unix.c
@@ -270,7 +270,7 @@ static void pex_child_error (struct pex_obj *, const char *, const char *, int)
 static int pex_unix_open_read (struct pex_obj *, const char *, int);
 static int pex_unix_open_write (struct pex_obj *, const char *, int);
 static long pex_unix_exec_child (struct pex_obj *, int, const char *,
-				 char * const *, int, int, int,
+				 char * const *, int, int, int, int,
 				 const char **, int *);
 static int pex_unix_close (struct pex_obj *, int);
 static int pex_unix_wait (struct pex_obj *, long, int *, struct pex_time *,
@@ -353,7 +353,7 @@ pex_child_error (struct pex_obj *obj, const char *executable,
 static long
 pex_unix_exec_child (struct pex_obj *obj, int flags, const char *executable,
 		     char * const * argv, int in, int out, int errdes,
-		     const char **errmsg, int *err)
+		     int toclose, const char **errmsg, int *err)
 {
   pid_t pid;
   /* We declare these to be volatile to avoid warnings from gcc about
@@ -402,6 +402,11 @@ pex_unix_exec_child (struct pex_obj *obj, int flags, const char *executable,
 	  if (close (errdes) < 0)
 	    pex_child_error (obj, executable, "close", errno);
 	}
+      if (toclose >= 0)
+	{
+	  if (close (toclose) < 0)
+	    pex_child_error (obj, executable, "close", errno);
+	}
       if ((flags & PEX_STDERR_TO_STDOUT) != 0)
 	{
 	  if (dup2 (STDOUT_FILE_NO, STDERR_FILE_NO) < 0)
diff --git a/libiberty/pex-win32.c b/libiberty/pex-win32.c
index ed45e5b8bb8..e6a18bdb7c3 100644
--- a/libiberty/pex-win32.c
+++ b/libiberty/pex-win32.c
@@ -184,7 +184,7 @@ fix_argv (char * const *argvec)
 static int pex_win32_open_read (struct pex_obj *, const char *, int);
 static int pex_win32_open_write (struct pex_obj *, const char *, int);
 static long pex_win32_exec_child (struct pex_obj *, int, const char *,
-				  char * const *, int, int, int,
+				  char * const *, int, int, int, int,
 				  const char **, int *);
 static int pex_win32_close (struct pex_obj *, int);
 static int pex_win32_wait (struct pex_obj *, long, int *,
@@ -493,7 +493,9 @@ spawn_script (const char *executable, const char * const * argv)
 static long
 pex_win32_exec_child (struct pex_obj *obj ATTRIBUTE_UNUSED, int flags,
 		      const char *executable, char * const * argv,
-		      int in, int out, int errdes, const char **errmsg,
+		      int in, int out, int errdes,
+		      int toclose ATTRIBUTE_UNUSED,
+		      const char **errmsg,
 		      int *err)
 {
   int org_in, org_out, org_errdes;