2007-08-31 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/31879
	PR fortran/31197
	PR fortran/31258
	PR fortran/32703
	* gfortran.h : Add prototype for gfc_resolve_substring_charlen.
	* resolve.c (gfc_resolve_substring_charlen): New function.
	(resolve_ref): Call gfc_resolve_substring_charlen.
	(gfc_resolve_character_operator): New function.
	(gfc_resolve_expr): Call the new functions in cases where the
	character length is missing.
	* iresolve.c (cshift, eoshift, merge, pack, reshape, spread,
	transpose, unpack): Call gfc_resolve_substring_charlen for
	source expressions that are character and have a reference.
	* trans.h (gfc_trans_init_string_length) Change name to
	gfc_conv_string_length; modify references in trans-expr.c,
	trans-array.c and trans-decl.c.
	* trans-expr.c (gfc_trans_string_length): Handle case of no
	backend_decl.
	(gfc_conv_aliased_arg): Remove code for treating substrings
	and replace with call to gfc_trans_string_length.
	* trans-array.c (gfc_conv_expr_descriptor): Remove code for
	treating strings and call gfc_trans_string_length instead.

2007-08-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31879
	* gfortran.dg/char_length_7.f90: New test.
	* gfortran.dg/char_length_9.f90: New test.
	* gfortran.dg/char_assign_1.f90: Add extra warning.

	PR fortran/31197
	PR fortran/31258
	* gfortran.dg/char_length_8.f90: New test.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127939 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 28 insertions, 0 deletions

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 73f5d73bc45..38da76be71a 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -534,6 +534,9 @@ gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
 {
   int n;
 
+  if (array->ts.type == BT_CHARACTER && array->ref)
+    gfc_resolve_substring_charlen (array);
+
   f->ts = array->ts;
   f->rank = array->rank;
   f->shape = gfc_copy_shape (array->shape, array->rank);
@@ -654,6 +657,9 @@ gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
 {
   int n;
 
+  if (array->ts.type == BT_CHARACTER && array->ref)
+    gfc_resolve_substring_charlen (array);
+
   f->ts = array->ts;
   f->rank = array->rank;
   f->shape = gfc_copy_shape (array->shape, array->rank);
@@ -1382,6 +1388,12 @@ gfc_resolve_merge (gfc_expr *f, gfc_expr *tsource,
 		   gfc_expr *fsource ATTRIBUTE_UNUSED,
 		   gfc_expr *mask ATTRIBUTE_UNUSED)
 {
+  if (tsource->ts.type == BT_CHARACTER && tsource->ref)
+    gfc_resolve_substring_charlen (tsource);
+
+  if (fsource->ts.type == BT_CHARACTER && fsource->ref)
+    gfc_resolve_substring_charlen (fsource);
+
   if (tsource->ts.type == BT_CHARACTER)
     check_charlen_present (tsource);
 
@@ -1590,6 +1602,9 @@ void
 gfc_resolve_pack (gfc_expr *f, gfc_expr *array, gfc_expr *mask,
 		  gfc_expr *vector ATTRIBUTE_UNUSED)
 {
+  if (array->ts.type == BT_CHARACTER && array->ref)
+    gfc_resolve_substring_charlen (array);
+
   f->ts = array->ts;
   f->rank = 1;
 
@@ -1693,6 +1708,9 @@ gfc_resolve_reshape (gfc_expr *f, gfc_expr *source, gfc_expr *shape,
   int kind;
   int i;
 
+  if (source->ts.type == BT_CHARACTER && source->ref)
+    gfc_resolve_substring_charlen (source);
+
   f->ts = source->ts;
 
   gfc_array_size (shape, &rank);
@@ -1984,6 +2002,9 @@ void
 gfc_resolve_spread (gfc_expr *f, gfc_expr *source, gfc_expr *dim,
 		    gfc_expr *ncopies)
 {
+  if (source->ts.type == BT_CHARACTER && source->ref)
+    gfc_resolve_substring_charlen (source);
+
   if (source->ts.type == BT_CHARACTER)
     check_charlen_present (source);
 
@@ -2258,6 +2279,10 @@ gfc_resolve_transfer (gfc_expr *f, gfc_expr *source ATTRIBUTE_UNUSED,
 void
 gfc_resolve_transpose (gfc_expr *f, gfc_expr *matrix)
 {
+
+  if (matrix->ts.type == BT_CHARACTER && matrix->ref)
+    gfc_resolve_substring_charlen (matrix);
+
   f->ts = matrix->ts;
   f->rank = 2;
   if (matrix->shape)
@@ -2384,6 +2409,9 @@ void
 gfc_resolve_unpack (gfc_expr *f, gfc_expr *vector, gfc_expr *mask,
 		    gfc_expr *field ATTRIBUTE_UNUSED)
 {
+  if (vector->ts.type == BT_CHARACTER && vector->ref)
+    gfc_resolve_substring_charlen (vector);
+
   f->ts = vector->ts;
   f->rank = mask->rank;
   resolve_mask_arg (mask);