svn merge -r113149:113242 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@113244 138bc75d-0d04-0410-961f-82ee72b054a4

45 files changed, 1119 insertions, 79 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 1485f4b5dd1..3e8e377b3ed 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,43 @@
+2006-04-24  Roger Sayle  <roger@eyesopen.com>
+
+	PR target/26961
+	* fold-const.c (fold_ternary): When converting "A ? B : C" into either
+	"A op B" or "A op C", we may need to convert A to the type of B and C.
+
+2006-04-23  Roger Sayle  <roger@eyesopen.com>
+
+	PR target/21283
+	* config/fr30/fr30.md (define_split): Avoid calling gen_lowpart on
+	a SImode SUBREG of a floating point register after no_new_pseudos.
+
+2006-04-23  Roger Sayle  <roger@eyesopen.com>
+
+	* config/fr30/fr30.md (addsi_small_int): Use REGNO_PTR_FRAME_P to
+	identify potentially eliminable registers to additionally catch
+	VIRTUAL_INCOMING_ARGS_REGNUM.
+	(addsi3): Update the conditions on when to use addsi_small_int.
+
+2006-04-23  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* tree-tailcall.c (pass_tail_recursion): Use gate_tail_calls too.
+
+2006-04-21  Carlos O'Donell  <carlos@codesourcery.com>
+	
+	Backport from mainline:
+	2006-04-19  Carlos O'Donell  <carlos@codesourcery.com>
+		    Nathan Sidwell  <nathan@codesourcery.com>
+	PR c/26774
+	* stor-layout.c (update_alignment_for_field): Do not align 
+	ERROR_MARK nodes.
+	(place_union_field): Place union field at the start of the union.
+	(place_field): Move ERROR_MARK check later, and use the current
+	allocation position to maintain monotonicity.
+
+2006-04-21  Volker Reichelt  <reichelt@igpm.rwth-aachen.de>
+
+	PR c/25875
+	* c-typeck.c (digest_init): Robustify.
+
 2006-04-21  Steve Ellcey  <sje@cup.hp.com>
 
 	* config/pa/t-pa64: Add dependencies on $(GCC_PASSES).
diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP
index 2eb98b8a704..21517bff1d0 100644
--- a/gcc/DATESTAMP
+++ b/gcc/DATESTAMP
@@ -1 +1 @@
-20060421
+20060425
diff --git a/gcc/c-typeck.c b/gcc/c-typeck.c
index ab1e2faaeb3..15cf10fb19a 100644
--- a/gcc/c-typeck.c
+++ b/gcc/c-typeck.c
@@ -4421,6 +4421,7 @@ digest_init (tree type, tree init, bool strict_string, int require_constant)
   tree inside_init = init;
 
   if (type == error_mark_node
+      || !init
       || init == error_mark_node
       || TREE_TYPE (init) == error_mark_node)
     return error_mark_node;
diff --git a/gcc/config/fr30/fr30.md b/gcc/config/fr30/fr30.md
index 734b3749ada..0deda961e85 100644
--- a/gcc/config/fr30/fr30.md
+++ b/gcc/config/fr30/fr30.md
@@ -290,7 +290,9 @@
 (define_split
   [(set (match_operand:SI 0 "register_operand"  "")
 	(match_operand:SI 1 "const_int_operand" ""))]
-   "INTVAL (operands[1]) <= -1 && INTVAL (operands[1]) >= -128"
+   "INTVAL (operands[1]) <= -1 && INTVAL (operands[1]) >= -128
+    && (GET_CODE (operands[0]) != SUBREG
+	|| SCALAR_INT_MODE_P (GET_MODE (XEXP (operands[0], 0))))"
    [(set:SI (match_dup 0) (match_dup 1))
     (set:SI (match_dup 0) (sign_extend:SI (match_dup 2)))]
    "{
@@ -654,10 +656,10 @@
     emit_insn (gen_addsi_regs (operands[0], operands[1], operands[2]));
   else if (GET_CODE (operands[2]) != CONST_INT)
     emit_insn (gen_addsi_big_int (operands[0], operands[1], operands[2]));
-  else if (   (REGNO (operands[1]) != FRAME_POINTER_REGNUM)
-           && (REGNO (operands[1]) != ARG_POINTER_REGNUM)
-	   && (INTVAL (operands[2]) >= -16)
-	   && (INTVAL (operands[2]) <= 15))
+  else if (INTVAL (operands[2]) >= -16
+	   && INTVAL (operands[2]) <= 15
+	   && (!REGNO_PTR_FRAME_P (REGNO (operands[1]))
+	       || REGNO (operands[1]) == STACK_POINTER_REGNUM))
     emit_insn (gen_addsi_small_int (operands[0], operands[1], operands[2]));
   else
     emit_insn (gen_addsi_big_int (operands[0], operands[1], operands[2]));
@@ -680,8 +682,8 @@
   [(set (match_operand:SI 0 "register_operand"              "=r,r")
 	(plus:SI (match_operand:SI 1 "register_operand"      "0,0")
 		 (match_operand:SI 2 "add_immediate_operand" "I,J")))]
-  "   (REGNO (operands[1]) != FRAME_POINTER_REGNUM)
-   && (REGNO (operands[1]) != ARG_POINTER_REGNUM)"
+  "! REGNO_PTR_FRAME_P (REGNO (operands[1]))
+   || REGNO (operands[1]) == STACK_POINTER_REGNUM"
   "@
    addn	%2, %0
    addn2	%2, %0"
diff --git a/gcc/fold-const.c b/gcc/fold-const.c
index 93d7f13215a..b9a1b345722 100644
--- a/gcc/fold-const.c
+++ b/gcc/fold-const.c
@@ -10111,7 +10111,9 @@ fold_ternary (enum tree_code code, tree type, tree op0, tree op1, tree op2)
       if (integer_zerop (op2)
 	  && truth_value_p (TREE_CODE (arg0))
 	  && truth_value_p (TREE_CODE (arg1)))
-	return fold_build2 (TRUTH_ANDIF_EXPR, type, arg0, arg1);
+	return fold_build2 (TRUTH_ANDIF_EXPR, type,
+			    fold_convert (type, arg0),
+			    arg1);
 
       /* Convert A ? B : 1 into !A || B if A and B are truth values.  */
       if (integer_onep (op2)
@@ -10121,7 +10123,9 @@ fold_ternary (enum tree_code code, tree type, tree op0, tree op1, tree op2)
 	  /* Only perform transformation if ARG0 is easily inverted.  */
 	  tem = invert_truthvalue (arg0);
 	  if (TREE_CODE (tem) != TRUTH_NOT_EXPR)
-	    return fold_build2 (TRUTH_ORIF_EXPR, type, tem, arg1);
+	    return fold_build2 (TRUTH_ORIF_EXPR, type,
+				fold_convert (type, tem),
+				arg1);
 	}
 
       /* Convert A ? 0 : B into !A && B if A and B are truth values.  */
@@ -10132,14 +10136,18 @@ fold_ternary (enum tree_code code, tree type, tree op0, tree op1, tree op2)
 	  /* Only perform transformation if ARG0 is easily inverted.  */
 	  tem = invert_truthvalue (arg0);
 	  if (TREE_CODE (tem) != TRUTH_NOT_EXPR)
-	    return fold_build2 (TRUTH_ANDIF_EXPR, type, tem, op2);
+	    return fold_build2 (TRUTH_ANDIF_EXPR, type,
+				fold_convert (type, tem),
+				op2);
 	}
 
       /* Convert A ? 1 : B into A || B if A and B are truth values.  */
       if (integer_onep (arg1)
 	  && truth_value_p (TREE_CODE (arg0))
 	  && truth_value_p (TREE_CODE (op2)))
