Merge from branches/gcc-4_8-branch r198615.

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

10 files changed, 145 insertions, 59 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index cbed9baaceb..5c4128e0ee1 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,56 @@
+2013-04-26  Janus Weil  <janus@gcc.gnu.org>
+
+	Backports from trunk:
+
+	PR fortran/56814
+	* interface.c (check_result_characteristics): Get result from interface
+	if present.
+
+	PR fortran/56968
+	* expr.c (gfc_check_pointer_assign): Handle generic functions returning
+	procedure pointers.
+
+	PR fortran/53685
+	PR fortran/57022
+	* check.c (gfc_calculate_transfer_sizes): Fix for array-valued SOURCE
+	expressions.
+	* target-memory.h (gfc_element_size): New prototype.
+	* target-memory.c (size_array): Remove.
+	(gfc_element_size): New function.
+	(gfc_target_expr_size): Modified to always return the full size of the
+	expression.
+
+2013-04-22  Thomas Koenig  <tkoenig@gcc.gnu.org>
+	    Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/56872
+	* frontend-passes.c (copy_walk_reduction_arg): Change argument type
+	to gfc_constructor.  If it has an iterator, wrap the copy of its
+	expression in an array constructor with that iterator.  Don't special
+	case function expressions.
+	(callback_reduction): Update caller.  Don't return early if there is
+	an iterator.
+
+2013-04-18  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/56816
+	* match.c (gfc_match_select_type): Add syntax error. Move namespace
+	allocation and cleanup...
+	* parse.c (decode_statement): ... here.
+
+2013-04-18  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/56994
+	* invoke.texi (NEAREST): S argument is not optional.
+
+2013-04-08  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/56782
+	Backport fron trunk.
+	* frontend-passes.c (callback_reduction):  Dont't do
+	any simplification if there is only a single element
+	which has an iterator.
+
 2013-03-22  Release Manager
 
 	* GCC 4.8.0 released.
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 0e71b9506f8..586adee8b34 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -4017,8 +4017,6 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size,
 			      size_t *result_length_p)
 {
   size_t result_elt_size;
-  mpz_t tmp;
-  gfc_expr *mold_element;
 
   if (source->expr_type == EXPR_FUNCTION)
     return FAILURE;
@@ -4027,20 +4025,12 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size,
     return FAILURE;
 
   /* Calculate the size of the source.  */
-  if (source->expr_type == EXPR_ARRAY
-      && gfc_array_size (source, &tmp) == FAILURE)
-    return FAILURE;
-
   *source_size = gfc_target_expr_size (source);
   if (*source_size == 0)
     return FAILURE;
 
-  mold_element = mold->expr_type == EXPR_ARRAY
-		 ? gfc_constructor_first (mold->value.constructor)->expr
-		 : mold;
-
   /* Determine the size of the element.  */
-  result_elt_size = gfc_target_expr_size (mold_element);
+  result_elt_size = gfc_element_size (mold);
   if (result_elt_size == 0)
     return FAILURE;
 
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 1b74a44ab74..d16bdb09089 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3528,7 +3528,11 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 	}
       else if (rvalue->expr_type == EXPR_FUNCTION)
 	{
-	  s2 = rvalue->symtree->n.sym->result;
+	  if (rvalue->value.function.esym)
+	    s2 = rvalue->value.function.esym->result;
+	  else
+	    s2 = rvalue->symtree->n.sym->result;
+
 	  name = s2->name;
 	}
       else
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index ead32f87882..fdfbce09465 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -188,37 +188,49 @@ optimize_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
    old one can be freed.  */
 
 static gfc_expr *
-copy_walk_reduction_arg (gfc_expr *e, gfc_expr *fn)
+copy_walk_reduction_arg (gfc_constructor *c, gfc_expr *fn)
 {
-  gfc_expr *fcn;
-  gfc_isym_id id;
+  gfc_expr *fcn, *e = c->expr;
 
-  if (e->rank == 0 || e->expr_type == EXPR_FUNCTION)
-    fcn = gfc_copy_expr (e);
-  else
+  fcn = gfc_copy_expr (e);
+  if (c->iterator)
     {
-      id = fn->value.function.isym->id;
+      gfc_constructor_base newbase;
+      gfc_expr *new_expr;
+      gfc_constructor *new_c;
+
+      newbase = NULL;
+      new_expr = gfc_get_expr ();
+      new_expr->expr_type = EXPR_ARRAY;
+      new_expr->ts = e->ts;
+      new_expr->where = e->where;
+      new_expr->rank = 1;
+      new_c = gfc_constructor_append_expr (&newbase, fcn, &(e->where));
+      new_c->iterator = c->iterator;
+      new_expr->value.constructor = newbase;
+      c->iterator = NULL;
+
+      fcn = new_expr;
+    }
+
+  if (fcn->rank != 0)
+    {
+      gfc_isym_id id = fn->value.function.isym->id;
 
       if (id == GFC_ISYM_SUM || id == GFC_ISYM_PRODUCT)
-	fcn = gfc_build_intrinsic_call (current_ns,
-					fn->value.function.isym->id,
+	fcn = gfc_build_intrinsic_call (current_ns, id,
 					fn->value.function.isym->name,
-					fn->where, 3, gfc_copy_expr (e),
-					NULL, NULL);
+					fn->where, 3, fcn, NULL, NULL);
       else if (id == GFC_ISYM_ANY || id == GFC_ISYM_ALL)
-	fcn = gfc_build_intrinsic_call (current_ns,
-					fn->value.function.isym->id,
+	fcn = gfc_build_intrinsic_call (current_ns, id,
 					fn->value.function.isym->name,
-					fn->where, 2, gfc_copy_expr (e),
-					NULL);
+					fn->where, 2, fcn, NULL);
       else
 	gfc_internal_error ("Illegal id in copy_walk_reduction_arg");
 
       fcn->symtree->n.sym->attr.access = ACCESS_PRIVATE;
     }
 
-  (void) gfc_expr_walker (&fcn, callback_reduction, NULL);
-
   return fcn;
 }
 
