[Patch, fortran] Fix PR fortran/50050 breakage: ICE on valid with null pointer initialization

[Mikael Morin <mikael dot morin at sfr dot fr>]

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.

Attachment: pr50050_3.CL
Description: Text document

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 <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" } }