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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 04598438aaededec6651157606153ad4e5823f1b..c386a649583f973b8d5d42478aa0b90770f81f4c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/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

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 81337944224186f9a6fe34477325ef46bfb3719b..adb2c0575a861b65d49c0c17bd969e4873f104e3 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/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

diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index aa10fbb405a12319512f3f3070dd3a6ffb7de7a8..153bab633960a22fe680d056df2bc9661779d4b6 100644 (file)
--- a/gcc/fortran/trans.c
+++ b/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)
-    span = get_array_span (type, 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.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 672c072393b8f6361271aa8481975edc8876f7c3..c0240a13700a3f0084806311803094a77e6cb47f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/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

diff --git a/gcc/testsuite/gfortran.dg/pr86328.f90 b/gcc/testsuite/gfortran.dg/pr86328.f90
new file mode 100644 (file)
index 0000000..dfa0e06
--- /dev/null
+++ b/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

diff --git a/gcc/testsuite/gfortran.dg/pr86760.f90 b/gcc/testsuite/gfortran.dg/pr86760.f90
new file mode 100644 (file)
index 0000000..e75b47c
--- /dev/null
+++ b/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