-	return fold_build2 (TRUTH_ORIF_EXPR, type, arg0, op2);
+	return fold_build2 (TRUTH_ORIF_EXPR, type,
+			    fold_convert (type, arg0),
+			    op2);
 
       return NULL_TREE;
 
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7f21c521f99..d874b602ca8 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,53 @@
+2006-04-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/27122
+	* resolve.c (resolve_function): Remove general restriction on auto
+	character length function interfaces.
+	(gfc_resolve_uops): Check restrictions on defined operator
+	procedures.
+	(resolve_types): Call the check for defined operators.
+
+	PR fortran/27113
+	* trans-array.c (get_array_ctor_var_strlen): Remove typo in enum.
+	Part of the fix in 4.2, which does not work in 4.1 because the
+	divergence is now too great.
+
+	PR fortran/26822
+	* intrinsic.c (add_functions): Mark LOGICAL as elemental.
+
+	PR fortran/26787
+	* expr.c (gfc_check_assign): Extend scope of error to include
+	assignments to a procedure in the main program or, from a
+	module or internal procedure that is not that represented by
+	the lhs symbol. Use VARIABLE rather than l-value in message.
+
+	PR fortran/25597
+	* trans-decl.c (gfc_trans_deferred_vars): Check if an array
+	result, is also automatic character length.  If so, process
+	the character length. Note that this fixes the bug in 4.2
+	but not here in 4.1 because the trees have diverged too much.
+	Manifestly correct, so applied anyway.
+
+	PR fortran/18803
+	PR fortran/25669
+	PR fortran/26834
+	* trans_intrinsic.c (gfc_walk_intrinsic_bound): Set
+	data.info.dimen for bound intrinsics.
+	* trans_array.c (gfc_conv_ss_startstride): Pick out LBOUND and
+	UBOUND intrinsics and supply their shape information to the ss
+	and the loop.
+
+	PR fortran/27124
+	* trans_expr.c (gfc_trans_function_call):  Add a new block, post,
+	in to which all the argument post blocks are put.  Add this block
+	to se->pre after a byref call or to se->post, otherwise.
+
+2006-04-22  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/26769
+	* iresolve.c (gfc_resolve_reshape): Use reshape_r16 for real(16).
+	(gfc_resolve_transpose): Use transpose_r16 for real(16).
+
 2006-04-18  Steve Ellcey  <sje@cup.hp.com>
 
 	* trans-io.c (gfc_build_io_library_fndecls): Align pad.
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 6ff35caed2a..d0fcbe2336c 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1863,13 +1863,49 @@ gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform)
       return FAILURE;
     }
 
-  if (sym->attr.flavor == FL_PROCEDURE && sym->attr.use_assoc)
+/* 12.5.2.2, Note 12.26: The result variable is very similar to any other
+   variable local to a function subprogram.  Its existence begins when
+   execution of the function is initiated and ends when execution of the
+   function is terminated.....
+   Therefore, the left hand side is no longer a varaiable, when it is:*/
+  if (sym->attr.flavor == FL_PROCEDURE
+	&& sym->attr.proc != PROC_ST_FUNCTION
+	&& !sym->attr.external)
     {
-      gfc_error ("'%s' in the assignment at %L cannot be an l-value "
-		 "since it is a procedure", sym->name, &lvalue->where);
-      return FAILURE;
-    }
+      bool bad_proc;
+      bad_proc = false;
+
+      /* (i) Use associated; */
+      if (sym->attr.use_assoc)
+	bad_proc = true;
+
+      /* (ii) The assignement is in the main program; or  */
+      if (gfc_current_ns->proc_name->attr.is_main_program)
+	bad_proc = true;
+
+      /* (iii) A module or internal procedure....  */
+      if ((gfc_current_ns->proc_name->attr.proc == PROC_INTERNAL
+	     || gfc_current_ns->proc_name->attr.proc == PROC_MODULE)
+	  && gfc_current_ns->parent
+	  && (!(gfc_current_ns->parent->proc_name->attr.function
+		  || gfc_current_ns->parent->proc_name->attr.subroutine)
+	      || gfc_current_ns->parent->proc_name->attr.is_main_program))
+	{
+	  /* .... that is not a function.... */ 
+	  if (!gfc_current_ns->proc_name->attr.function)
+	    bad_proc = true;
+
+	  /* .... or is not an entry and has a different name.  */
+	  if (!sym->attr.entry && sym->name != gfc_current_ns->proc_name->name)
+	    bad_proc = true;
+	}
 
+      if (bad_proc)
+	{
+	  gfc_error ("'%s' at %L is not a VALUE", sym->name, &lvalue->where);
+	  return FAILURE;
+	}
+    }
 
   if (rvalue->rank != 0 && lvalue->rank != rvalue->rank)
     {
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 707fe5b456a..78289227d7d 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1670,7 +1670,7 @@ add_functions (void)
 
   make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
 
-  add_sym_2 ("logical", 0, 1, BT_LOGICAL, dl, GFC_STD_F95,
+  add_sym_2 ("logical", 1, 1, BT_LOGICAL, dl, GFC_STD_F95,
 	     gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
 	     l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
 
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index d07864ee36e..ecb1448df12 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1,6 +1,6 @@
 /* Intrinsic function resolution.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation,
-   Inc.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006
+   Free Software Foundation, Inc.
    Contributed by Andy Vaught & Katherine Holcomb
 
 This file is part of GCC.
@@ -1520,7 +1520,7 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
 	f->value.function.name =
 	  gfc_get_string (PREFIX("reshape_%c%d"),
 			  gfc_type_letter (BT_COMPLEX), source->ts.kind);
-      else if (source->ts.type == BT_REAL && kind == 10)
+      else if (source->ts.type == BT_REAL && (kind == 10 || kind == 16))
 	f->value.function.name =
 	  gfc_get_string (PREFIX("reshape_%c%d"),
 			  gfc_type_letter (BT_REAL), source->ts.kind);
@@ -1994,9 +1994,10 @@ gfc_resolve_transpose (gfc_expr * f, gfc_expr * matrix)
           break;
 
         case BT_REAL:
-	  /* There is no kind=10 integer type.  We need to
+	  /* There is no kind=10 integer type and on 32-bit targets
+	     there is usually no kind=16 integer type.  We need to
 	     call the real version.  */
-	  if (kind == 10)
+	  if (kind == 10 || kind == 16)
 	    {
 	      f->value.function.name =
 		gfc_get_string (PREFIX("transpose_r%d"), kind);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5f1e7278e24..9f398a3ced2 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -947,9 +947,17 @@ resolve_generic_f0 (gfc_expr * expr, gfc_symbol * sym)
 	{
 	  expr->value.function.name = s->name;
 	  expr->value.function.esym = s;
-	  expr->ts = s->ts;
+
+	  if (s->ts.type != BT_UNKNOWN)
+	    expr->ts = s->ts;
+	  else if (s->result != NULL && s->result->ts.type != BT_UNKNOWN)
+	    expr->ts = s->result->ts;
+
 	  if (s->as != NULL)
 	    expr->rank = s->as->rank;
+	  else if (s->result != NULL && s->result->as != NULL)
+	    expr->rank = s->result->as->rank;
+
 	  return MATCH_YES;
 	}
 
@@ -1224,28 +1232,16 @@ resolve_function (gfc_expr * expr)
   need_full_assumed_size--;
 
   if (sym && sym->ts.type == BT_CHARACTER
-	  && sym->ts.cl && sym->ts.cl->length == NULL)
+	&& sym->ts.cl
+	&& sym->ts.cl->length == NULL
+	&& !sym->attr.dummy
+	&& !sym->attr.contained)
     {
-      if (sym->attr.if_source == IFSRC_IFBODY)
-	{
-	  /* This follows from a slightly odd requirement at 5.1.1.5 in the
-	     standard that allows assumed character length functions to be
-	     declared in interfaces but not used.  Picking up the symbol here,
-	     rather than resolve_symbol, accomplishes that.  */
-	  gfc_error ("Function '%s' can be declared in an interface to "
-		     "return CHARACTER(*) but cannot be used at %L",
-		     sym->name, &expr->where);
-	  return FAILURE;
-	}
-
       /* Internal procedures are taken care of in resolve_contained_fntype.  */
-      if (!sym->attr.dummy && !sym->attr.contained)
-	{
-	  gfc_error ("Function '%s' is declared CHARACTER(*) and cannot "
-		     "be used at %L since it is not a dummy argument",
-		     sym->name, &expr->where);
-	  return FAILURE;
-	}
+      gfc_error ("Function '%s' is declared CHARACTER(*) and cannot "
+		 "be used at %L since it is not a dummy argument",
+		 sym->name, &expr->where);
+      return FAILURE;
     }
 
 /* See if function is already resolved.  */
@@ -6084,6 +6080,68 @@ resolve_fntype (gfc_namespace * ns)
       }
 }
 
+/* 12.3.2.1.1 Defined operators.  */
+
+static void
+gfc_resolve_uops(gfc_symtree *symtree)
+{
+  gfc_interface *itr;
+  gfc_symbol *sym;
+  gfc_formal_arglist *formal;
+
+  if (symtree == NULL) 
+    return; 
+ 
+  gfc_resolve_uops (symtree->left);
+  gfc_resolve_uops (symtree->right);
+
+  for (itr = symtree->n.uop->operator; itr; itr = itr->next)
+    {
+      sym = itr->sym;
+      if (!sym->attr.function)
+	gfc_error("User operator procedure '%s' at %L must be a FUNCTION",
+		  sym->name, &sym->declared_at);
+
+      if (sym->ts.type == BT_CHARACTER
+	    && !(sym->ts.cl && sym->ts.cl->length)
+	    && !(sym->result && sym->result->ts.cl && sym->result->ts.cl->length))
+	gfc_error("User operator procedure '%s' at %L cannot be assumed character "
+		  "length", sym->name, &sym->declared_at);
+
+      formal = sym->formal;
+      if (!formal || !formal->sym)
+	{
+	  gfc_error("User operator procedure '%s' at %L must have at least "
+		    "one argument", sym->name, &sym->declared_at);
+	  continue;
+	}
+
+      if (formal->sym->attr.intent != INTENT_IN)
+	gfc_error ("First argument of operator interface at %L must be "
+		   "INTENT(IN)", &sym->declared_at);
+
+      if (formal->sym->attr.optional)
+	gfc_error ("First argument of operator interface at %L cannot be "
+		   "optional", &sym->declared_at);
+
+      formal = formal->next;
+      if (!formal || !formal->sym)
+	continue;
+
+      if (formal->sym->attr.intent != INTENT_IN)
+	gfc_error ("Second argument of operator interface at %L must be "
+		   "INTENT(IN)", &sym->declared_at);
+
+      if (formal->sym->attr.optional)
+	gfc_error ("Second argument of operator interface at %L cannot be "
+		   "optional", &sym->declared_at);
+
+      if (formal->next)
+	gfc_error ("Operator interface at %L must have, at most, two "
+		   "arguments", &sym->declared_at);
+    }
+}
+
 
 /* Examine all of the expressions associated with a program unit,
    assign types to all intermediate expressions, make sure that all
@@ -6143,6 +6201,8 @@ resolve_types (gfc_namespace * ns)
   /* Warn about unused labels.  */
   if (gfc_option.warn_unused_labels)
     warn_unused_label (ns);
+
+  gfc_resolve_uops (ns->uop_root);
 }
 
 
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 19c5724ddf0..3cd86fa1129 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1304,7 +1304,7 @@ get_array_ctor_var_strlen (gfc_expr * expr, tree * len)
 	  /* Array references don't change the string length.  */
 	  break;
 
