[Patch, fortran] PR43895 - [OOP] internal compiler error: verify_ssa failed

[Paul Richard Thomas <paul dot richard dot thomas at gmail dot com>]

This one is pretty 'obvious' but I'll await an OK before applying it.

Bootstrapped and regtested on x86_64/FC9 - OK for trunk and 4.5?

Paul

2010-06-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/43895
	* trans-array.c (structure_alloc_comps): Dereference scalar
	'decl' if it is a REFERENCE_TYPE. Tidy expressions containing
	TREE_TYPE (decl).

2010-06-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/43895
	* gfortran.dg/alloc_comp_class_1 : New test.

Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 160311)
--- gcc/fortran/trans-array.c	(working copy)
*************** structure_alloc_comps (gfc_symbol * der_
*** 5938,5943 ****
--- 5938,5944 ----
    gfc_loopinfo loop;
    stmtblock_t fnblock;
    stmtblock_t loopbody;
+   tree decl_type;
    tree tmp;
    tree comp;
    tree dcmp;
*************** structure_alloc_comps (gfc_symbol * der_
*** 5951,5971 ****
  
    gfc_init_block (&fnblock);
  
!   if (POINTER_TYPE_P (TREE_TYPE (decl)) && rank != 0)
      decl = build_fold_indirect_ref_loc (input_location,
  				    decl);
  
    /* If this an array of derived types with allocatable components
       build a loop and recursively call this function.  */
!   if (TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE
! 	|| GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
      {
        tmp = gfc_conv_array_data (decl);
        var = build_fold_indirect_ref_loc (input_location,
  				     tmp);
  	
        /* Get the number of elements - 1 and set the counter.  */
!       if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
  	{
  	  /* Use the descriptor for an allocatable array.  Since this
  	     is a full array reference, we only need the descriptor
--- 5952,5979 ----
  
    gfc_init_block (&fnblock);
  
!   decl_type = TREE_TYPE (decl);
! 
!   if ((POINTER_TYPE_P (decl_type) && rank != 0)
! 	|| (TREE_CODE (decl_type) == REFERENCE_TYPE && rank == 0))
! 
      decl = build_fold_indirect_ref_loc (input_location,
  				    decl);
  
+   /* Just in case in gets dereferenced.  */
+   decl_type = TREE_TYPE (decl);
+ 
    /* If this an array of derived types with allocatable components
       build a loop and recursively call this function.  */
!   if (TREE_CODE (decl_type) == ARRAY_TYPE
! 	|| GFC_DESCRIPTOR_TYPE_P (decl_type))
      {
        tmp = gfc_conv_array_data (decl);
        var = build_fold_indirect_ref_loc (input_location,
  				     tmp);
  	
        /* Get the number of elements - 1 and set the counter.  */
!       if (GFC_DESCRIPTOR_TYPE_P (decl_type))
  	{
  	  /* Use the descriptor for an allocatable array.  Since this
  	     is a full array reference, we only need the descriptor
*************** structure_alloc_comps (gfc_symbol * der_
*** 5981,5987 ****
        else
  	{
  	  /*  Otherwise use the TYPE_DOMAIN information.  */
! 	  tmp =  array_type_nelts (TREE_TYPE (decl));
  	  tmp = fold_convert (gfc_array_index_type, tmp);
  	}
  
--- 5989,5995 ----
        else
  	{
  	  /*  Otherwise use the TYPE_DOMAIN information.  */
! 	  tmp =  array_type_nelts (decl_type);
  	  tmp = fold_convert (gfc_array_index_type, tmp);
  	}
  
*************** structure_alloc_comps (gfc_symbol * der_
*** 5998,6004 ****
          {
  	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest)))
  	    {
! 	      tmp = gfc_duplicate_allocatable (dest, decl, TREE_TYPE(decl), rank);
  	      gfc_add_expr_to_block (&fnblock, tmp);
  	    }
  	  tmp = build_fold_indirect_ref_loc (input_location,
--- 6006,6012 ----
          {
  	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest)))
  	    {
! 	      tmp = gfc_duplicate_allocatable (dest, decl, decl_type, rank);
  	      gfc_add_expr_to_block (&fnblock, tmp);
  	    }
  	  tmp = build_fold_indirect_ref_loc (input_location,
Index: gcc/testsuite/gfortran.dg/alloc_comp_class_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/alloc_comp_class_1.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/alloc_comp_class_1.f90	(revision 0)
***************
*** 0 ****
--- 1,33 ----
+ ! { dg-do run }
+ ! Test the fix for PR43895, in which the dummy 'a' was not
+ ! dereferenced for the deallocation of component 'a', as required
+ ! for INTENT(OUT).
+ !
+ ! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+ !
+ module d_mat_mod
+   type  :: base_sparse_mat
+   end type base_sparse_mat
+ 
+   type, extends(base_sparse_mat) :: d_base_sparse_mat
+     integer :: i
+   end type d_base_sparse_mat
+ 
+   type :: d_sparse_mat
+     class(d_base_sparse_mat), allocatable  :: a 
+   end type d_sparse_mat
+ end module d_mat_mod
+ 
+   use d_mat_mod
+   type(d_sparse_mat) :: b
+   allocate (b%a)
+   b%a%i = 42
+   call bug14 (b)
+   if (allocated (b%a)) call abort
+ contains
+   subroutine bug14(a)
+     implicit none
+     type(d_sparse_mat), intent(out) :: a
+   end subroutine bug14
+ end
+ ! { dg-final { cleanup-modules "d_mat_mod " } }