Commit d54e80ce by Mikael Morin

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
parent 42aa5124
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> 2011-08-25 Tobias Burnus <burnus@net-b.de>
* trans-array.c (gfc_conv_descriptor_token): Add assert. * trans-array.c (gfc_conv_descriptor_token): Add assert.
......
...@@ -409,6 +409,9 @@ gfc_clear_shape (mpz_t *shape, int rank) ...@@ -409,6 +409,9 @@ gfc_clear_shape (mpz_t *shape, int rank)
void void
gfc_free_shape (mpz_t **shape, int rank) gfc_free_shape (mpz_t **shape, int rank)
{ {
if (*shape == NULL)
return;
gfc_clear_shape (*shape, rank); gfc_clear_shape (*shape, rank);
free (*shape); free (*shape);
*shape = NULL; *shape = NULL;
...@@ -490,8 +493,7 @@ free_expr0 (gfc_expr *e) ...@@ -490,8 +493,7 @@ free_expr0 (gfc_expr *e)
} }
/* Free a shape array. */ /* 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); gfc_free_ref_list (e->ref);
......
...@@ -5198,8 +5198,7 @@ check_host_association (gfc_expr *e) ...@@ -5198,8 +5198,7 @@ check_host_association (gfc_expr *e)
&& sym->attr.contained) && sym->attr.contained)
{ {
/* Clear the shape, since it might not be valid. */ /* 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! */ /* Give the expression the right symtree! */
gfc_find_sym_tree (e->symtree->name, NULL, 1, &st); gfc_find_sym_tree (e->symtree->name, NULL, 1, &st);
......
...@@ -4428,6 +4428,7 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr) ...@@ -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.pre);
gfc_add_block_to_block (&block, &loop.post); gfc_add_block_to_block (&block, &loop.post);
gcc_assert (lss->shape != NULL);
gfc_free_shape (&lss->shape, cm->as->rank); gfc_free_shape (&lss->shape, cm->as->rank);
gfc_cleanup_loop (&loop); gfc_cleanup_loop (&loop);
......
...@@ -1999,6 +1999,7 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where) ...@@ -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.pre);
gfc_add_block_to_block (&block, &loop.post); gfc_add_block_to_block (&block, &loop.post);
gcc_assert (ss->shape != NULL);
gfc_free_shape (&ss->shape, cm->as->rank); gfc_free_shape (&ss->shape, cm->as->rank);
gfc_cleanup_loop (&loop); gfc_cleanup_loop (&loop);
......
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> 2011-08-25 Jason Merrill <jason@redhat.com>
PR c++/50157 PR c++/50157
......
! { 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" } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment