Merge from gcc-7-branch.ARM/embedded-7-branch-2018q2ARM/embedded-7-branch

git-svn-id: https://gcc.gnu.org/svn/gcc/branches/ARM/embedded-7-branch@261903 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 27 insertions, 9 deletions

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index ac5e462a524..e73f2d76f45 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2998,22 +2998,36 @@ done:
     cl->length = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
   else
     {
-      /* If gfortran ends up here, then the len may be reducible to a
-	 constant.  Try to do that here.  If it does not reduce, simply
-	 assign len to the charlen.  */
+      /* If gfortran ends up here, then len may be reducible to a constant.
+	 Try to do that here.  If it does not reduce, simply assign len to
+	 charlen.  A complication occurs with user-defined generic functions,
+	 which are not resolved.  Use a private namespace to deal with
+	 generic functions.  */
+
       if (len && len->expr_type != EXPR_CONSTANT)
 	{
+	  gfc_namespace *old_ns;
 	  gfc_expr *e;
+
+	  old_ns = gfc_current_ns;
+	  gfc_current_ns = gfc_get_namespace (NULL, 0);
+
 	  e = gfc_copy_expr (len);
 	  gfc_reduce_init_expr (e);
 	  if (e->expr_type == EXPR_CONSTANT)
-	    gfc_replace_expr (len, e);
+	    {
+	      gfc_replace_expr (len, e);
+	      if (mpz_cmp_si (len->value.integer, 0) < 0)
+		mpz_set_ui (len->value.integer, 0);
+	    }
 	  else
 	    gfc_free_expr (e);
-	  cl->length = len;
+
+	  gfc_free_namespace (gfc_current_ns);
+	  gfc_current_ns = old_ns;
 	}
-      else
-	cl->length = len;
+
+      cl->length = len;
     }
 
   ts->u.cl = cl;
@@ -9031,8 +9045,12 @@ gfc_match_derived_decl (void)
 
   if (!gensym->attr.generic && gensym->ts.type != BT_UNKNOWN)
     {
-      gfc_error ("Derived type name %qs at %C already has a basic type "
-		 "of %s", gensym->name, gfc_typename (&gensym->ts));
+      if (gensym->ts.u.derived)
+	gfc_error ("Derived type name %qs at %C already has a basic type "
+		   "of %s", gensym->name, gfc_typename (&gensym->ts));
+      else
+	gfc_error ("Derived type name %qs at %C already has a basic type",
+		   gensym->name);
       return MATCH_ERROR;
     }