re PR fortran/17144 (Not Implemented: Character string array constructors /…

re PR fortran/17144 (Not Implemented: Character string array constructors / Assignment to char array)

	PR fortran/17144
	* trans-array.c (gfc_trans_allocate_temp_array): Remove
	string_length argument.
	(gfc_trans_array_ctor_element): New function.
	(gfc_trans_array_constructor_subarray): Use it.
	(gfc_trans_array_constructor_value): Ditto.  Handle constant
	character arrays.
	(get_array_ctor_var_strlen, get_array_ctor_strlen): New functions.
	(gfc_trans_array_constructor): Use them.
	(gfc_add_loop_ss_code): Update to new gfc_ss layout.
	(gfc_conv_ss_descriptor): Remember section string length.
	(gfc_conv_scalarized_array_ref): Ditto.  Remove dead code.
	(gfc_conv_resolve_dependencies): Update to new gfc_ss layout.
	(gfc_conv_expr_descriptor): Ditto.
	(gfc_conv_loop_setup): Ditto.  Spelling fixes.
	* trans-array.h (gfc_trans_allocate_temp_array): Update prototype.
	* trans-const.c (gfc_conv_constant):  Update to new gfc_ss layout.
	* trans-expr.c (gfc_conv_component_ref): Turn error into ICE.
	(gfc_conv_variable): Set string_length from section.
	(gfc_conv_function_call): Remove extra argument.
	(gfc_conv_expr, gfc_conv_expr_reference): Update to new gfc_ss layout.
	* trans-types.c (gfc_get_character_type_len): New function.
	(gfc_get_character_type): Use it.
	(gfc_get_dtype): Return zero for internal types.
	* trans-types.h (gfc_get_character_type_len): Add prototype.
	* trans.h (struct gfc_ss): Move string_length out of union.
testsuite/
	* gfortran.dg/string_ctor_1.f90: New test.

From-SVN: r86558

gcc/fortran/ChangeLog

+2004-08-25  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/17144
+	* trans-array.c (gfc_trans_allocate_temp_array): Remove
+	string_length argument.
+	(gfc_trans_array_ctor_element): New function.
+	(gfc_trans_array_constructor_subarray): Use it.
+	(gfc_trans_array_constructor_value): Ditto.  Handle constant
+	character arrays.
+	(get_array_ctor_var_strlen, get_array_ctor_strlen): New functions.
+	(gfc_trans_array_constructor): Use them.
+	(gfc_add_loop_ss_code): Update to new gfc_ss layout.
+	(gfc_conv_ss_descriptor): Remember section string length.
+	(gfc_conv_scalarized_array_ref): Ditto.  Remove dead code.
+	(gfc_conv_resolve_dependencies): Update to new gfc_ss layout.
+	(gfc_conv_expr_descriptor): Ditto.
+	(gfc_conv_loop_setup): Ditto.  Spelling fixes.
+	* trans-array.h (gfc_trans_allocate_temp_array): Update prototype.
+	* trans-const.c (gfc_conv_constant):  Update to new gfc_ss layout.
+	* trans-expr.c (gfc_conv_component_ref): Turn error into ICE.
+	(gfc_conv_variable): Set string_length from section.
+	(gfc_conv_function_call): Remove extra argument.
+	(gfc_conv_expr, gfc_conv_expr_reference): Update to new gfc_ss layout.
+	* trans-types.c (gfc_get_character_type_len): New function.
+	(gfc_get_character_type): Use it.
+	(gfc_get_dtype): Return zero for internal types.
+	* trans-types.h (gfc_get_character_type_len): Add prototype.
+	* trans.h (struct gfc_ss): Move string_length out of union.
+
 2004-08-25  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
 
 	* trans.h (build2_v, build3_v): New macros.

gcc/fortran/trans-array.h

@@ -27,8 +27,7 @@ tree gfc_array_deallocate (tree);
 void gfc_array_allocate (gfc_se *, gfc_ref *, tree);
 
 /* Generate code to allocate a temporary array.  */
-tree gfc_trans_allocate_temp_array (gfc_loopinfo *, gfc_ss_info *, tree,
-				    tree);
+tree gfc_trans_allocate_temp_array (gfc_loopinfo *, gfc_ss_info *, tree);
 
 /* Generate function entry code for allocation of compiler allocated array
    variables.  */

gcc/fortran/trans-const.c

@@ -353,7 +353,7 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr)
       assert (se->ss->expr == expr);
 
       se->expr = se->ss->data.scalar.expr;
-      se->string_length = se->ss->data.scalar.string_length;
+      se->string_length = se->ss->string_length;
       gfc_advance_se_ss_chain (se);
       return;
     }

gcc/fortran/trans-expr.c

@@ -231,9 +231,8 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
   if (c->ts.type == BT_CHARACTER)
     {
       tmp = c->ts.cl->backend_decl;
-      assert (tmp);
-      if (!INTEGER_CST_P (tmp))
-	gfc_todo_error ("Unknown length character component");
+      /* Components must always be constant length.  */
+      assert (tmp && INTEGER_CST_P (tmp));
       se->string_length = tmp;
     }
 
@@ -260,6 +259,7 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 
       /* A scalarized term.  We already know the descriptor.  */
       se->expr = se->ss->data.info.descriptor;
+      se->string_length = se->ss->string_length;
       ref = se->ss->data.info.ref;
     }
   else
@@ -1040,7 +1040,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 	  tmp = gfc_typenode_for_spec (&sym->ts);
 	  info->dimen = se->loop->dimen;
 	  /* Allocate a temporary to store the result.  */
