2011-08-22 Mikael Morin <mikael.morin@gcc.gnu.org>

	PR fortran/50050
	* gfortran.h (gfc_clear_shape, gfc_free_shape): New prototypes.
	* expr.c (gfc_clear_shape, gfc_free_shape): New functions.
	(free_expr0): Re-use gfc_free_shape.
	* trans-expr.c (gfc_trans_subarray_assign): Ditto.
	* trans-io.c (transfer_array_component): Ditto.
	* resolve.c (check_host_association): Ditto.
	(gfc_expr_to_initialize): Don't force the rank value and free the shape
	after updating the expression. Recalculate shape and rank.
	(resolve_where_shape): Re-use gfc_clear_shape.
	* array.c (gfc_array_ref_shape): Ditto.

2011-08-22  Mikael Morin  <mikael.morin@gcc.gnu.org>

	PR fortran/50050
	* gfortran.dg/alloc_comp_initializer_3.f90: New test.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e0ad71c34dfba2fe9994b3c811218159d6724b95..69d901e0c7be97b168a0bb581784917d13cbd7cf 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2011-08-22  Mikael Morin  <mikael.morin@gcc.gnu.org>
+
+       PR fortran/50050
+       * gfortran.h (gfc_clear_shape, gfc_free_shape): New prototypes.
+       * expr.c (gfc_clear_shape, gfc_free_shape): New functions.
+       (free_expr0): Re-use gfc_free_shape.
+       * trans-expr.c (gfc_trans_subarray_assign): Ditto.
+       * trans-io.c (transfer_array_component): Ditto.
+       * resolve.c (check_host_association): Ditto.
+       (gfc_expr_to_initialize): Don't force the rank value and free the shape
+       after updating the expression. Recalculate shape and rank.
+       (resolve_where_shape): Re-use gfc_clear_shape.
+       * array.c (gfc_array_ref_shape): Ditto.
+
 2011-08-21  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR fortran/47659
@@ -18,7 +32,7 @@
        * dependency.c (gfc_dep_compare_expr): Add new result value "-3".
        (gfc_check_element_vs_section,gfc_check_element_vs_element): Handle
        result value "-3".
-        * frontend-passes.c (optimize_comparison): Ditto.
+       * frontend-passes.c (optimize_comparison): Ditto.
        * interface.c (gfc_check_typebound_override): Ditto.
 
 2011-08-19  Mikael Morin  <mikael.morin@sfr.fr>

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 3074275a819a630c230af16737aadcf287ee37fc..aa9cc0c3ab39caee778d5422a97b765225cf7c62 100644 (file)
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -2281,9 +2281,7 @@ gfc_array_ref_shape (gfc_array_ref *ar, mpz_t *shape)
     }
 
 cleanup:
-  for (d--; d >= 0; d--)
-    mpz_clear (shape[d]);
-
+  gfc_clear_shape (shape, d);
   return FAILURE;
 }
 

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 6d94369c54382f2be7b6b7f0cc9bc685425967b1..9922094fd6e26b2c08106215b8658da920b5168a 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -396,6 +396,25 @@ gfc_copy_expr (gfc_expr *p)
 }
 
 
+void
+gfc_clear_shape (mpz_t *shape, int rank)
+{
+  int i;
+
+  for (i = 0; i < rank; i++)
+    mpz_clear (shape[i]);
+}
+
+
+void
+gfc_free_shape (mpz_t **shape, int rank)
+{
+  gfc_clear_shape (*shape, rank);
+  free (*shape);
+  *shape = NULL;
+}
+
+
 /* Workhorse function for gfc_free_expr() that frees everything
    beneath an expression node, but not the node itself.  This is
    useful when we want to simplify a node and replace it with
@@ -404,8 +423,6 @@ gfc_copy_expr (gfc_expr *p)
 static void
 free_expr0 (gfc_expr *e)
 {
-  int n;
-
   switch (e->expr_type)
     {
     case EXPR_CONSTANT:
@@ -474,12 +491,7 @@ free_expr0 (gfc_expr *e)
 
   /* Free a shape array.  */
   if (e->shape != NULL)
-    {
-      for (n = 0; n < e->rank; n++)
-       mpz_clear (e->shape[n]);
-
-      free (e->shape);
-    }
+    gfc_free_shape (&e->shape, e->rank);
 
   gfc_free_ref_list (e->ref);
 

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index ae0a138e7bdaae9db6bea316c15a495784b2a3cd..ac36d249912c1d2e5893298afee3106233c5f002 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2711,6 +2711,8 @@ gfc_expr *gfc_get_int_expr (int, locus *, int);
 gfc_expr *gfc_get_logical_expr (int, locus *, bool);
 gfc_expr *gfc_get_iokind_expr (locus *, io_kind);
 
