re PR fortran/55901 ([OOP] type is (character(len=*)) misinterpreted as array)

2015-03-24  Andre Vehreschild  <vehre@gmx.de>

	PR fortran/55901
	* trans-expr.c (gfc_conv_structure): Fixed indendation.
	Using integer_zero_node now instead of explicitly
	constructing a integer constant zero node.
	(gfc_conv_derived_to_class): Add handling of _len component,
	i.e., when the rhs has a string_length then assign that to
	class' _len, else assign 0.
	(gfc_conv_intrinsic_to_class): Likewise.

From-SVN: r221627

gcc/fortran/ChangeLog

 2015-03-24  Andre Vehreschild  <vehre@gmx.de>
 
+	PR fortran/55901
+	* trans-expr.c (gfc_conv_structure): Fixed indendation.
+	Using integer_zero_node now instead of explicitly
+	constructing a integer constant zero node.
+	(gfc_conv_derived_to_class): Add handling of _len component,
+	i.e., when the rhs has a string_length then assign that to
+	class' _len, else assign 0.
+	(gfc_conv_intrinsic_to_class): Likewise.
+
+2015-03-24  Andre Vehreschild  <vehre@gmx.de>
+
 	PR fortran/64787
 	PR fortran/57456
 	PR fortran/63230

gcc/fortran/trans-expr.c

@@ -569,6 +569,34 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
 	}
     }
 
+  if (class_ts.u.derived->components->ts.type == BT_DERIVED
+      && class_ts.u.derived->components->ts.u.derived
+		 ->attr.unlimited_polymorphic)
+    {
+      /* Take care about initializing the _len component correctly.  */
+      ctree = gfc_class_len_get (var);
+      if (UNLIMITED_POLY (e))
+	{
+	  gfc_expr *len;
+	  gfc_se se;
+
+	  len = gfc_copy_expr (e);
+	  gfc_add_len_component (len);
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr (&se, len);
+	  if (optional)
+	    tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (se.expr),
+			      cond_optional, se.expr,
+			      fold_convert (TREE_TYPE (se.expr),
+					    integer_zero_node));
+	  else
+	    tmp = se.expr;
+	}
+      else
+	tmp = integer_zero_node;
+      gfc_add_modify (&parmse->pre, ctree, fold_convert (TREE_TYPE (ctree),
+							  tmp));
+    }
   /* Pass the address of the class object.  */
   parmse->expr = gfc_build_addr_expr (NULL_TREE, var);
 
@@ -727,19 +755,24 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e,
 	}
     }
 
+  gcc_assert (class_ts.type == BT_CLASS);
+  if (class_ts.u.derived->components->ts.type == BT_DERIVED
+      && class_ts.u.derived->components->ts.u.derived
+		 ->attr.unlimited_polymorphic)
+    {
+      ctree = gfc_class_len_get (var);
       /* When the actual arg is a char array, then set the _len component of the
        unlimited polymorphic entity, too.  */
       if (e->ts.type == BT_CHARACTER)
 	{
-      ctree = gfc_class_len_get (var);
 	  /* Start with parmse->string_length because this seems to be set to a
 	   correct value more often.  */
 	  if (parmse->string_length)
-	  gfc_add_modify (&parmse->pre, ctree, parmse->string_length);
+	    tmp = parmse->string_length;
 	  /* When the string_length is not yet set, then try the backend_decl of
 	   the cl.  */
 	  else if (e->ts.u.cl->backend_decl)
-          gfc_add_modify (&parmse->pre, ctree, e->ts.u.cl->backend_decl);
+	    tmp = e->ts.u.cl->backend_decl;
 	  /* If both of the above approaches fail, then try to generate an
 	   expression from the input, which is only feasible currently, when the
 	   expression can be evaluated to a constant one.  */
@@ -757,7 +790,7 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e,
 			      e->value.character.length);
 		  gfc_conv_const_charlen (e->ts.u.cl);
 		  e->ts.u.cl->resolved = 1;
-	      gfc_add_modify (&parmse->pre, ctree, e->ts.u.cl->backend_decl);
+		  tmp = e->ts.u.cl->backend_decl;
 		}
 	      else
 		{
@@ -766,6 +799,11 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e,
 		}
 	    }
 	}
+      else
+	tmp = integer_zero_node;
+
+      gfc_add_modify (&parmse->pre, ctree, tmp);
+    }
   /* Pass the address of the class object.  */
   parmse->expr = gfc_build_addr_expr (NULL_TREE, var);
 }
@@ -7060,13 +7098,9 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init)
 						val));
 	}
       else if (cm->ts.type == BT_INTEGER && strcmp (cm->name, "_len") == 0)
-        {
-          gfc_expr *e = gfc_get_int_expr (gfc_default_integer_kind, NULL, 0);
-          val = gfc_conv_constant_to_tree (e);
 	CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl,
 				fold_convert (TREE_TYPE (cm->backend_decl),
-                                                val));
-        }
+					      integer_zero_node));
       else
 	{
 	  val = gfc_conv_initializer (c->expr, &cm->ts,