-	  gfc_trans_allocate_temp_array (se->loop, info, tmp, NULL_TREE);
+	  gfc_trans_allocate_temp_array (se->loop, info, tmp);
 
 	  /* Zero the first stride to indicate a temporary.  */
 	  tmp =
@@ -1711,7 +1711,7 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr)
       /* Substitute a scalar expression evaluated outside the scalarization
          loop.  */
       se->expr = se->ss->data.scalar.expr;
-      se->string_length = se->ss->data.scalar.string_length;
+      se->string_length = se->ss->string_length;
       gfc_advance_se_ss_chain (se);
       return;
     }
@@ -1799,7 +1799,7 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
       && se->ss->type == GFC_SS_REFERENCE)
     {
       se->expr = se->ss->data.scalar.expr;
-      se->string_length = se->ss->data.scalar.string_length;
+      se->string_length = se->ss->string_length;
       gfc_advance_se_ss_chain (se);
       return;
     }

gcc/fortran/trans-types.c

@@ -267,15 +267,14 @@ gfc_get_logical_type (int kind)
     }
 }
 
-/* Get a type node for a character kind.  */
+/* Create a character type with the given kind and length.  */
 
 tree
-gfc_get_character_type (int kind, gfc_charlen * cl)
+gfc_get_character_type_len (int kind, tree len)
 {
   tree base;
-  tree type;
-  tree len;
   tree bounds;
+  tree type;
 
   switch (kind)
     {
@@ -287,14 +286,25 @@ gfc_get_character_type (int kind, gfc_charlen * cl)
       fatal_error ("character kind=%d not available", kind);
     }
 
-  len = (cl == 0) ? NULL_TREE : cl->backend_decl;
-
   bounds = build_range_type (gfc_array_index_type, gfc_index_one_node, len);
   type = build_array_type (base, bounds);
   TYPE_STRING_FLAG (type) = 1;
 
   return type;
 }
+
+
+/* Get a type node for a character kind.  */
+
+tree
+gfc_get_character_type (int kind, gfc_charlen * cl)
+{
+  tree len;
+
+  len = (cl == NULL) ? NULL_TREE : cl->backend_decl;
+
+  return gfc_get_character_type_len (kind, len);
+}
 
 /* Covert a basic type.  This will be an array for character types.  */
 
@@ -480,6 +490,9 @@ gfc_is_nodesc_array (gfc_symbol * sym)
   return 1;
 }
 
+
+/* Create an array descriptor type.  */
+
 static tree
 gfc_build_array_type (tree type, gfc_array_spec * as)
 {
@@ -584,7 +597,9 @@ gfc_get_dtype (tree type, int rank)
       break;
 
     default:
-      abort ();
+      /* TODO: Don't do dtype for temporary descriptorless arrays.  */
+      /* We can strange array types for temporary arrays.  */
+      return gfc_index_zero_node;
     }
 
   assert (rank <= GFC_DTYPE_RANK_MASK);

gcc/fortran/trans-types.h

@@ -112,6 +112,7 @@ tree gfc_get_real_type (int);
 tree gfc_get_complex_type (int);
 tree gfc_get_logical_type (int);
 tree gfc_get_character_type (int, gfc_charlen *);
+tree gfc_get_character_type_len (int, tree);
 
 tree gfc_sym_type (gfc_symbol *);
 tree gfc_typenode_for_spec (gfc_typespec *);

gcc/fortran/trans.h

@@ -162,13 +162,13 @@ typedef struct gfc_ss
   gfc_ss_type type;
   gfc_expr *expr;
   mpz_t *shape;
+  tree string_length;
   union
   {
     /* If type is GFC_SS_SCALAR or GFC_SS_REFERENCE.  */
     struct
     {
       tree expr;
-      tree string_length;
     }
     scalar;
 
@@ -179,7 +179,6 @@ typedef struct gfc_ss
          assigned expression.  */
       int dimen;
       tree type;
-      tree string_length;
     }
     temp;
     /* All other types.  */

gcc/testsuite/ChangeLog

+2004-08-25  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/17144
+	* gfortran.dg/string_ctor_1.f90: New test.
+
 2004-08-25  Kriang Lerdsuwanakij  <lerdsuwa@users.sourceforge.net>
 
 	PR c++/14428

gcc/testsuite/gfortran.dg/string_ctor_1.f90

+! { dg-do run }
+! Program to test character array constructors.
+! PR17144
+subroutine test1 (n, t, u)
+  integer n
+  character(len=n) :: s(2)
+  character(len=*) :: t
+  character(len=*) :: u
+
+  ! A variable array constructor.
+  s = (/t, u/)
+  ! An array constructor as part of an expression.
+  if (any (s .ne. (/"Hell", "Worl"/))) call abort
+end subroutine
+
+subroutine test2
+  character*5 :: s(2)
+
+  ! A constant array constructor
+  s = (/"Hello", "World"/)
+  if ((s(1) .ne. "Hello") .or. (s(2) .ne. "World")) call abort
+end subroutine
+
+subroutine test3
+  character*1 s(26)
+  character*26 t
+  integer i
+
+  ! A large array constructor
+  s = (/'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', &
+        'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z'/)
+  do i=1, 26
+    t(i:i) = s(i)
+  end do
+
+  ! Assignment with dependency
+  s = (/(s(27-i), i=1, 26)/)
+  do i=1, 26
+    t(i:i) = s(i)
+  end do
+  if (t .ne. "zyxwvutsrqponmlkjihgfedcba") call abort
+end subroutine
+
+program string_ctor_1
+  call test1 (4, "Hello", "World")
+  call test2
+  call test3
+end program
+