re PR fortran/32129 (ICE: Procedure call with array-section-actual to scalar dummy)

2007-12-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/32129
	* dump-parse-tree.c (gfc_show_expr_n): New function for
	debugging.
	* gfortran.h : Add prototype for gfc_show_expr_n.
	* expr.c (simplify_constructor): Copy the constructor
	expression and try to simplify that.  If success, replace the
	original.  Otherwise discard the copy, keep going through
	the structure and return success.

	PR fortran/31487
	* decl.c (build_struct): Pad out default initializers with
	spaces to the component character length.

2007-12-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/32129
	* gfortran.dg/derived_comp_array_ref_6.f90: New test.
	* gfortran.dg/derived_comp_array_ref_7.f90: New test.

	PR fortran/31487
	* gfortran.dg/char_component_initializer_1.f90: New test.

From-SVN: r130719

gcc/fortran/ChangeLog

+2007-12-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32129
+	* dump-parse-tree.c (gfc_show_expr_n): New function for
+	debugging.
+	* gfortran.h : Add prototype for gfc_show_expr_n.
+	* expr.c (simplify_constructor): Copy the constructor
+	expression and try to simplify that.  If success, replace the
+	original.  Otherwise discard the copy, keep going through
+	the structure and return success.
+
+	PR fortran/31487
+	* decl.c (build_struct): Pad out default initializers with
+	spaces to the component character length.
+
 2007-12-08  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/34342

gcc/fortran/decl.c

@@ -1394,6 +1394,24 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
     c->dimension = 1;
   *as = NULL;
 
+  /* Should this ever get more complicated, combine with similar section
+     in add_init_expr_to_sym into a separate function.  */
+  if (c->ts.type == BT_CHARACTER && !c->pointer && c->initializer)
+    {
+      int len = mpz_get_si (c->ts.cl->length->value.integer);
+
+      if (c->initializer->expr_type == EXPR_CONSTANT)
+	gfc_set_constant_character_len (len, c->initializer, false);
+      else if (mpz_cmp (c->ts.cl->length->value.integer,
+			c->initializer->ts.cl->length->value.integer))
+	{
+	  gfc_constructor *ctor = c->initializer->value.constructor;
+	  for (;ctor ; ctor = ctor->next)
+	    if (ctor->expr->expr_type == EXPR_CONSTANT)
+	      gfc_set_constant_character_len (len, ctor->expr, true);
+	}
+    }
+
   /* Check array components.  */
   if (!c->dimension)
     {

gcc/fortran/dump-parse-tree.c

@@ -540,6 +540,15 @@ gfc_show_expr (gfc_expr *p)
     }
 }
 
+/* Show an expression for diagnostic purposes. */
+void
+gfc_show_expr_n (const char * msg, gfc_expr *e)
+{
+  if (msg)
+    gfc_status (msg);
+  gfc_show_expr (e);
+  gfc_status_char ('\n');
+}
 
 /* Show symbol attributes.  The flavor and intent are followed by
    whatever single bit attributes are present.  */

gcc/fortran/expr.c

@@ -963,6 +963,8 @@ simplify_intrinsic_op (gfc_expr *p, int type)
 static try
 simplify_constructor (gfc_constructor *c, int type)
 {
+  gfc_expr *p;
+
   for (; c; c = c->next)
     {
       if (c->iterator
@@ -971,8 +973,21 @@ simplify_constructor (gfc_constructor *c, int type)
 	      || gfc_simplify_expr (c->iterator->step, type) == FAILURE))
 	return FAILURE;
 
-      if (c->expr && gfc_simplify_expr (c->expr, type) == FAILURE)
-	return FAILURE;
+      if (c->expr)
+	{
+	  /* Try and simplify a copy.  Replace the original if successful
+	     but keep going through the constructor at all costs.  Not
+	     doing so can make a dog's dinner of complicated things.  */
+	  p = gfc_copy_expr (c->expr);
+
+	  if (gfc_simplify_expr (p, type) == FAILURE)
+	    {
+	      gfc_free_expr (p);
+	      continue;
+	    }
+
+	  gfc_replace_expr (c->expr, p);
+	}
     }
 
   return SUCCESS;