@@ -296,10 +308,15 @@ callback_reduction (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
 
   c = gfc_constructor_first (arg->value.constructor);
 
+  /* Don't do any simplififcation if we have
+     - no element in the constructor or
+     - only have a single element in the array which contains an
+     iterator.  */
+
   if (c == NULL)
     return 0;
 
-  res = copy_walk_reduction_arg (c->expr, fn);
+  res = copy_walk_reduction_arg (c, fn);
 
   c = gfc_constructor_next (c);
   while (c)
@@ -311,7 +328,7 @@ callback_reduction (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
       new_expr->where = fn->where;
       new_expr->value.op.op = op;
       new_expr->value.op.op1 = res;
-      new_expr->value.op.op2 = copy_walk_reduction_arg (c->expr, fn);
+      new_expr->value.op.op2 = copy_walk_reduction_arg (c, fn);
       res = new_expr;
       c = gfc_constructor_next (c);
     }
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index fff8c39ad93..5ea62757f22 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1182,8 +1182,15 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2,
 {
   gfc_symbol *r1, *r2;
 
-  r1 = s1->result ? s1->result : s1;
-  r2 = s2->result ? s2->result : s2;
+  if (s1->ts.interface && s1->ts.interface->result)
+    r1 = s1->ts.interface->result;
+  else
+    r1 = s1->result ? s1->result : s1;
+
+  if (s2->ts.interface && s2->ts.interface->result)
+    r2 = s2->ts.interface->result;
+  else
+    r2 = s2->result ? s2->result : s2;
 
   if (r1->ts.type == BT_UNKNOWN)
     return SUCCESS;
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 4a48425cd83..1d8e0c0e7ec 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -9248,7 +9248,7 @@ Elemental function
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
 @item @var{X} @tab Shall be of type @code{REAL}.
-@item @var{S} @tab (Optional) shall be of type @code{REAL} and
+@item @var{S} @tab Shall be of type @code{REAL} and
 not equal to zero.
 @end multitable
 
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index d75cf1cc17d..e9a701bb608 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -5364,7 +5364,6 @@ gfc_match_select_type (void)
   char name[GFC_MAX_SYMBOL_LEN];
   bool class_array;
   gfc_symbol *sym;
-  gfc_namespace *parent_ns;
 
   m = gfc_match_label ();
   if (m == MATCH_ERROR)
@@ -5374,8 +5373,6 @@ gfc_match_select_type (void)
   if (m != MATCH_YES)
     return m;
 
-  gfc_current_ns = gfc_build_block_ns (gfc_current_ns);
-
   m = gfc_match (" %n => %e", name, &expr2);
   if (m == MATCH_YES)
     {
@@ -5406,7 +5403,10 @@ gfc_match_select_type (void)
 
   m = gfc_match (" )%t");
   if (m != MATCH_YES)
-    goto cleanup;
+    {
+      gfc_error ("parse error in SELECT TYPE statement at %C");
+      goto cleanup;
+    }
 
   /* This ghastly expression seems to be needed to distinguish a CLASS
      array, which can have a reference, from other expressions that
@@ -5444,9 +5444,6 @@ gfc_match_select_type (void)
   return MATCH_YES;
 
 cleanup:
-  parent_ns = gfc_current_ns->parent;
-  gfc_free_namespace (gfc_current_ns);
-  gfc_current_ns = parent_ns;
   return m;
 }
 
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 6ee7b7fb85c..33d325d8df9 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -262,6 +262,7 @@ end_of_block:
 static gfc_statement
 decode_statement (void)
 {
+  gfc_namespace *ns;
   gfc_statement st;
   locus old_locus;
   match m;
@@ -363,7 +364,12 @@ decode_statement (void)
   match (NULL, gfc_match_associate, ST_ASSOCIATE);
   match (NULL, gfc_match_critical, ST_CRITICAL);
   match (NULL, gfc_match_select, ST_SELECT_CASE);
+
+  gfc_current_ns = gfc_build_block_ns (gfc_current_ns);
   match (NULL, gfc_match_select_type, ST_SELECT_TYPE);
+  ns = gfc_current_ns;
+  gfc_current_ns = gfc_current_ns->parent;
+  gfc_free_namespace (ns);
 
   /* General statement matching: Instead of testing every possible
      statement, we eliminate most possibilities by peeking at the
diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index caad1b4368d..26a5de2326d 100644
--- a/gcc/fortran/target-memory.c
+++ b/gcc/fortran/target-memory.c
@@ -35,16 +35,6 @@ along with GCC; see the file COPYING3.  If not see
 /* --------------------------------------------------------------- */ 
 /* Calculate the size of an expression.  */
 
-static size_t
-size_array (gfc_expr *e)
-{
-  mpz_t array_size;
-  gfc_constructor *c = gfc_constructor_first (e->value.constructor);
-  size_t elt_size = gfc_target_expr_size (c->expr);
-
-  gfc_array_size (e, &array_size);
-  return (size_t)mpz_get_ui (array_size) * elt_size;
-}
 
 static size_t
 size_integer (int kind)
@@ -82,16 +72,14 @@ size_character (int length, int kind)
 }
 
 
+/* Return the size of a single element of the given expression.
+   Identical to gfc_target_expr_size for scalars.  */
+
 size_t
-gfc_target_expr_size (gfc_expr *e)
+gfc_element_size (gfc_expr *e)
 {
   tree type;
 
-  gcc_assert (e != NULL);
-
-  if (e->expr_type == EXPR_ARRAY)
-    return size_array (e);
-
   switch (e->ts.type)
     {
     case BT_INTEGER:
@@ -133,12 +121,36 @@ gfc_target_expr_size (gfc_expr *e)
 	return size;
       }
     default:
-      gfc_internal_error ("Invalid expression in gfc_target_expr_size.");
+      gfc_internal_error ("Invalid expression in gfc_element_size.");
       return 0;
     }
 }
 
 
+/* Return the size of an expression in its target representation.  */
+
+size_t
+gfc_target_expr_size (gfc_expr *e)
+{
+  mpz_t tmp;
+  size_t asz;
+
+  gcc_assert (e != NULL);
+
+  if (e->rank)
+    {
+      if (gfc_array_size (e, &tmp))
+	asz = mpz_get_ui (tmp);
+      else
+	asz = 0;
+    }
+  else
+    asz = 1;
+
+  return asz * gfc_element_size (e);
+}
+
+
 /* The encode_* functions export a value into a buffer, and 
    return the number of bytes of the buffer that have been
    used.  */
diff --git a/gcc/fortran/target-memory.h b/gcc/fortran/target-memory.h
index 8eebf8752cc..100321a2b7a 100644
--- a/gcc/fortran/target-memory.h
+++ b/gcc/fortran/target-memory.h
@@ -24,7 +24,7 @@ along with GCC; see the file COPYING3.  If not see
 /* Convert a BOZ to REAL or COMPLEX.  */
 bool gfc_convert_boz (gfc_expr *, gfc_typespec *);
 
-/* Return the size of an expression in its target representation.  */
+size_t gfc_element_size (gfc_expr *);
 size_t gfc_target_expr_size (gfc_expr *);
 
 /* Write a constant expression in binary form to a target buffer.  */