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.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 290005f..4a02e5c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,18 @@
+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

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index e9b7651..584bb19 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/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)
     {

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index e1e463f..f9c92b2 100644 (file)
--- a/gcc/fortran/dump-parse-tree.c
+++ b/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.  */

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 1242e5e..255acb6 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/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;

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 1045338..f1fe872 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/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 *);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index cbf82bf..c56d1ef 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,4 +1,13 @@
-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

diff --git a/gcc/testsuite/gfortran.dg/char_component_initializer_1.f90 b/gcc/testsuite/gfortran.dg/char_component_initializer_1.f90
new file mode 100644 (file)
index 0000000..8642ddf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_component_initializer_1.f90
@@ -0,0 +1,18 @@
+! { 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

diff --git a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_6.f90 b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_6.f90
new file mode 100644 (file)
index 0000000..b8a2a81
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_6.f90
@@ -0,0 +1,27 @@
+! { 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" } }

diff --git a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_7.f90 b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_7.f90
new file mode 100644 (file)
index 0000000..8900565
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_7.f90
@@ -0,0 +1,25 @@
+! { 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