Hello,
this is an attempt to fix my recent breakage for PR50050.
I forgot that shape can't always be known, and thus, that for some
expressions, the shape field is a NULL pointer.
This patch adds an early return in gfc_free_shape in the case shape is NULL.
Then some external NULL shape checks are redundant and can be removed.
I added some asserts in the cases there was no check before, so that the code
is strictly equivalent.
Neither bootstraped, nor regression tested, but it is in progress. My machine
does its best (which is not a lot) to have this properly compiled and tested
(and then committed) as soon as possible.
Otherwise OK for 4.{4..7} ?
Mikael
PS: Sorry for the breakage, and thanks to Andrew Benson for the early report
(with a reduced testcase !). I was about to break the 4.5 branch as well
before I saw it.
2011-08-22 Mikael Morin <mikael.mo...@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-22 Mikael Morin <mikael.mo...@gcc.gnu.org>
* gfortran.dg/pointer_comp_init_1.f90: New test.
Index: trans-expr.c
===================================================================
--- trans-expr.c (révision 177956)
+++ trans-expr.c (copie de travail)
@@ -4411,6 +4411,7 @@ gfc_trans_subarray_assign (tree dest, gfc_componen
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);
Index: expr.c
===================================================================
--- expr.c (révision 177956)
+++ expr.c (copie de travail)
@@ -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);
Index: resolve.c
===================================================================
--- resolve.c (révision 177956)
+++ resolve.c (copie de travail)
@@ -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);
Index: trans-io.c
===================================================================
--- trans-io.c (révision 177956)
+++ trans-io.c (copie de travail)
@@ -1999,6 +1999,7 @@ transfer_array_component (tree expr, gfc_component
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);
! { 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 <aben...@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" } }