+void gfc_clear_shape (mpz_t *shape, int rank);
+void gfc_free_shape (mpz_t **shape, int rank);
 void gfc_free_expr (gfc_expr *);
 void gfc_replace_expr (gfc_expr *, gfc_expr *);
 mpz_t *gfc_copy_shape (mpz_t *, int);

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 85d2091dc88f18313c7db430ee645a582e6c2e5c..e3427230c886b64d0fe148a548336129a618f943 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5199,12 +5199,7 @@ check_host_association (gfc_expr *e)
        {
          /* Clear the shape, since it might not be valid.  */
          if (e->shape != NULL)
-           {
-             for (n = 0; n < e->rank; n++)
-               mpz_clear (e->shape[n]);
-
-             free (e->shape);
-           }
+           gfc_free_shape (&e->shape, e->rank);
 
          /* Give the expression the right symtree!  */
          gfc_find_sym_tree (e->symtree->name, NULL, 1, &st);
@@ -6559,10 +6554,13 @@ gfc_expr_to_initialize (gfc_expr *e)
        for (i = 0; i < ref->u.ar.dimen; i++)
          ref->u.ar.start[i] = ref->u.ar.end[i] = ref->u.ar.stride[i] = NULL;
 
-       result->rank = ref->u.ar.dimen;
        break;
       }
 
+  gfc_free_shape (&result->shape, result->rank);
+
+  /* Recalculate rank, shape, etc.  */
+  gfc_resolve_expr (result);
   return result;
 }
 
@@ -8429,11 +8427,8 @@ ignore:
   result = SUCCESS;
 
 over:
-  for (i--; i >= 0; i--)
-    {
-      mpz_clear (shape[i]);
-      mpz_clear (shape2[i]);
-    }
+  gfc_clear_shape (shape, i);
+  gfc_clear_shape (shape2, i);
   return result;
 }
 

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 39ad0b6e9e1112b25561fa1e415f11b0dad3a98c..39a83ce4da3553d870d30e99f045bd4de5fb0aba 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4411,10 +4411,7 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
   gfc_add_block_to_block (&block, &loop.pre);
   gfc_add_block_to_block (&block, &loop.post);
 
-  for (n = 0; n < cm->as->rank; n++)
-    mpz_clear (lss->shape[n]);
-  free (lss->shape);
-
+  gfc_free_shape (&lss->shape, cm->as->rank);
   gfc_cleanup_loop (&loop);
 
   return gfc_finish_block (&block);

diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 4e019a36c514980fc84556c1342256152eab8ace..2ae34d8f25acdeffa2cc93a0a0bc0d4dd3bd04d9 100644 (file)
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -1999,10 +1999,7 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where)
   gfc_add_block_to_block (&block, &loop.pre);
   gfc_add_block_to_block (&block, &loop.post);
 
-  for (n = 0; n < cm->as->rank; n++)
-    mpz_clear (ss->shape[n]);
-  free (ss->shape);
-
+  gfc_free_shape (&ss->shape, cm->as->rank);
   gfc_cleanup_loop (&loop);
 
   return gfc_finish_block (&block);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a375cfb1570342ec15c68e2ae717e094e23beff9..f7df8c1db9d4530ffbecb5110c95a7cc504c3fa6 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-08-22  Mikael Morin  <mikael.morin@gcc.gnu.org>
+
+       PR fortran/50050
+       * gfortran.dg/alloc_comp_initializer_3.f90: New test.
+
 2011-08-22  Georg-Johann Lay  <avr@gjlay.de>
        
        * gcc.dg/pr49994-2.c: Add dg-require-effective-target scheduling.

diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_initializer_3.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_initializer_3.f90
new file mode 100644 (file)
index 0000000..014b069
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_initializer_3.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! PR fortran/50050
+! Out of bound whilst releasing initialization of allocate object
+!
+! Contributed by someone <sigurdkn@gmail.com>
+
+program bug
+  implicit none
+  type foo
+    integer, pointer :: a => null()
+  end type
+  type(foo), dimension(:,:), allocatable :: data
+  allocate(data(1:1,1)) ! This used to lead to an ICE
+end program