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, 56 insertions, 14 deletions

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 00690fe..e3bc886 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -42,6 +42,45 @@ along with GCC; see the file COPYING3.  If not see
 #include "dependency.h"
 #include "gimplify.h"
 
+
+/* Calculate the number of characters in a string.  */
+
+tree
+gfc_get_character_len (tree type)
+{
+  tree len;
+  
+  gcc_assert (type && TREE_CODE (type) == ARRAY_TYPE
+	      && TYPE_STRING_FLAG (type));
+  
+  len = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
+  len = (len) ? (len) : (integer_zero_node);
+  return fold_convert (gfc_charlen_type_node, len);
+}
+
+
+
+/* Calculate the number of bytes in a string.  */
+
+tree
+gfc_get_character_len_in_bytes (tree type)
+{
+  tree tmp, len;
+  
+  gcc_assert (type && TREE_CODE (type) == ARRAY_TYPE
+	      && TYPE_STRING_FLAG (type));
+  
+  tmp = TYPE_SIZE_UNIT (TREE_TYPE (type));
+  tmp = (tmp && !integer_zerop (tmp))
+    ? (fold_convert (gfc_charlen_type_node, tmp)) : (NULL_TREE);
+  len = gfc_get_character_len (type);
+  if (tmp && len && !integer_zerop (len))
+    len = fold_build2_loc (input_location, MULT_EXPR,
+			   gfc_charlen_type_node, len, tmp);
+  return len;
+}
+
+
 /* Convert a scalar to an array descriptor. To be used for assumed-rank
    arrays.  */
 
@@ -87,6 +126,8 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
   gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc),
 		  gfc_get_dtype_rank_type (0, etype));
   gfc_conv_descriptor_data_set (&se->pre, desc, scalar);
+  gfc_conv_descriptor_span_set (&se->pre, desc,
+				gfc_conv_descriptor_elem_len (desc));
 
   /* Copy pointer address back - but only if it could have changed and
      if the actual argument is a pointer and not, e.g., NULL().  */
@@ -9630,11 +9671,12 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 	  lse.direct_byref = 1;
 	  gfc_conv_expr_descriptor (&lse, expr2);
 	  strlen_rhs = lse.string_length;
+	  gfc_init_se (&rse, NULL);
 
 	  if (expr1->ts.type == BT_CLASS)
 	    {
 	      rse.expr = NULL_TREE;
-	      rse.string_length = NULL_TREE;
+	      rse.string_length = strlen_rhs;
 	      trans_class_vptr_len_assignment (&block, expr1, expr2, &rse,
 					       NULL, NULL);
 	    }
@@ -9694,6 +9736,19 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 	  gfc_add_modify (&lse.pre, desc, tmp);
 	}
 
+      if (expr1->ts.type == BT_CHARACTER
+	  && expr1->symtree->n.sym->ts.deferred
+	  && expr1->symtree->n.sym->ts.u.cl->backend_decl
+	  && VAR_P (expr1->symtree->n.sym->ts.u.cl->backend_decl))
+	{
+	  tmp = expr1->symtree->n.sym->ts.u.cl->backend_decl;
+	  if (expr2->expr_type != EXPR_NULL)
+	    gfc_add_modify (&block, tmp,
+			    fold_convert (TREE_TYPE (tmp), strlen_rhs));
+	  else
+	    gfc_add_modify (&block, tmp, build_zero_cst (TREE_TYPE (tmp)));
+	}
+
       gfc_add_block_to_block (&block, &lse.pre);
       if (rank_remap)
 	gfc_add_block_to_block (&block, &rse.pre);
@@ -9856,19 +9911,6 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 				   msg, rsize, lsize);
 	}
 
-      if (expr1->ts.type == BT_CHARACTER
-	  && expr1->symtree->n.sym->ts.deferred
-	  && expr1->symtree->n.sym->ts.u.cl->backend_decl
-	  && VAR_P (expr1->symtree->n.sym->ts.u.cl->backend_decl))
-	{
-	  tmp = expr1->symtree->n.sym->ts.u.cl->backend_decl;
-	  if (expr2->expr_type != EXPR_NULL)
-	    gfc_add_modify (&block, tmp,
-			    fold_convert (TREE_TYPE (tmp), strlen_rhs));
-	  else
-	    gfc_add_modify (&block, tmp, build_zero_cst (TREE_TYPE (tmp)));
-	}
-
       /* Check string lengths if applicable.  The check is only really added
 	 to the output code if -fbounds-check is enabled.  */
       if (expr1->ts.type == BT_CHARACTER && expr2->expr_type != EXPR_NULL)