Merge in trunk.

[thirdparty/gcc.git] / gcc / fortran / trans-expr.c

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 6b4500073a08870aeb6c97c71e1be308ad70166b..ba22368b50013d89c9972a2912777dd6a297e7ba 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -69,14 +69,16 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
   type = get_scalar_to_descriptor_type (scalar, attr);
   desc = gfc_create_var (type, "desc");
   DECL_ARTIFICIAL (desc) = 1;
+
+  if (!POINTER_TYPE_P (TREE_TYPE (scalar)))
+    scalar = gfc_build_addr_expr (NULL_TREE, scalar);
   gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc),
                  gfc_get_dtype (type));
   gfc_conv_descriptor_data_set (&se->pre, desc, scalar);
 
   /* Copy pointer address back - but only if it could have changed and
      if the actual argument is a pointer and not, e.g., NULL().  */
-  if ((attr.pointer || attr.allocatable)
-       && attr.intent != INTENT_IN && POINTER_TYPE_P (TREE_TYPE (scalar)))
+  if ((attr.pointer || attr.allocatable) && attr.intent != INTENT_IN)
     gfc_add_modify (&se->post, scalar,
                    fold_convert (TREE_TYPE (scalar),
                                  gfc_conv_descriptor_data_get (desc)));
@@ -424,7 +426,11 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
          gfc_conv_expr_descriptor (parmse, e);
 
          if (e->rank != class_ts.u.derived->components->as->rank)
-           class_array_data_assign (&block, ctree, parmse->expr, true);
+           {
+             gcc_assert (class_ts.u.derived->components->as->type
+                         == AS_ASSUMED_RANK);
+             class_array_data_assign (&block, ctree, parmse->expr, false);
+           }
          else
            {
              if (gfc_expr_attr (e).codimension)
@@ -1689,6 +1695,14 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
       se->string_length = tmp;
     }
 
+  if (gfc_deferred_strlen (c, &field))
+    {
+      tmp = fold_build3_loc (input_location, COMPONENT_REF,
+                            TREE_TYPE (field),
+                            decl, field, NULL_TREE);
+      se->string_length = tmp;
+    }
+
   if (((c->attr.pointer || c->attr.allocatable)
        && (!c->attr.dimension && !c->attr.codimension)
        && c->ts.type != BT_CHARACTER)
@@ -4093,7 +4107,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
              parmse.expr
                = fold_build3_loc (input_location, COND_EXPR,
                                   TREE_TYPE (parmse.expr),
-                                  gfc_unlikely (tmp),
+                                  gfc_unlikely (tmp, PRED_FORTRAN_ABSENT_DUMMY),
                                   fold_convert (TREE_TYPE (parmse.expr),
                                                 null_pointer_node),
                                   parmse.expr);
@@ -6045,9 +6059,42 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
          gfc_add_expr_to_block (&block, tmp);
        }
     }
-  else
+  else if (gfc_deferred_strlen (cm, &tmp))
     {
-      /* Scalar component.  */
+      tree strlen;
+      strlen = tmp;
+      gcc_assert (strlen);
+      strlen = fold_build3_loc (input_location, COMPONENT_REF,
+                               TREE_TYPE (strlen),
+                               TREE_OPERAND (dest, 0),
+                               strlen, NULL_TREE);
+
+      if (expr->expr_type == EXPR_NULL)
+       {
+         tmp = build_int_cst (TREE_TYPE (cm->backend_decl), 0);
+         gfc_add_modify (&block, dest, tmp);
+         tmp = build_int_cst (TREE_TYPE (strlen), 0);
+         gfc_add_modify (&block, strlen, tmp);
+       }
+      else
+       {
+         tree size;
+         gfc_init_se (&se, NULL);
+         gfc_conv_expr (&se, expr);
+         size = size_of_string_in_bytes (cm->ts.kind, se.string_length);
+         tmp = build_call_expr_loc (input_location,
+                                    builtin_decl_explicit (BUILT_IN_MALLOC),
+                                    1, size);
+         gfc_add_modify (&block, dest,
+                         fold_convert (TREE_TYPE (dest), tmp));
+         gfc_add_modify (&block, strlen, se.string_length);
+         tmp = gfc_build_memcpy_call (dest, se.expr, size);
+         gfc_add_expr_to_block (&block, tmp);
+       }
+    }
+  else if (!cm->attr.deferred_parameter)
+    {
+      /* Scalar component (excluding deferred parameters).  */
       gfc_init_se (&se, NULL);
       gfc_init_se (&lse, NULL);
 
@@ -7749,7 +7796,10 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block,
 
       /* Update the lhs character length.  */
       size = string_length;
-      gfc_add_modify (block, expr1->ts.u.cl->backend_decl, size);
+      if (TREE_CODE (expr1->ts.u.cl->backend_decl) == VAR_DECL)
+       gfc_add_modify (block, expr1->ts.u.cl->backend_decl, size);
+      else
+       gfc_add_modify (block, lse.string_length, size);
     }
 }