-	case COMPONENT_REF:
+	case REF_COMPONENT:
 	  /* Use the length of the component.  */
 	  ts = &ref->u.c.component->ts;
 	  break;
@@ -2386,6 +2386,18 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
 	  loop->dimen = ss->data.info.dimen;
 	  break;
 
+	/* As usual, lbound and ubound are exceptions!.  */
+	case GFC_SS_INTRINSIC:
+	  switch (ss->expr->value.function.isym->generic_id)
+	    {
+	    case GFC_ISYM_LBOUND:
+	    case GFC_ISYM_UBOUND:
+	      loop->dimen = ss->data.info.dimen;
+
+	    default:
+	      break;
+	    }
+
 	default:
 	  break;
 	}
@@ -2411,6 +2423,17 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
 	    gfc_conv_section_startstride (loop, ss, n);
 	  break;
 
+	case GFC_SS_INTRINSIC:
+	  switch (ss->expr->value.function.isym->generic_id)
+	    {
+	    /* Fall through to supply start and stride.  */
+	    case GFC_ISYM_LBOUND:
+	    case GFC_ISYM_UBOUND:
+	      break;
+	    default:
+	      continue;
+	    }
+
 	case GFC_SS_CONSTRUCTOR:
 	case GFC_SS_FUNCTION:
 	  for (n = 0; n < ss->data.info.dimen; n++)
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index a5649ad07ae..8e4f00b02d3 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2500,6 +2500,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 	{
 	  tree result = TREE_VALUE (current_fake_result_decl);
 	  fnbody = gfc_trans_dummy_array_bias (proc_sym, result, fnbody);
+
+	  /* An automatic character length, pointer array result.  */
+	  if (proc_sym->ts.type == BT_CHARACTER
+		&& TREE_CODE (proc_sym->ts.cl->backend_decl) == VAR_DECL)
+	    fnbody = gfc_trans_dummy_character (proc_sym->ts.cl, fnbody);
 	}
       else if (proc_sym->ts.type == BT_CHARACTER)
 	{
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 99ff8e3949f..b10765ccd45 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1809,6 +1809,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
   gfc_charlen cl;
   gfc_expr *e;
   gfc_symbol *fsym;
+  stmtblock_t post;
 
   arglist = NULL_TREE;
   retargs = NULL_TREE;
@@ -1838,6 +1839,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
   else
     info = NULL;
 
+  gfc_init_block (&post);
   gfc_init_interface_mapping (&mapping);
   need_interface_mapping = ((sym->ts.type == BT_CHARACTER
 				  && sym->ts.cl->length
@@ -1935,7 +1937,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 	gfc_add_interface_mapping (&mapping, fsym, &parmse);
 
       gfc_add_block_to_block (&se->pre, &parmse.pre);
-      gfc_add_block_to_block (&se->post, &parmse.post);
+      gfc_add_block_to_block (&post, &parmse.post);
 
       /* Character strings are passed as two parameters, a length and a
          pointer.  */
@@ -2140,6 +2142,12 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 	}
     }
 
+  /* Follow the function call with the argument post block.  */
+  if (byref)
+    gfc_add_block_to_block (&se->pre, &post);
+  else
+    gfc_add_block_to_block (&se->post, &post);
+
   return has_alternate_specifier;
 }
 
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index baff2b38e28..ea8f0e3d835 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -3710,6 +3710,7 @@ gfc_walk_intrinsic_bound (gfc_ss * ss, gfc_expr * expr)
   newss->type = GFC_SS_INTRINSIC;
   newss->expr = expr;
   newss->next = ss;
+  newss->data.info.dimen = 1;
 
   return newss;
 }
