1 files changed, 34 insertions, 5 deletions

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 7eeb5a68aa..1655de2c9f 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -125,6 +125,7 @@ gfc_run_passes (gfc_namespace *ns)
   doloop_level = 0;
   doloop_warn (ns);
   doloop_list.release ();
+  int w, e;
 
   if (flag_frontend_optimize)
     {
@@ -136,6 +137,10 @@ gfc_run_passes (gfc_namespace *ns)
       expr_array.release ();
     }
 
+  gfc_get_errors (&w, &e);
+  if (e > 0)
+   return;
+
   if (flag_realloc_lhs)
     realloc_strings (ns);
 }
@@ -174,8 +179,17 @@ realloc_string_callback (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
 
   if (!gfc_check_dependency (expr1, expr2, true))
     return 0;
-  
+
+  /* gfc_check_dependency doesn't always pick up identical expressions.
+     However, eliminating the above sends the compiler into an infinite
+     loop on valid expressions.  Without this check, the gimplifier emits
+     an ICE for a = a, where a is deferred character length.  */
+  if (!gfc_dep_compare_expr (expr1, expr2))
+    return 0;
+
   current_code = c;
+  inserted_block = NULL;
+  changed_statement = NULL;
   n = create_var (expr2, "trim");
   co->expr2 = n;
   return 0;
@@ -602,6 +616,7 @@ create_var (gfc_expr * e, const char *vname)
   gfc_code *n;
   gfc_namespace *ns;
   int i;
+  bool deferred;
 
   if (e->expr_type == EXPR_CONSTANT || is_fe_temp (e))
     return gfc_copy_expr (e);
@@ -652,18 +667,20 @@ create_var (gfc_expr * e, const char *vname)
 	}
     }
 
+  deferred = 0;
   if (e->ts.type == BT_CHARACTER && e->rank == 0)
     {
       gfc_expr *length;
 
+      symbol->ts.u.cl = gfc_new_charlen (ns, NULL);
       length = constant_string_length (e);
       if (length)
+	symbol->ts.u.cl->length = length;
+      else
 	{
-	  symbol->ts.u.cl = gfc_new_charlen (ns, NULL);
-	  symbol->ts.u.cl->length = length;
+	  symbol->attr.allocatable = 1;
+	  deferred = 1;
 	}
-      else
-	symbol->attr.allocatable = 1;
     }
 
   symbol->attr.flavor = FL_VARIABLE;
@@ -675,6 +692,7 @@ create_var (gfc_expr * e, const char *vname)
   result = gfc_get_expr ();
   result->expr_type = EXPR_VARIABLE;
   result->ts = e->ts;
+  result->ts.deferred = deferred;
   result->rank = e->rank;
   result->shape = gfc_copy_shape (e->shape, e->rank);
   result->symtree = symtree;
@@ -1248,6 +1266,11 @@ combine_array_constructor (gfc_expr *e)
   if (forall_level > 0)
     return false;
 
+  /* Inside an iterator, things can get hairy; we are likely to create
+     an invalid temporary variable.  */
+  if (iterator_level > 0)
+    return false;
+
   op1 = e->value.op.op1;
   op2 = e->value.op.op2;
 
@@ -2812,6 +2835,12 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees,
   if (in_where)
     return 0;
 
+  /* For now don't do anything in OpenMP workshare, it confuses
+     its translation, which expects only the allowed statements in there.
+     We should figure out how to parallelize this eventually.  */
+  if (in_omp_workshare)
+    return 0;
+
   expr1 = co->expr1;
   expr2 = co->expr2;
   if (expr2->expr_type != EXPR_FUNCTION