re PR fortran/50050 (Internal compiler error free_expr0 at expr.c:3709 via gfc_done_2)

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

	PR fortran/50050
	* expr.c (gfc_free_shape): Do nothing if shape is NULL.
	(free_expr0): Remove redundant NULL shape check.
	* resolve.c (check_host_association): Ditto.
	* trans-expr.c (gfc_trans_subarray_assign): Assert that shape is
	non-NULL.
	* trans-io.c (transfer_array_component): Ditto.

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

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

From-SVN: r178086

7 files changed, 52 insertions, 4 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5cab38d..be796ba 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2011-08-25  Mikael Morin  <mikael.morin@gcc.gnu.org>
+
+	PR fortran/50050
+	* expr.c (gfc_free_shape): Do nothing if shape is NULL.
+	(free_expr0): Remove redundant NULL shape check.
+	* resolve.c (check_host_association): Ditto.
+	* trans-expr.c (gfc_trans_subarray_assign): Assert that shape is
+	non-NULL.
+	* trans-io.c (transfer_array_component): Ditto.
+
 2011-08-25  Tobias Burnus  <burnus@net-b.de>
 
 	* trans-array.c (gfc_conv_descriptor_token): Add assert.
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index b050b11..3c09a2a 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -409,6 +409,9 @@ gfc_clear_shape (mpz_t *shape, int rank)
 void
 gfc_free_shape (mpz_t **shape, int rank)
 {
+  if (*shape == NULL)
+    return;
+
   gfc_clear_shape (*shape, rank);
   free (*shape);
   *shape = NULL;
@@ -490,8 +493,7 @@ free_expr0 (gfc_expr *e)
     }
 
   /* Free a shape array.  */
-  if (e->shape != NULL)
-    gfc_free_shape (&e->shape, e->rank);
+  gfc_free_shape (&e->shape, e->rank);
 
   gfc_free_ref_list (e->ref);
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e342723..436c160 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5198,8 +5198,7 @@ check_host_association (gfc_expr *e)
 	      && sym->attr.contained)
 	{
 	  /* Clear the shape, since it might not be valid.  */
-	  if (e->shape != NULL)
-	    gfc_free_shape (&e->shape, e->rank);
+	  gfc_free_shape (&e->shape, e->rank);
 
 	  /* Give the expression the right symtree!  */
 	  gfc_find_sym_tree (e->symtree->name, NULL, 1, &st);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 628930a..ea65c02 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4428,6 +4428,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);
 
+  gcc_assert (lss->shape != NULL);
   gfc_free_shape (&lss->shape, cm->as->rank);
   gfc_cleanup_loop (&loop);
 
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 2ae34d8..931565d 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -1999,6 +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);
 
+  gcc_assert (ss->shape != NULL);
   gfc_free_shape (&ss->shape, cm->as->rank);
   gfc_cleanup_loop (&loop);
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c646612..417f0f1 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-08-25  Mikael Morin  <mikael.morin@gcc.gnu.org>
+
+	PR fortran/50050
+	* gfortran.dg/pointer_comp_init_1.f90: New test.
+
 2011-08-25  Jason Merrill  <jason@redhat.com>
 
 	PR c++/50157
diff --git a/gcc/testsuite/gfortran.dg/pointer_comp_init_1.f90 b/gcc/testsuite/gfortran.dg/pointer_comp_init_1.f90
new file mode 100644
index 0000000..44f360e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_comp_init_1.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+!
+! PR fortran/50050
+! ICE whilst trying to access NULL shape.
+
+! Reduced from the FoX library http://www1.gly.bris.ac.uk/~walker/FoX/
+! Contributed by Andrew Benson <abenson@its.caltech.edu>
+
+module m_common_attrs
+  implicit none
+
+  type dict_item
+  end type dict_item
+
+  type dict_item_ptr
+     type(dict_item), pointer :: d => null()
+  end type dict_item_ptr
+
+contains
+
+  subroutine add_item_to_dict()
+    type(dict_item_ptr), pointer :: tempList(:)
+    integer :: n
+
+    allocate(tempList(0:n+1)) 
+  end subroutine add_item_to_dict
+
+end module m_common_attrs
+
+! { dg-final { cleanup-modules "m_common_attrs" } }