re PR fortran/86328 (Runtime segfault reading an allocatable class(*) object in allocate statements)

2018-08-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/86328
	PR fortran/86760
	* trans-array.c (gfc_conv_scalarized_array_ref): Do not fix
	info->descriptor but pass it directly to gfc_build_array_ref.
	(gfc_conv_array_ref): Likewise for se->expr.
	* trans.c (gfc_build_array_ref): If 'decl' is a COMPONENT_REF
	obtain the span field directly from it.

2018-08-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/86328
	PR fortran/86760
	* gfortran.dg/pr86328.f90 : New test.
	in comment 12 of the PR.
	* gfortran.dg/pr86760.f90 : New test.

From-SVN: r264008

gcc/fortran/ChangeLog

@@ -1,3 +1,13 @@
+2018-08-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/86328
+	PR fortran/86760
+	* trans-array.c (gfc_conv_scalarized_array_ref): Do not fix
+	info->descriptor but pass it directly to gfc_build_array_ref.
+	(gfc_conv_array_ref): Likewise for se->expr.
+	* trans.c (gfc_build_array_ref): If 'decl' is a COMPONENT_REF
+	obtain the span field directly from it.
+
 2017-08-28  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/80477

gcc/fortran/trans-array.c

@@ -3414,11 +3414,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
   if (is_pointer_array (info->descriptor))
     {
       if (TREE_CODE (info->descriptor) == COMPONENT_REF)
-	{
-	  decl = gfc_evaluate_now (info->descriptor, &se->pre);
-	  GFC_DECL_PTR_ARRAY_P (decl) = 1;
-	  TREE_USED (decl) = 1;
-	}
+	decl = info->descriptor;
       else if (TREE_CODE (info->descriptor) == INDIRECT_REF)
 	decl = TREE_OPERAND (info->descriptor, 0);
 
@@ -3659,11 +3655,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
       && is_pointer_array (se->expr))
     {
       if (TREE_CODE (se->expr) == COMPONENT_REF)
-	{
-	  decl = gfc_evaluate_now (se->expr, &se->pre);
-	  GFC_DECL_PTR_ARRAY_P (decl) = 1;
-	  TREE_USED (decl) = 1;
-	}
+	decl = se->expr;
       else if (TREE_CODE (se->expr) == INDIRECT_REF)
 	decl = TREE_OPERAND (se->expr, 0);
       else

gcc/fortran/trans.c

@@ -407,7 +407,12 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
   if (vptr)
     span = gfc_vptr_size_get (vptr);
   else if (decl)
+    {
+      if (TREE_CODE (decl) == COMPONENT_REF)
+	span = gfc_conv_descriptor_span_get (decl);
+      else
 	span = get_array_span (type, decl);
+    }
 
   /* If a non-null span has been generated reference the element with
      pointer arithmetic.  */

gcc/testsuite/ChangeLog

@@ -1,3 +1,11 @@
+2018-08-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/86328
+	PR fortran/86760
+	* gfortran.dg/pr86328.f90 : New test.
+	in comment 12 of the PR.
+	* gfortran.dg/pr86760.f90 : New test.
+
 2018-08-30  Sandra Loosemore  <sandra@codesourcery.com>
 
 	* g++.dg/cpp0x/noexcept30.C: Make dependence on

gcc/testsuite/gfortran.dg/pr86328.f90

@@ -0,0 +1,49 @@
+! { dg-do run }
+!
+! Test the fix for PR86328 in which temporaries were not being
+! assigned for array component references.
+!
+! Contributed by Martin  <mscfd@gmx.net>
+!
+program ptr_alloc
+
+   type :: t
+      class(*), allocatable :: val
+   end type
+
+   type :: list
+      type(t), dimension(:), pointer :: ll
+   end type
+
+   integer :: i
+   type(list) :: a
+
+   allocate(a%ll(1:2))
+   do i = 1,2
+      allocate(a%ll(i)%val, source=i)
+   end do
+
+   do i = 1,2
+     call rrr(a, i)
+   end do
+
+   do i = 1,2
+      deallocate(a%ll(i)%val)
+   end do
+   deallocate (a%ll)
+contains
+
+   subroutine rrr(a, i)
+      type(list), intent(in) :: a
+      class(*), allocatable :: c
+      integer :: i
+
+      allocate(c, source=a%ll(i)%val)
+      select type (c)
+        type is (integer)
+          if (c .ne. i) stop 1
+      end select
+
+   end subroutine
+
+end

gcc/testsuite/gfortran.dg/pr86760.f90

@@ -0,0 +1,57 @@
+! { dg-do run }
+!
+! Test the fix for PR86760 in which temporaries were not being
+! assigned for array component references.
+!
+! Contributed by Chris Hansen  <hansec@uw.edu>
+!
+MODULE test_nesting_mod
+  IMPLICIT NONE
+  TYPE :: test_obj1
+  CONTAINS
+    PROCEDURE :: destroy
+  END TYPE
+
+  TYPE :: obj_ptr
+    CLASS(test_obj1), POINTER :: f => NULL()
+  END TYPE
+
+  TYPE :: obj_container
+    TYPE(obj_ptr), POINTER, DIMENSION(:) :: v => NULL()
+  END TYPE
+
+  integer :: ctr = 0
+
+CONTAINS
+
+  SUBROUTINE destroy(self)
+    CLASS(test_obj1), INTENT(INOUT):: self
+    ctr = ctr + 1
+  END SUBROUTINE
+
+  SUBROUTINE container_destroy(self)
+    type(obj_container), INTENT(INOUT) :: self
+    INTEGER :: i
+    DO i=1,ubound(self%v,1)
+      CALL self%v(i)%f%destroy()
+    END DO
+  END SUBROUTINE
+
+END MODULE
+
+
+PROGRAM test_nesting_ptr
+  USE test_nesting_mod
+  IMPLICIT NONE
+  INTEGER :: i
+  INTEGER, PARAMETER :: n = 2
+  TYPE(obj_container) :: var
+
+  ALLOCATE(var%v(n))
+  DO i=1,n
+    ALLOCATE(test_obj1::var%v(i)%f)
+  END DO
+  CALL container_destroy(var)
+
+  if (ctr .ne. 2) stop 1
+END