diff --git a/gcc/stor-layout.c b/gcc/stor-layout.c
index d6d7d161978..5e81a3f59f6 100644
--- a/gcc/stor-layout.c
+++ b/gcc/stor-layout.c
@@ -658,6 +658,10 @@ update_alignment_for_field (record_layout_info rli, tree field,
   bool user_align;
   bool is_bitfield;
 
+  /* Do not attempt to align an ERROR_MARK node */
+  if (TREE_CODE (type) == ERROR_MARK)
+    return 0;
+
   /* Lay out the field so we know what alignment it needs.  */
   layout_decl (field, known_align);
   desired_align = DECL_ALIGN (field);
@@ -770,6 +774,12 @@ place_union_field (record_layout_info rli, tree field)
   DECL_FIELD_BIT_OFFSET (field) = bitsize_zero_node;
   SET_DECL_OFFSET_ALIGN (field, BIGGEST_ALIGNMENT);
 
+  /* If this is an ERROR_MARK return *after* having set the 
+     field at the start of the union. This helps when parsing
+     invalid fields. */
+  if (TREE_CODE (TREE_TYPE (field)) == ERROR_MARK)
+    return;
+
   /* We assume the union's size will be a multiple of a byte so we don't
      bother with BITPOS.  */
   if (TREE_CODE (rli->t) == UNION_TYPE)
@@ -818,17 +828,6 @@ place_field (record_layout_info rli, tree field)
 
   gcc_assert (TREE_CODE (field) != ERROR_MARK);
 
-  if (TREE_CODE (type) == ERROR_MARK)
-    {
-      if (TREE_CODE (field) == FIELD_DECL)
-	{
-	  DECL_FIELD_OFFSET (field) = size_int (0);
-	  DECL_FIELD_BIT_OFFSET (field) = bitsize_int (0);
-	}
-      
-      return;
-    }
-  
   /* If FIELD is static, then treat it like a separate variable, not
      really like a structure field.  If it is a FUNCTION_DECL, it's a
      method.  In both cases, all we do is lay out the decl, and we do
@@ -853,6 +852,16 @@ place_field (record_layout_info rli, tree field)
       return;
     }
 
+  else if (TREE_CODE (type) == ERROR_MARK) 
+    {
+      /* Place this field at the current allocation position, so we
+	 maintain monotonicity.  */
+      DECL_FIELD_OFFSET (field) = rli->offset;
+      DECL_FIELD_BIT_OFFSET (field) = rli->bitpos;
+      SET_DECL_OFFSET_ALIGN (field, rli->offset_align);
+      return;
+    }
+
   /* Work out the known alignment so far.  Note that A & (-A) is the
      value of the least-significant bit in A that is one.  */
   if (! integer_zerop (rli->bitpos))
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3757c8e1fda..1f2fca089a8 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,53 @@
+2006-04-24  Roger Sayle  <roger@eyesopen.com>
+
+	PR target/26961
+	* gcc.dg/fold-cond-1.c: New test case.
+	* gcc.dg/pr26961-1.c: Likewise.
+
+2006-04-23  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc.dg/sibcall-7.c: New test.
+	* gcc.dg/tree-ssa/tailrecursion-1.c: Pass -foptimize-sibling-calls.
+	* gcc.dg/tree-ssa/tailrecursion-2.c: Likewise.
+	* gcc.dg/tree-ssa/tailrecursion-3.c: Likewise.
+	* gcc.dg/tree-ssa/tailrecursion-4.c: Likewise.
+	* gcc.dg/tree-ssa/tailrecursion-5.c: Likewise.
+
+2006-04-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/27122
+	* gfortran.dg/defined_operators_1.f90: New test.
+	* gfortran.dg/assumed_charlen_function_1.f90: Add new error and
+	remove old ones associated, incorrectly, with Note 5.46.
+
+	PR fortran/26787
+	* gfortran.dg/proc_assign_1.f90: New test.
+	* gfortran.dg/procedure_lvalue.f90: Change message.
+	* gfortran.dg/namelist_4.f90: Add new error.
+
+	PR fortran/27089
+	* gfortran.dg/specification_type_resolution_1.f90
+
+	PR fortran/18803
+	PR fortran/25669
+	PR fortran/26834
+	* gfortran.dg/bounds_temporaries_1.f90: New test.
+
+	PR fortran/27124
+	* gfortran.dg/array_return_value_1.f90: New test.
+
+2006-04-21  Carlos O'Donell  <carlos@codesourcery.com>
+
+	Backport from mainline:
+	2006-04-19  Carlos O'Donell  <carlos@codesourcery.com>
+	PR c/26774
+	* gcc.dg/struct-parse-1.c: New test case.
+
+2006-04-21  Volker Reichelt  <reichelt@igpm.rwth-aachen.de>
+
+	PR c/25875
+	* gcc.dg/init-bad-4.c: New test.
+
 2006-04-21  Paul Brook  <paul@codesourcery.com>
 
 	Backport from mainline.
diff --git a/gcc/testsuite/gcc.dg/fold-cond-1.c b/gcc/testsuite/gcc.dg/fold-cond-1.c
new file mode 100644
index 00000000000..e9212d1ae7b
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/fold-cond-1.c
@@ -0,0 +1,28 @@
+/* { dg-do compile } */
+/* { dg-options "-O2 -fdump-tree-original" } */
+
+_Bool test1(int a, int b)
+{
+  return a ? b : 0;
+}
+
+_Bool test2(int c, int d)
+{
+  return c ? d : 1;
+}
+
+_Bool test3(int e, int f)
+{
+  return e ? 0 : f;
+}
+
+_Bool test4(int g, int h)
+{
+  return g ? 1 : h;
+}
+
+/* { dg-final { scan-tree-dump-times "a != 0 \&\& b != 0" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "c == 0 \\|\\| d != 0" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "e == 0 \&\& f != 0" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "\\(g \\| h\\) != 0" 1 "original" } } */
+/* { dg-final { cleanup-tree-dump "original" } } */
diff --git a/gcc/testsuite/gcc.dg/init-bad-4.c b/gcc/testsuite/gcc.dg/init-bad-4.c
new file mode 100644
index 00000000000..3f03002908a
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/init-bad-4.c
@@ -0,0 +1,5 @@
+/* PR c/25875 */
+/* Origin: Richard Guenther <rguenth@gcc.gnu.org> */
+/* { dg-do compile } */
+
+struct A { } a = (struct A) {{ (X)0 }};  /* { dg-error "no members|extra brace|near|undeclared|constant|compound" } */
diff --git a/gcc/testsuite/gcc.dg/pr26961-1.c b/gcc/testsuite/gcc.dg/pr26961-1.c
new file mode 100644
index 00000000000..56907d89d47
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/pr26961-1.c
@@ -0,0 +1,8 @@
+/* { dg-do compile } */
+/* { dg-options "-O2" } */
+
+long long foo(int i, int j)
+{
+  return i ? (long long)(!j) : 0;
+}
+
diff --git a/gcc/testsuite/gcc.dg/sibcall-7.c b/gcc/testsuite/gcc.dg/sibcall-7.c
new file mode 100644
index 00000000000..273c2c36d21
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/sibcall-7.c
@@ -0,0 +1,43 @@
+/* Simple check that tail recursive call optimization is also
+   controlled by -foptimize-sibling-calls.
+
+   Copyright (C) 2006 Free Software Foundation Inc.
+   Original test by Hans-Peter Nilsson  <hp@bitrange.com>  */
+
+/* { dg-do run } */
+/* { dg-options "-O2 -fno-optimize-sibling-calls" } */
+
+
+extern void abort (void);
+
+extern void recurser_void (int);
+extern void track (int);
+
+int main (void)
+{
+  recurser_void (0);
+  return 0;
+}
+
+void recurser_void (int n)
+{
+  if (n == 0 || n == 7)
+    track (n);
+
+  if (n == 10)
+    return;
+
+  recurser_void (n + 1);
+}
+
+void *trackpoint;
+
+void track (int n)
+{
+  char stackpos[1];
+
+  if (n == 0)
+    trackpoint = stackpos;
+  else if (n != 7 || trackpoint == stackpos)
+    abort ();
+}
diff --git a/gcc/testsuite/gcc.dg/struct-parse-1.c b/gcc/testsuite/gcc.dg/struct-parse-1.c
new file mode 100644
index 00000000000..32c115797fd
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/struct-parse-1.c
@@ -0,0 +1,11 @@
+/* Copyright (C) 2006 Free Software Foundation, Inc. */
+/* Contributed by Carlos O'Donell on 2006-03-31 */
+
+/* This code caused the C frontend to loop 
+   forever exhausting all system memory, or ICE */
+/* Origin: Carlos O'Donell <carlos@codesourcery.com> */
+
+/* { dg-options "-std=c99" } */
+struct s { int a; int b; struct t c; }; /* { dg-error "error: field 'c' has incomplete type" } */
+struct s d = { .b = 0 };
+
diff --git a/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-1.c b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-1.c
index af65736661f..8802bc8bc69 100644
--- a/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-1.c
+++ b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-1.c
@@ -1,5 +1,5 @@
 /* { dg-do compile } */
