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

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 78e3c2e164de1b8b5877f31774d424a3dd4d5e96..2c2aa2b8d9031dc5a74dc508384a7cff9f708075 100644 (file)
--- 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 c4a3775d858d38abf0e8b447ae6d4b5a0a8fea7e..816f3b99ac19cd6740965fa7c2335bd63121b796 100644 (file)
--- 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 0f8219d0717d254aaf5799050ea1cccda85853c8..0a015c8ca593847631d663b54175522ec3b4253a 100644 (file)
--- 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 (file)
index 0000000..69b9c27
--- /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