Fortran: Fix some issues with pointers to character.

gcc/fortran/ChangeLog:

	PR fortran/100120
	PR fortran/100816
	PR fortran/100818
	PR fortran/100819
	PR fortran/100821
	* trans-array.c (gfc_get_array_span): rework the way character
	array "span" was calculated.
	(gfc_conv_expr_descriptor): improve handling of character sections
	and unlimited polymorphic objects.
	* trans-expr.c (gfc_get_character_len): new function to calculate
	character string length.
	(gfc_get_character_len_in_bytes): new function to calculate
	character string length in bytes.
	(gfc_conv_scalar_to_descriptor): add call to set the "span".
	(gfc_trans_pointer_assignment): set "_len" and antecipate the
	initialization of the deferred character length hidden argument.
	* trans-intrinsic.c (gfc_conv_associated): set "force_no_tmp" to
	avoid the creation of a temporary.
	* trans-types.c (gfc_get_dtype_rank_type): rework type detection
	so that unlimited polymorphic objects get proper type infomation,
	also important for bind(c).
	(gfc_get_dtype): add argument to pass the rank if necessary.
	(gfc_get_array_type_bounds): cosmetic change to have character
	arrays called character instead of unknown.
	* trans-types.h (gfc_get_dtype): modify prototype.
	* trans.c (get_array_span): rework the way character array "span"
	was calculated.
	* trans.h (gfc_get_character_len): new prototype.
	(gfc_get_character_len_in_bytes): new prototype.
	Add "unlimited_polymorphic" flag to "gfc_se" type to signal when
	expression carries an unlimited polymorphic object.

libgfortran/ChangeLog:

	PR fortran/100120
	* intrinsics/associated.c (associated): have associated verify if
	the "span" matches insted of the "elem_len".
	* libgfortran.h (GFC_DESCRIPTOR_SPAN): add macro to retrive the
	descriptor "span".

gcc/testsuite/ChangeLog:

	PR fortran/100120
	* gfortran.dg/PR100120.f90: New test.
	PR fortran/100816
	PR fortran/100818
	PR fortran/100819
	PR fortran/100821
	* gfortran.dg/character_workout_1.f90: New test.
	* gfortran.dg/character_workout_4.f90: New test.

1 files changed, 38 insertions, 23 deletions

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 7eeef55..a6bcd2b 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -860,16 +860,25 @@ gfc_get_array_span (tree desc, gfc_expr *expr)
 	 size of the array. Attempt to deal with unbounded character
 	 types if possible. Otherwise, return NULL_TREE.  */
       tmp = gfc_get_element_type (TREE_TYPE (desc));
-      if (tmp && TREE_CODE (tmp) == ARRAY_TYPE
-	  && (TYPE_MAX_VALUE (TYPE_DOMAIN (tmp)) == NULL_TREE
-	      || integer_zerop (TYPE_MAX_VALUE (TYPE_DOMAIN (tmp)))))
-	{
-	  if (expr->expr_type == EXPR_VARIABLE
-	      && expr->ts.type == BT_CHARACTER)
-	    tmp = fold_convert (gfc_array_index_type,
-				gfc_get_expr_charlen (expr));
-	  else
-	    tmp = NULL_TREE;
+      if (tmp && TREE_CODE (tmp) == ARRAY_TYPE && TYPE_STRING_FLAG (tmp))
+	{
+	  gcc_assert (expr->ts.type == BT_CHARACTER);
+	  
+	  tmp = gfc_get_character_len_in_bytes (tmp);
+	  
+	  if (tmp == NULL_TREE || integer_zerop (tmp))
+	    {
+	      tree bs;
+
+	      tmp = gfc_get_expr_charlen (expr);
+	      tmp = fold_convert (gfc_array_index_type, tmp);
+	      bs = build_int_cst (gfc_array_index_type, expr->ts.kind);
+	      tmp = fold_build2_loc (input_location, MULT_EXPR,
+				     gfc_array_index_type, tmp, bs);
+	    }
+	  
+	  tmp = (tmp && !integer_zerop (tmp))
+	    ? (fold_convert (gfc_array_index_type, tmp)) : (NULL_TREE);
 	}
       else
 	tmp = fold_convert (gfc_array_index_type,
@@ -7328,6 +7337,9 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
       expr = expr->value.function.actual->expr;
     }
 
+  if (!se->direct_byref)
+    se->unlimited_polymorphic = UNLIMITED_POLY (expr);
+  
   /* Special case things we know we can pass easily.  */
   switch (expr->expr_type)
     {
@@ -7351,9 +7363,11 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	  && TREE_CODE (desc) == COMPONENT_REF)
 	deferred_array_component = true;
 
-      subref_array_target = se->direct_byref && is_subref_array (expr);
-      need_tmp = gfc_ref_needs_temporary_p (expr->ref)
-			&& !subref_array_target;
+      subref_array_target = (is_subref_array (expr)
+			     && (se->direct_byref
+				 || expr->ts.type == BT_CHARACTER));
+      need_tmp = (gfc_ref_needs_temporary_p (expr->ref)
+		  && !subref_array_target);
 
       if (se->force_tmp)
 	need_tmp = 1;
@@ -7390,9 +7404,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 				      subref_array_target, expr);
 
 	      /* ....and set the span field.  */
-	      tmp = gfc_get_array_span (desc, expr);
-	      if (tmp != NULL_TREE && !integer_zerop (tmp))
-		gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp);
+	      tmp = gfc_conv_descriptor_span_get (desc);
+	      gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp);
 	    }
 	  else if (se->want_pointer)
 	    {
@@ -7607,6 +7620,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
       int dim, ndim, codim;
       tree parm;
       tree parmtype;
+      tree dtype;
       tree stride;
       tree from;
       tree to;
@@ -7689,7 +7703,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
       else
 	{
 	  /* Otherwise make a new one.  */
-	  if (expr->ts.type == BT_CHARACTER && expr->ts.deferred)
+	  if (expr->ts.type == BT_CHARACTER)
 	    parmtype = gfc_typenode_for_spec (&expr->ts);
 	  else
 	    parmtype = gfc_get_element_type (TREE_TYPE (desc));
@@ -7723,11 +7737,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	}
 
       /* Set the span field.  */
-      if (expr->ts.type == BT_CHARACTER && ss_info->string_length)
-	tmp = ss_info->string_length;
-      else
-	tmp = gfc_get_array_span (desc, expr);
-      if (tmp != NULL_TREE)
+      tmp = gfc_get_array_span (desc, expr);
+      if (tmp)
 	gfc_conv_descriptor_span_set (&loop.pre, parm, tmp);
 
       /* The following can be somewhat confusing.  We have two
@@ -7741,7 +7752,11 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 
       /* Set the dtype.  */
       tmp = gfc_conv_descriptor_dtype (parm);
-      gfc_add_modify (&loop.pre, tmp, gfc_get_dtype (parmtype));
+      if (se->unlimited_polymorphic)
+	dtype = gfc_get_dtype (TREE_TYPE (desc), &loop.dimen);
+      else
+	dtype = gfc_get_dtype (parmtype);
+      gfc_add_modify (&loop.pre, tmp, dtype);
 
       /* The 1st element in the section.  */
       base = gfc_index_zero_node;