From: Paul Thomas <pault@gcc.gnu.org>
Date: Sun, 25 Feb 2018 12:41:26 +0000 (+0000)
Subject: re PR fortran/84523 (Runtime crash deallocating allocatable array within derived... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=8fba26f48f4224ca9f2faab0b2a28e20784a119c;p=gcc.git

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 78e3c2e164d..2c2aa2b8d90 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index c4a3775d858..816f3b99ac1 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/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);
 }
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0f8219d0717..0a015c8ca59 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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
diff --git a/gcc/testsuite/gfortran.dg/pr84523.f90 b/gcc/testsuite/gfortran.dg/pr84523.f90
new file mode 100644
index 00000000000..69b9c27e503
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr84523.f90
@@ -0,0 +1,42 @@
+! { 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