re PR fortran/43895 ([OOP] internal compiler error: verify_ssa failed)

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.f90 : New test.

From-SVN: r160326

4 files changed, 59 insertions, 6 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3830da9..d9ab021 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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-04  Joseph Myers  <joseph@codesourcery.com>
 
 	* gfortranspec.c (append_arg, lang_specific_driver): Use
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 7d7b3a3..575dd02 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5938,6 +5938,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
   gfc_loopinfo loop;
   stmtblock_t fnblock;
   stmtblock_t loopbody;
+  tree decl_type;
   tree tmp;
   tree comp;
   tree dcmp;
@@ -5951,21 +5952,28 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 
   gfc_init_block (&fnblock);
 
-  if (POINTER_TYPE_P (TREE_TYPE (decl)) && rank != 0)
+  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 (TREE_TYPE (decl)) == ARRAY_TYPE
-	|| GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
+  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 (TREE_TYPE (decl)))
+      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
@@ -5981,7 +5989,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
       else
 	{
 	  /*  Otherwise use the TYPE_DOMAIN information.  */
-	  tmp =  array_type_nelts (TREE_TYPE (decl));
+	  tmp =  array_type_nelts (decl_type);
 	  tmp = fold_convert (gfc_array_index_type, tmp);
 	}
 
@@ -5998,7 +6006,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
         {
 	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest)))
 	    {
-	      tmp = gfc_duplicate_allocatable (dest, decl, TREE_TYPE(decl), rank);
+	      tmp = gfc_duplicate_allocatable (dest, decl, decl_type, rank);
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
 	  tmp = build_fold_indirect_ref_loc (input_location,
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4bfe09f..37caab6 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-06-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/43895
+	* gfortran.dg/alloc_comp_class_1.f90 : New test.
+
 2010-06-05  Jakub Jelinek  <jakub@redhat.com>
 
 	PR c++/44361
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_class_1.f90
new file mode 100644
index 0000000..c783f49
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_1.f90
@@ -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 " } }