gcc/fortran/gfortran.h

@@ -2359,6 +2359,7 @@ void gfc_show_components (gfc_symbol *);
 void gfc_show_constructor (gfc_constructor *);
 void gfc_show_equiv (gfc_equiv *);
 void gfc_show_expr (gfc_expr *);
+void gfc_show_expr_n (const char *, gfc_expr *);
 void gfc_show_namelist (gfc_namelist *);
 void gfc_show_namespace (gfc_namespace *);
 void gfc_show_ref (gfc_ref *);

gcc/testsuite/ChangeLog

-2007-12-06  Tobias Burnus  <burnus@net-b.de>
+2007-12-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32129
+	* gfortran.dg/derived_comp_array_ref_6.f90: New test.
+	* gfortran.dg/derived_comp_array_ref_7.f90: New test.
+
+	PR fortran/31487
+	* gfortran.dg/char_component_initializer_1.f90: New test.
+
+2007-12-09  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/34342
 	PR fortran/34345

gcc/testsuite/gfortran.dg/char_component_initializer_1.f90

+! { dg-do run }
+! Check the fix for PR31487 in which the derived type default initializer
+! would be padded out with nulls instead of spaces.
+!
+! Reported by Harald Anlauf <anlauf@gmx.de>
+!
+program gfcbug62
+  implicit none
+  character(len=16) ::    tdefi(2) = (/'0z1jan0000','1hr       '/)
+  type t_ctl
+     character(len=16) :: tdefi(2) = (/'0z1jan0000','1hr       '/)
+  end type t_ctl
+
+  type(t_ctl) :: ctl
+  integer     :: i,k
+
+  if (tdefi(1) .ne. ctl%tdefi(1)) call abort ()
+end program gfcbug62

gcc/testsuite/gfortran.dg/derived_comp_array_ref_6.f90

+! { dg-do compile }
+! Check the fix for PR32129 in which the argument 'vec(vy(i, :))' was
+! incorrectly simplified, resulting in an ICE and a missed error.
+!
+! Reported by Tobias Burnus <burnus@gcc.gnu.org>
+!
+    MODULE cdf_aux_mod
+      TYPE :: the_distribution
+        INTEGER :: parameters(1)
+      END TYPE the_distribution
+      TYPE (the_distribution), PARAMETER :: the_beta = the_distribution((/0/))
+    CONTAINS
+      SUBROUTINE set_bound(arg_name)
+        INTEGER, INTENT (IN) :: arg_name
+      END SUBROUTINE set_bound
+    END MODULE cdf_aux_mod
+    MODULE cdf_beta_mod
+    CONTAINS
+      SUBROUTINE cdf_beta()
+        USE cdf_aux_mod
+        INTEGER :: which
+          which = 1
+          CALL set_bound(the_beta%parameters(1:which)) ! { dg-error "Type/rank mismatch" }
+      END SUBROUTINE cdf_beta
+    END MODULE cdf_beta_mod
+
+! { dg-final { cleanup-modules "cdf_aux_mod" } }

gcc/testsuite/gfortran.dg/derived_comp_array_ref_7.f90

+! { dg-do run }
+! Check the fix for PR32129 #4 in which the argument 'vec(vy(i, :))' was
+! incorrectly simplified, resulting in an ICE.
+!
+! Reported by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+program testCode
+  implicit none
+  type vec
+    real, dimension(2) :: coords
+  end type
+  integer :: i
+  real, dimension(2,2), parameter :: vy = reshape ((/1,2,3,4/),(/2,2/))
+  i = 1
+  if (any (foo(vec(vy(i, :))) /= vy(i, :))) call abort ()
+
+contains
+
+  function foo (xin)
+    type(vec) :: xin
+    real, dimension (2) :: foo
+    intent(in)  xin
+    foo = xin%coords
+  end function
+end program