-/* { dg-options "-O1 -fdump-tree-tailr-details" } */
+/* { dg-options "-O1 -foptimize-sibling-calls -fdump-tree-tailr-details" } */
 int
 t(int a)
 {
diff --git a/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-2.c b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-2.c
index d0bc8b9c230..9fe3af9855a 100644
--- a/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-2.c
+++ b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-2.c
@@ -1,5 +1,5 @@
 /* { dg-do compile } */
-/* { dg-options "-O1 -fdump-tree-tailr-details" } */
+/* { dg-options "-O1 -foptimize-sibling-calls -fdump-tree-tailr-details" } */
 int
 t(char *a)
 {
diff --git a/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-3.c b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-3.c
index 4e0ca133e5d..ca727df391d 100644
--- a/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-3.c
+++ b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-3.c
@@ -1,5 +1,5 @@
 /* { dg-do compile } */
-/* { dg-options "-O1 -fdump-tree-tailr-details" } */
+/* { dg-options "-O1 -foptimize-sibling-calls -fdump-tree-tailr-details" } */
 int
 t(int a)
 {
diff --git a/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-4.c b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-4.c
index edab9833f0f..bb43d76aca9 100644
--- a/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-4.c
+++ b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-4.c
@@ -1,5 +1,5 @@
 /* { dg-do compile } */
-/* { dg-options "-O1 -fdump-tree-tailr-details" } */
+/* { dg-options "-O1 -foptimize-sibling-calls -fdump-tree-tailr-details" } */
 int
 t(int a)
 {
diff --git a/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-5.c b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-5.c
index 2a0af0a714b..53a2cdb15e3 100644
--- a/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-5.c
+++ b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-5.c
@@ -1,5 +1,5 @@
 /* { dg-do run } */
-/* { dg-options "-O1 -fdump-tree-optimized" } */
+/* { dg-options "-O1 -foptimize-sibling-calls -fdump-tree-optimized" } */
 
 extern void abort (void);
 extern void exit (int);
diff --git a/gcc/testsuite/gfortran.dg/array_return_value_1.f90 b/gcc/testsuite/gfortran.dg/array_return_value_1.f90
new file mode 100644
index 00000000000..45699ffd7d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_return_value_1.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! Tests the fix for PR27124 in which the unpacking of argument
+! temporaries and of array result temporaries occurred in the
+! incorrect order.
+! 
+! Test is based on the original example, provided by
+! Philippe Schaffnit <P.Schaffnit@access.rwth-aachen.de>
+!
+  PROGRAM Test
+    INTEGER :: Array(2, 3) = reshape ((/1,4,2,5,3,6/),(/2,3/))
+    integer :: Brray(2, 3) = 0
+    Brray(1,:) = Function_Test (Array(1,:))
+    if (any(reshape (Brray, (/6/)) .ne. (/11, 0, 12, 0, 13, 0/))) call abort ()
+    Array(1,:) = Function_Test (Array(1,:))
+    if (any(reshape (Array, (/6/)) .ne. (/11, 4, 12, 5, 13, 6/))) call abort ()
+
+  contains
+      FUNCTION Function_Test (Input)
+          INTEGER, INTENT(IN) :: Input(1:3)
+          INTEGER :: Function_Test(1:3)
+          Function_Test = Input + 10
+      END FUNCTION Function_Test
+  END PROGRAM Test
+
diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f90
index e10fd70b584..a28934e2597 100644
--- a/gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f90
@@ -17,7 +17,7 @@ END MODULE M1
 

 MODULE  INTEGER_SETS

  INTERFACE  OPERATOR  (.IN.)

-  FUNCTION ELEMENT(X,A)

+  FUNCTION ELEMENT(X,A) ! { dg-error "cannot be assumed character length" }

      USE M1

      CHARACTER(LEN=*)      :: ELEMENT

      INTEGER, INTENT(IN)   ::  X

@@ -59,7 +59,6 @@ function not_OK (ch)
   not_OK = ch

 end function not_OK

 

-  use INTEGER_SETS

   use m1

 

   character(4) :: answer

@@ -74,11 +73,8 @@ end function not_OK
     end function ext

   end interface

 

-  answer = i.IN.z   ! { dg-error "cannot be used|Operands of user operator" }

-  answer = ext (2)  ! { dg-error "but cannot be used" }

-

   answer = not_OK ("unOK") ! { dg-error "since it is not a dummy" }

 

 END

 

-! { dg-final { cleanup-modules "M1 INTEGER_SETS" } }

+! { dg-final { cleanup-modules "M1" } }

diff --git a/gcc/testsuite/gfortran.dg/bounds_temporaries_1.f90 b/gcc/testsuite/gfortran.dg/bounds_temporaries_1.f90
new file mode 100644
index 00000000000..a277566735d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_temporaries_1.f90
@@ -0,0 +1,64 @@
+! { dg-do compile }
+! This tests the fix for PRs 26834, 25669 and 18803, in which
+! shape information for the lbound and ubound intrinsics was not
+! transferred to the scalarizer.  For this reason, an ICE would
+! ensue, whenever these functions were used in temporaries.
+!
+! The tests are lifted from the PRs and some further checks are
+! done to make sure that nothing is broken.
+!
+! This is PR26834
+subroutine gfcbug34 ()
+  implicit none
+  type t
+     integer, pointer :: i (:) => NULL ()
+  end type t
+  type(t), save :: gf
+  allocate (gf%i(20))
+  write(*,*) 'ubound:', ubound (gf% i)
+  write(*,*) 'lbound:', lbound (gf% i)
+end subroutine gfcbug34
+
+! This is PR25669
+subroutine foo (a)
+  real a(*)
+  call bar (a, LBOUND(a),2)
+end subroutine foo
+subroutine bar (b, i, j)
+  real b(i:j)
+  print *, i, j
+  print *, b(i:j)
+end subroutine bar
+
+! This is PR18003
+subroutine io_bug()
+  integer :: a(10)
+  print *, ubound(a)
+end subroutine io_bug
+
+! This checks that lbound and ubound are OK in  temporary
+! expressions.
+subroutine io_bug_plus()
+  integer :: a(10, 10), b(2)
+  print *, ubound(a)*(/1,2/)
+  print *, (/1,2/)*ubound(a)
+end subroutine io_bug_plus
+
+  character(4) :: ch(2), ech(2) = (/'ABCD', 'EFGH'/)
+  real(4) :: a(2)
+  equivalence (ech,a)  ! { dg-warning "default CHARACTER EQUIVALENCE statement" }
+  integer(1) :: i(8) = (/(j, j = 1,8)/)
+
+! Check that the bugs have gone
+  call io_bug ()
+  call io_bug_plus ()
+  call foo ((/1.0,2.0,3.0/))
+  call gfcbug34 ()
+
+! Check that we have not broken other intrinsics.
+  print *, cos ((/1.0,2.0/))
+  print *, transfer (a, ch)
+  print *, i(1:4) * transfer (a, i, 4) * 2
+end
+
+
diff --git a/gcc/testsuite/gfortran.dg/defined_operators_1.f90 b/gcc/testsuite/gfortran.dg/defined_operators_1.f90
new file mode 100644
index 00000000000..a66b8b6dd00
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/defined_operators_1.f90
@@ -0,0 +1,53 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+! Tests the fix for PR27122, in which the requirements of 12.3.2.1.1
+! for defined operators were not enforced.
+! 
+! Based on PR test by Thomas Koenig  <tkoenig@gcc.gnu.org>
+!
+module mymod
+  interface operator (.foo.)
+     module procedure foo_0 ! { dg-error "must have at least one argument" }
+     module procedure foo_1 ! { dg-error "must be INTENT" }
+     module procedure foo_2 ! { dg-error "cannot be optional" }
+     module procedure foo_3 ! { dg-error "must have, at most, two arguments" }
+     module procedure foo_1_OK
+     module procedure foo_2_OK
+     function foo_chr (chr) ! { dg-error "cannot be assumed character length" }
+      character(*) :: foo_chr
+      character(*), intent(in) :: chr
+     end function foo_chr
+  end interface
+contains
+  function foo_0 ()
+    integer :: foo_1
+    foo_0 = 1
+  end function foo_0
+  function foo_1 (a)
+    integer :: foo_1
+    integer :: a
+    foo_1 = 1
+  end function foo_1
+  function foo_1_OK (a)
+    integer :: foo_1_OK
+    integer, intent (in) :: a
+    foo_1_OK = 1
+  end function foo_1_OK
+  function foo_2 (a, b)
+    integer :: foo_2
+    integer, intent(in) :: a
+    integer, intent(in), optional :: b
+    foo_2 = 2 * a + b
+  end function foo_2
+  function foo_2_OK (a, b)
+    real :: foo_2_OK
+    real, intent(in) :: a
+    real, intent(in) :: b
+    foo_2_OK = 2.0 * a + b
+  end function foo_2_OK
+  function foo_3 (a, b, c)
+    integer :: foo_3
+    integer, intent(in) :: a, b, c
+    foo_3 = a + 3 * b - c
+  end function foo_3
+end module mymod
diff --git a/gcc/testsuite/gfortran.dg/namelist_4.f90 b/gcc/testsuite/gfortran.dg/namelist_4.f90
index 9e62a1f370f..52a5bc9938c 100644
--- a/gcc/testsuite/gfortran.dg/namelist_4.f90
+++ b/gcc/testsuite/gfortran.dg/namelist_4.f90
@@ -28,8 +28,9 @@ program P1
 CONTAINS

 ! This has the additional wrinkle of a reference to the object.

   INTEGER FUNCTION F1()

-    NAMELIST /NML3/ F2 ! { dg-error "PROCEDURE attribute conflicts" }

-    f2 = 1     ! Used to ICE here

+    NAMELIST /NML3/ F2 ! { dg-error "PROCEDURE attribute conflicts" }
+! Used to ICE here

+    f2 = 1             ! { dg-error "is not a VALUE" }

     F1=1

   END FUNCTION

   INTEGER FUNCTION F2()

diff --git a/gcc/testsuite/gfortran.dg/proc_assign_1.f90 b/gcc/testsuite/gfortran.dg/proc_assign_1.f90
new file mode 100644
index 00000000000..9382902fec2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_assign_1.f90
@@ -0,0 +1,79 @@
+! { dg-do compile }

+! This tests the patch for PR26787 in which it was found that setting

+! the result of one module procedure from within another produced an

+! ICE rather than an error.

+!

+! This is an "elaborated" version of the original testcase from

+! Joshua Cogliati  <jjcogliati-r1@yahoo.com>

+!

+function ext1 ()

+    integer ext1, ext2, arg

+    ext1 = 1

+    entry ext2 (arg)

+    ext2 = arg
+! gcc-4.2 version contains this:

+!contains

+!    subroutine int_1 ()

+!        ext1 = arg * arg     ! OK - host associated.

+!    end subroutine int_1

+end function ext1

+

+module simple

+    implicit none

+contains

+    integer function foo () 

+         foo = 10            ! OK - function result

+         call foobar ()

+    contains

+        subroutine foobar ()

+            integer z

+            foo = 20         ! OK - host associated.

+        end subroutine foobar

+    end function foo

+    subroutine bar()         ! This was the original bug.

+        foo = 10             ! { dg-error "is not a VALUE" }

+    end subroutine bar

+    integer function oh_no ()

+        oh_no = 1

+        foo = 5              ! { dg-error "is not a VALUE" }

+    end function oh_no

+end module simple

+

+module simpler

+    implicit none

+contains

+    integer function foo_er () 

+         foo_er = 10         ! OK - function result

+    end function foo_er

+end module simpler

+

+    use simpler

+    real w, stmt_fcn

+    interface

+	function ext1 ()

+	    integer ext1

+	end function ext1

+	function ext2 (arg)

+	    integer ext2, arg

+	end function ext2

+    end interface

+    stmt_fcn (w) = sin (w)     

+    call x (y ())

+    x = 10                   ! { dg-error "Expected VARIABLE" }

+    y = 20                   ! { dg-error "is not a VALUE" }

+    foo_er = 8               ! { dg-error "is not a VALUE" }

+    ext1 = 99                ! { dg-error "is not a VALUE" }

+    ext2 = 99                ! { dg-error "is not a VALUE" }

+    stmt_fcn = 1.0           ! { dg-error "Expected VARIABLE" }

+    w = stmt_fcn (1.0)

+contains

+    subroutine x (i)

+        integer i

+        y = i                ! { dg-error "is not a VALUE" }

+    end subroutine x

+    function y ()

+        integer y

+        y = 2                ! OK - function result

+    end function y

+end

+! { dg-final { cleanup-modules "simple simpler" } }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/procedure_lvalue.f90 b/gcc/testsuite/gfortran.dg/procedure_lvalue.f90
index 2a2c3550454..634eaca0e27 100644
--- a/gcc/testsuite/gfortran.dg/procedure_lvalue.f90
+++ b/gcc/testsuite/gfortran.dg/procedure_lvalue.f90
@@ -14,7 +14,7 @@ end module t
 
 subroutine r
   use t
-  b = 1.       ! { dg-error "l-value since it is a procedure" }
+  b = 1.       ! { dg-error "is not a VALUE" }
   y = a(1.)
 end subroutine r
 
diff --git a/gcc/testsuite/gfortran.dg/specification_type_resolution_1.f90 b/gcc/testsuite/gfortran.dg/specification_type_resolution_1.f90
new file mode 100644
index 00000000000..b830b5dfc7d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/specification_type_resolution_1.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! Test of the fix of PR27089, where gfortran was unable to resolve the
+! type of n_elements_uncommon_with_ in the specification expression on
+! line 21.
+!
+! Test extracted from vec{int}.F90 of tonto.
+!
+module test
+   public    n_elements_uncommon_with_
+   interface n_elements_uncommon_with_
+      module procedure n_elements_uncommon_with
+   end interface
+contains
+   pure function n_elements_uncommon_with(x) result(res)
+      integer(4), dimension(:), intent(in) :: x
+      integer(4) :: res
+      res = size (x, 1)
+   end function
+   pure function elements_uncommon_with(x) result(res)
+      integer(4), dimension(:), intent(in) :: x
+      integer(4), dimension(n_elements_uncommon_with_(x)) :: res
+      res = x
+   end function
+end module test
+   use test
+   integer(4) :: z(4)
+   z = 1
+   print *, elements_uncommon_with (z)
+   print *, n_elements_uncommon_with_ (z)
+end
+! { dg-final { cleanup-modules "test" } }
diff --git a/gcc/tree-tailcall.c b/gcc/tree-tailcall.c
index 7d510af7782..20b520a0751 100644
--- a/gcc/tree-tailcall.c
+++ b/gcc/tree-tailcall.c
@@ -1006,7 +1006,7 @@ execute_tail_calls (void)
 struct tree_opt_pass pass_tail_recursion = 
 {
   "tailr",				/* name */
-  NULL,					/* gate */
+  gate_tail_calls,			/* gate */
   execute_tail_recursion,		/* execute */
   NULL,					/* sub */
   NULL,					/* next */
diff --git a/gcc/treelang/ChangeLog b/gcc/treelang/ChangeLog
index b163506c22a..343c2db5e7f 100644
--- a/gcc/treelang/ChangeLog
+++ b/gcc/treelang/ChangeLog
@@ -1,3 +1,7 @@
+2006-04-22  Matthias Klose  <doko@debian.org>
+
+	* Make-lang.in(treelang.check): Don't set and pass TRANSFORM.
+
 2006-02-28  Release Manager
 
 	* GCC 4.1.0 released.
diff --git a/gcc/treelang/Make-lang.in b/gcc/treelang/Make-lang.in
index 8e99dd770c2..57499e545c4 100644
--- a/gcc/treelang/Make-lang.in
+++ b/gcc/treelang/Make-lang.in
@@ -1,6 +1,6 @@
 # Top level makefile fragment for TREELANG For GCC. -*- makefile -*-
 
-#   Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+#   Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2006
 #   Free Software Foundation, Inc.
 
 #This file is part of GCC.
@@ -299,7 +299,6 @@ treelang.check: $(TESTSUITEDIR)/site.exp
 	srcdir=`cd ${srcdir}; ${PWD_COMMAND}` ; export srcdir ; \
 	cd testsuite; \
 	EXPECT=${EXPECT} ; export EXPECT ; \
-	TRANSFORM=$(program_transform_name); export TRANSFORM; \
 	if [ -f $${rootme}/../expect/expect ] ; then  \
 	   TCL_LIBRARY=`cd .. ; cd ${srcdir}/../tcl/library ; ${PWD_COMMAND}` ; \
 	   export TCL_LIBRARY ; fi ; \
diff --git a/gcc/version.c b/gcc/version.c
index 157b4f76233..f9a42645185 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.0-10)"
+#define VERSUFFIX " (Red Hat 4.1.0-11)"
 
 /* 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 00eb8fea888..63a09b9e3a2 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,12 @@
+2006-04-22  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/26769
+	* Makefile.am (i_transpose_c): Add generated/transpose_r16.c.
+	(i_reshape_c): Add generated/reshape_r16.c.
+	* Makefile.in: Regenerated.
+	* generated/transpose_r16.c: Generated new file.
+	* generated/redhape_r16.c: Generated new file.
+
 2006-04-21  Jakub Jelinek  <jakub@redhat.com>
 
 	PR libgfortran/24685
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index c420c5b40dc..269388dc10e 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -313,6 +313,7 @@ generated/transpose_i4.c \
 generated/transpose_i8.c \
 generated/transpose_i16.c \
 generated/transpose_r10.c \
+generated/transpose_r16.c \
 generated/transpose_c4.c \
 generated/transpose_c8.c \
 generated/transpose_c10.c \
@@ -328,6 +329,7 @@ generated/reshape_i4.c \
 generated/reshape_i8.c \
 generated/reshape_i16.c \
 generated/reshape_r10.c \
+generated/reshape_r16.c \
 generated/reshape_c4.c \
 generated/reshape_c8.c \
 generated/reshape_c10.c \
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index e6aca09243c..a796e3dfa55 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -123,15 +123,15 @@ am__objects_16 = matmul_i4.lo matmul_i8.lo matmul_i16.lo matmul_r4.lo \
 	matmul_c8.lo matmul_c10.lo matmul_c16.lo
 am__objects_17 = matmul_l4.lo matmul_l8.lo matmul_l16.lo
 am__objects_18 = transpose_i4.lo transpose_i8.lo transpose_i16.lo \
-	transpose_r10.lo transpose_c4.lo transpose_c8.lo \
-	transpose_c10.lo transpose_c16.lo
+	transpose_r10.lo transpose_r16.lo transpose_c4.lo \
+	transpose_c8.lo transpose_c10.lo transpose_c16.lo
 am__objects_19 = shape_i4.lo shape_i8.lo shape_i16.lo
 am__objects_20 = eoshift1_4.lo eoshift1_8.lo eoshift1_16.lo
 am__objects_21 = eoshift3_4.lo eoshift3_8.lo eoshift3_16.lo
 am__objects_22 = cshift1_4.lo cshift1_8.lo cshift1_16.lo
 am__objects_23 = reshape_i4.lo reshape_i8.lo reshape_i16.lo \
-	reshape_r10.lo reshape_c4.lo reshape_c8.lo reshape_c10.lo \
-	reshape_c16.lo
+	reshape_r10.lo reshape_r16.lo reshape_c4.lo reshape_c8.lo \
+	reshape_c10.lo reshape_c16.lo
 am__objects_24 = in_pack_i4.lo in_pack_i8.lo in_pack_i16.lo \
 	in_pack_c4.lo in_pack_c8.lo in_pack_c10.lo in_pack_c16.lo
 am__objects_25 = in_unpack_i4.lo in_unpack_i8.lo in_unpack_i16.lo \
@@ -661,6 +661,7 @@ generated/transpose_i4.c \
 generated/transpose_i8.c \
 generated/transpose_i16.c \
 generated/transpose_r10.c \
+generated/transpose_r16.c \
 generated/transpose_c4.c \
 generated/transpose_c8.c \
 generated/transpose_c10.c \
@@ -676,6 +677,7 @@ generated/reshape_i4.c \
 generated/reshape_i8.c \
 generated/reshape_i16.c \
 generated/reshape_r10.c \
+generated/reshape_r16.c \
 generated/reshape_c4.c \
 generated/reshape_c8.c \
 generated/reshape_c10.c \
@@ -1935,6 +1937,9 @@ transpose_i16.lo: generated/transpose_i16.c
 transpose_r10.lo: generated/transpose_r10.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_r10.lo `test -f 'generated/transpose_r10.c' || echo '$(srcdir)/'`generated/transpose_r10.c
 
+transpose_r16.lo: generated/transpose_r16.c
+	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_r16.lo `test -f 'generated/transpose_r16.c' || echo '$(srcdir)/'`generated/transpose_r16.c
+
 transpose_c4.lo: generated/transpose_c4.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c4.lo `test -f 'generated/transpose_c4.c' || echo '$(srcdir)/'`generated/transpose_c4.c
 
@@ -1995,6 +2000,9 @@ reshape_i16.lo: generated/reshape_i16.c
 reshape_r10.lo: generated/reshape_r10.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_r10.lo `test -f 'generated/reshape_r10.c' || echo '$(srcdir)/'`generated/reshape_r10.c
 
+reshape_r16.lo: generated/reshape_r16.c
+	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_r16.lo `test -f 'generated/reshape_r16.c' || echo '$(srcdir)/'`generated/reshape_r16.c
+
 reshape_c4.lo: generated/reshape_c4.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c4.lo `test -f 'generated/reshape_c4.c' || echo '$(srcdir)/'`generated/reshape_c4.c
 
diff --git a/libgfortran/generated/reshape_r16.c b/libgfortran/generated/reshape_r16.c
new file mode 100644
index 00000000000..a83f6246824
--- /dev/null
+++ b/libgfortran/generated/reshape_r16.c
@@ -0,0 +1,268 @@
+/* Implementation of the RESHAPE
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+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.)
+
+Libgfortran 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 "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_REAL_16)
+
+typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
+
+/* The shape parameter is ignored. We can currently deduce the shape from the
+   return array.  */
+
+extern void reshape_r16 (gfc_array_r16 * const restrict, 
+	gfc_array_r16 * const restrict, 
+	shape_type * const restrict,
+	gfc_array_r16 * const restrict, 
+	shape_type * const restrict);
+export_proto(reshape_r16);
+
+void
+reshape_r16 (gfc_array_r16 * const restrict ret, 
+	gfc_array_r16 * const restrict source, 
+	shape_type * const restrict shape,
+	gfc_array_r16 * const restrict pad, 
+	shape_type * const restrict order)
+{
+  /* r.* indicates the return array.  */
+  index_type rcount[GFC_MAX_DIMENSIONS];
+  index_type rextent[GFC_MAX_DIMENSIONS];
+  index_type rstride[GFC_MAX_DIMENSIONS];
+  index_type rstride0;
+  index_type rdim;
+  index_type rsize;
+  index_type rs;
+  index_type rex;
+  GFC_REAL_16 *rptr;
+  /* s.* indicates the source array.  */
+  index_type scount[GFC_MAX_DIMENSIONS];
+  index_type sextent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type sstride0;
+  index_type sdim;
+  index_type ssize;
+  const GFC_REAL_16 *sptr;
+  /* p.* indicates the pad array.  */
+  index_type pcount[GFC_MAX_DIMENSIONS];
+  index_type pextent[GFC_MAX_DIMENSIONS];
+  index_type pstride[GFC_MAX_DIMENSIONS];
+  index_type pdim;
+  index_type psize;
+  const GFC_REAL_16 *pptr;
+
+  const GFC_REAL_16 *src;
+  int n;
+  int dim;
+
+  if (source->dim[0].stride == 0)
+    source->dim[0].stride = 1;
+  if (shape->dim[0].stride == 0)
+    shape->dim[0].stride = 1;
+  if (pad && pad->dim[0].stride == 0)
+    pad->dim[0].stride = 1;
+  if (order && order->dim[0].stride == 0)
+    order->dim[0].stride = 1;
+
+  if (ret->data == NULL)
+    {
+      rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+      rs = 1;
+      for (n=0; n < rdim; n++)
+	{
+	  ret->dim[n].lbound = 0;
+	  rex = shape->data[n * shape->dim[0].stride];
+	  ret->dim[n].ubound =  rex - 1;
+	  ret->dim[n].stride = rs;
+	  rs *= rex;
+	}
+      ret->offset = 0;
+      ret->data = internal_malloc_size ( rs * sizeof (GFC_REAL_16));
+      ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
+    }
+  else
+    {
+      rdim = GFC_DESCRIPTOR_RANK (ret);
+      if (ret->dim[0].stride == 0)
+	ret->dim[0].stride = 1;
+    }
+
+  rsize = 1;
+  for (n = 0; n < rdim; n++)
+    {
+      if (order)
+        dim = order->data[n * order->dim[0].stride] - 1;
+      else
+        dim = n;
+
+      rcount[n] = 0;
+      rstride[n] = ret->dim[dim].stride;
+      rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+
+      if (rextent[n] != shape->data[dim * shape->dim[0].stride])
+        runtime_error ("shape and target do not conform");
+
+      if (rsize == rstride[n])
+        rsize *= rextent[n];
+      else
+        rsize = 0;
+      if (rextent[n] <= 0)
+        return;
+    }
+
+  sdim = GFC_DESCRIPTOR_RANK (source);
+  ssize = 1;
+  for (n = 0; n < sdim; n++)
+    {
+      scount[n] = 0;
+      sstride[n] = source->dim[n].stride;
+      sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+      if (sextent[n] <= 0)
+        abort ();
+
+      if (ssize == sstride[n])
+        ssize *= sextent[n];
+      else
+        ssize = 0;
+    }
+
+  if (pad)
+    {
+      pdim = GFC_DESCRIPTOR_RANK (pad);
+      psize = 1;
+      for (n = 0; n < pdim; n++)
+        {
+          pcount[n] = 0;
+          pstride[n] = pad->dim[n].stride;
+          pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+          if (pextent[n] <= 0)
+            abort ();
+          if (psize == pstride[n])
+            psize *= pextent[n];
+          else
+            psize = 0;
+        }
+      pptr = pad->data;
+    }
+  else
+    {
+      pdim = 0;
+      psize = 1;
+      pptr = NULL;
+    }
+
+  if (rsize != 0 && ssize != 0 && psize != 0)
+    {
+      rsize *= sizeof (GFC_REAL_16);
+      ssize *= sizeof (GFC_REAL_16);
+      psize *= sizeof (GFC_REAL_16);
+      reshape_packed ((char *)ret->data, rsize, (char *)source->data,
+		      ssize, pad ? (char *)pad->data : NULL, psize);
+      return;
+    }
+  rptr = ret->data;
+  src = sptr = source->data;
+  rstride0 = rstride[0];
+  sstride0 = sstride[0];
+
+  while (rptr)
+    {
+      /* Select between the source and pad arrays.  */
+      *rptr = *src;
+      /* Advance to the next element.  */
+      rptr += rstride0;
+      src += sstride0;
+      rcount[0]++;
+      scount[0]++;
+      /* Advance to the next destination element.  */
+      n = 0;
+      while (rcount[n] == rextent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          rcount[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          rptr -= rstride[n] * rextent[n];
+          n++;
+          if (n == rdim)
+            {
+              /* Break out of the loop.  */
+              rptr = NULL;
+              break;
+            }
+          else
+            {
+              rcount[n]++;
+              rptr += rstride[n];
+            }
+        }
+      /* Advance to the next source element.  */
+      n = 0;
+      while (scount[n] == sextent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          scount[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          src -= sstride[n] * sextent[n];
+          n++;
+          if (n == sdim)
+            {
+              if (sptr && pad)
+                {
+                  /* Switch to the pad array.  */
+                  sptr = NULL;
+                  sdim = pdim;
+                  for (dim = 0; dim < pdim; dim++)
+                    {
+                      scount[dim] = pcount[dim];
+                      sextent[dim] = pextent[dim];
+                      sstride[dim] = pstride[dim];
+                      sstride0 = sstride[0];
+                    }
+                }
+              /* We now start again from the beginning of the pad array.  */
+              src = pptr;
+              break;
+            }
+          else
+            {
+              scount[n]++;
+              src += sstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/transpose_r16.c b/libgfortran/generated/transpose_r16.c
new file mode 100644
index 00000000000..797f3c2e557
--- /dev/null
+++ b/libgfortran/generated/transpose_r16.c
@@ -0,0 +1,104 @@
+/* Implementation of the TRANSPOSE intrinsic
+   Copyright 2003, 2005 Free Software Foundation, Inc.
+   Contributed by Tobias Schlüter
+
+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.)
+
+Libgfortran 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 "config.h"
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_REAL_16)
+
+extern void transpose_r16 (gfc_array_r16 * const restrict ret, 
+	gfc_array_r16 * const restrict source);
+export_proto(transpose_r16);
+
+void
+transpose_r16 (gfc_array_r16 * const restrict ret, 
+	gfc_array_r16 * const restrict source)
+{
+  /* r.* indicates the return array.  */
+  index_type rxstride, rystride;
+  GFC_REAL_16 *rptr;
+  /* s.* indicates the source array.  */
+  index_type sxstride, systride;
+  const GFC_REAL_16 *sptr;
+
+  index_type xcount, ycount;
+  index_type x, y;
+
+  assert (GFC_DESCRIPTOR_RANK (source) == 2);
+
+  if (ret->data == NULL)
+    {
+      assert (GFC_DESCRIPTOR_RANK (ret) == 2);
+      assert (ret->dtype == source->dtype);
+
+      ret->dim[0].lbound = 0;
+      ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
+      ret->dim[0].stride = 1;
+
+      ret->dim[1].lbound = 0;
+      ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
+      ret->dim[1].stride = ret->dim[0].ubound+1;
+
+      ret->data = internal_malloc_size (sizeof (GFC_REAL_16) * size0 ((array_t *) ret));
+      ret->offset = 0;
+    }
+
+  if (ret->dim[0].stride == 0)
+    ret->dim[0].stride = 1;
+  if (source->dim[0].stride == 0)
+    source->dim[0].stride = 1;
+
+  sxstride = source->dim[0].stride;
+  systride = source->dim[1].stride;
+  xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
+  ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+  rxstride = ret->dim[0].stride;
+  rystride = ret->dim[1].stride;
+
+  rptr = ret->data;
+  sptr = source->data;
+
+  for (y=0; y < ycount; y++)
+    {
+      for (x=0; x < xcount; x++)
+        {
+          *rptr = *sptr;
+
+          sptr += sxstride;
+          rptr += rystride;
+        }
+        sptr += systride - (sxstride * xcount);
+        rptr += rxstride - (rystride * xcount);
+    }
+}
+
+#endif
diff --git a/libjava/classpath/ChangeLog.gcj b/libjava/classpath/ChangeLog.gcj
index 7b2821b0a27..835302af42d 100644
--- a/libjava/classpath/ChangeLog.gcj
+++ b/libjava/classpath/ChangeLog.gcj
@@ -1,5 +1,11 @@
 2006-04-21  Tom Tromey  <tromey@redhat.com>
 
+	PR classpath/27163:
+	* gnu/java/net/protocol/ftp/FTPConnection.java
+	(changeWorkingDirectory): Do nothing if path is empty.
+
+2006-04-21  Tom Tromey  <tromey@redhat.com>
+
 	PR libgcj/27231:
 	* gnu/java/net/protocol/http/HTTPURLConnection.java (connect): Handle
 	case where no '/' appears in 'location'.
diff --git a/libjava/classpath/gnu/java/net/protocol/ftp/FTPConnection.java b/libjava/classpath/gnu/java/net/protocol/ftp/FTPConnection.java
index d0f48727cfa..f5317d479bc 100644
--- a/libjava/classpath/gnu/java/net/protocol/ftp/FTPConnection.java
+++ b/libjava/classpath/gnu/java/net/protocol/ftp/FTPConnection.java
@@ -429,6 +429,9 @@ public class FTPConnection
   public boolean changeWorkingDirectory(String path)
     throws IOException
   {
+    // Do nothing if the path is empty.
+    if (path.length() == 0)
+      return true;
     String cmd = CWD + ' ' + path;
     send(cmd);
     FTPResponse response = getResponse();