re PR fortran/84523 (Runtime crash deallocating allocatable array within derived type)

2018-02-25  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84523
	* trans-intrinsic.c (gfc_conv_allocated): If the argument se
	has a pre block, add it to the expression pre block.

2018-02-25  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84523
	* gfortran.dg/pr84523.f90: New test.

From-SVN: r257970

gcc/fortran/ChangeLog

+2018-02-25  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/84523
+	* trans-intrinsic.c (gfc_conv_allocated): If the argument se
+	has a pre block, add it to the expression pre block.
+
 2018-02-25  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/78238

gcc/fortran/trans-intrinsic.c

@@ -7606,6 +7606,11 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr)
       tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp,
 			     fold_convert (TREE_TYPE (tmp), null_pointer_node));
     }
+
+  /* Components of pointer array references sometimes come back with a pre block.  */
+  if (arg1se.pre.head)
+    gfc_add_block_to_block (&se->pre, &arg1se.pre);
+
   se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp);
 }
 

gcc/testsuite/ChangeLog

+2018-02-25  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/84523
+	* gfortran.dg/pr84523.f90: New test.
+
 2018-02-25  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/78238

gcc/testsuite/gfortran.dg/pr84523.f90

+! { dg-do run }
+!
+! Test the fix for PR84523.
+!
+! Contributed by Harald Anlauf  <anlauf@gmx.de>
+!
+program gfcbug148
+  implicit none
+  integer, parameter :: nspots = 80
+  type t_spot
+    real, allocatable     :: vm(:,:,:)
+  end type t_spot
+  type t_rowcol
+    integer               :: nh
+    type(t_spot), pointer :: spots(:) => NULL ()
+  end type t_rowcol
+  type(t_rowcol)          :: col
+  call construct (col, nspots)
+  call destruct  (col)
+  !========================================================================
+contains
+  !========================================================================
+  subroutine construct (rc, nh)
+    type(t_rowcol) ,intent(out) :: rc   ! row or column to set
+    integer        ,intent(in)  :: nh   ! number of spots in a row
+    rc%nh = nh
+    allocate (rc%spots(nh))
+  end subroutine construct
+  !------------------------------------------------------------------------
+  subroutine destruct (rc)
+    type(t_rowcol) ,intent(inout) :: rc   ! row or column to free
+    integer :: k
+    if (associated (rc%spots)) then
+      if (size(rc%spots) .ne. nspots) stop 1
+      do k=1, size(rc% spots)
+        if (allocated (rc%spots(k)%vm)) stop 2  ! Would segfault in runtime.
+      end do
+      deallocate (rc%spots)
+    endif
+    nullify (rc%spots)
+  end subroutine destruct
+end program gfcbug148