[fortran] PR86328 - [8/9 Regression] Runtime segfault reading an allocatable class(*) object in allocate statements

Message ID CAGkQGiJckRo2MM3QyFk7_mmA0=GCPZFF2RNjdWWD+igGtA4uZg@mail.gmail.com
State New
Headers show
Series
  • [fortran] PR86328 - [8/9 Regression] Runtime segfault reading an allocatable class(*) object in allocate statements
Related show

Commit Message

Paul Richard Thomas Aug. 29, 2018, 3:55 p.m.
The attached patch fixes PR86328 and PR86760. The regression was
caused by my commit r252949.

The parts of the patch that fix the PRs are in trans.c and
trans-array.c. The problem was caused by fixing the expressions that
would provide the 'span' in gfc_build_array_ref, since the latter
expected a variable expression. A number of evaluations of component
array elements were producing pre blocks that were not added and so
the temporaries were not being evaluated.

The fix is to pass the COMPONENT_REF and extract the 'span' directly from it.

The rest of the patch arises from PR86328 comment #12. In fact, this
took most of the time that I have spent on these PRs :-(  Having done
this, I felt that I had to include this part of the patch in the
submission. However, I have found a host of related bugs, which I will
put together in one PR.

My inclination is to commit the patch without the parts in resolve.c,
trans-expr.c and pr86328_12.f90, especially for 8-branch. I am open to
suggestions for 9-branch.

Bootstraps and regtests on FC28/x68_64 - OK for 8- and 9-branches?

Paul

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

    PR fortran/86328
    PR fortran/86760
    * resolve.c (resolve_ordinary_assign): Ensure that the vtable
    is generated for intrinsic assignment to unlimited polymorphic
    entities.
    * 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-expr.c (trans_class_assignment): For unlimited
    polymorphic assignments, 'size' must be multiplied by the rhs
    '_len' values if non-zero.
    (gfc_trans_assignment_1): For scalar polymorphic assignments to
    allocatable lhs, finalize and deallocate before the assignment
    is made.
    * trans.c (gfc_build_array_ref): If 'decl' is a COMPONENT_REF
    obtain the span field directly from it.

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

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

Comments

Janus Weil Aug. 29, 2018, 7:18 p.m. | #1
Hi Paul,

> The attached patch fixes PR86328 and PR86760. The regression was

> caused by my commit r252949.

>

> The parts of the patch that fix the PRs are in trans.c and

> trans-array.c. The problem was caused by fixing the expressions that

> would provide the 'span' in gfc_build_array_ref, since the latter

> expected a variable expression. A number of evaluations of component

> array elements were producing pre blocks that were not added and so

> the temporaries were not being evaluated.

>

> The fix is to pass the COMPONENT_REF and extract the 'span' directly from it.

>

> The rest of the patch arises from PR86328 comment #12. In fact, this

> took most of the time that I have spent on these PRs :-(  Having done

> this, I felt that I had to include this part of the patch in the

> submission. However, I have found a host of related bugs, which I will

> put together in one PR.

>

> My inclination is to commit the patch without the parts in resolve.c,

> trans-expr.c and pr86328_12.f90, especially for 8-branch. I am open to

> suggestions for 9-branch.

>

> Bootstraps and regtests on FC28/x68_64 - OK for 8- and 9-branches?


the patch is ok for trunk from my side. I also agree that it makes
sense to backport those parts that address the regression to 8-branch.
Thanks for the fix!

Cheers,
Janus
Paul Richard Thomas Sept. 1, 2018, 11:58 a.m. | #2
Hi Janus,

Thanks for the review. I decided to commit just the parts that address
the regression to both branches. Assignment to polymorphic variables
is in such a mess that I did not consider it sensible to apply part of
a fragment of Band Aid. I will raise a PR for the bugs that I know of.

Committed to 8-branch as r264027 and trunk as r264008

Cheers

Paul


On 29 August 2018 at 20:18, Janus Weil <janus@gcc.gnu.org> wrote:
> Hi Paul,

>

>> The attached patch fixes PR86328 and PR86760. The regression was

>> caused by my commit r252949.

>>

>> The parts of the patch that fix the PRs are in trans.c and

>> trans-array.c. The problem was caused by fixing the expressions that

>> would provide the 'span' in gfc_build_array_ref, since the latter

>> expected a variable expression. A number of evaluations of component

>> array elements were producing pre blocks that were not added and so

>> the temporaries were not being evaluated.

>>

>> The fix is to pass the COMPONENT_REF and extract the 'span' directly from it.

>>

>> The rest of the patch arises from PR86328 comment #12. In fact, this

>> took most of the time that I have spent on these PRs :-(  Having done

>> this, I felt that I had to include this part of the patch in the

>> submission. However, I have found a host of related bugs, which I will

>> put together in one PR.

>>

>> My inclination is to commit the patch without the parts in resolve.c,

>> trans-expr.c and pr86328_12.f90, especially for 8-branch. I am open to

>> suggestions for 9-branch.

>>

>> Bootstraps and regtests on FC28/x68_64 - OK for 8- and 9-branches?

>

> the patch is ok for trunk from my side. I also agree that it makes

> sense to backport those parts that address the regression to 8-branch.

> Thanks for the fix!

>

> Cheers,

> Janus




-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Patch

Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 263915)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_ordinary_assign (gfc_code *code,
*** 10258,10263 ****
--- 10258,10271 ----
    gfc_ref *ref;
    symbol_attribute attr;
  
+   /* Make sure that a vtable exists for intrinsic rhs of an assignment
+      to an unlimited polymorphic lhs.  */
+   if (code->expr1
+       && code->expr1->ts.type == BT_CLASS
+       && code->expr1->ts.u.derived
+       && UNLIMITED_POLY (code->expr1))
+     gfc_find_vtab (&code->expr2->ts);
+ 
    if (gfc_extend_assign (code, ns))
      {
        gfc_expr** rhsptr;
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 263915)
--- gcc/fortran/trans-array.c	(working copy)
*************** gfc_conv_scalarized_array_ref (gfc_se *
*** 3414,3424 ****
    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;
! 	}
        else if (TREE_CODE (info->descriptor) == INDIRECT_REF)
  	decl = TREE_OPERAND (info->descriptor, 0);
  
--- 3414,3420 ----
    if (is_pointer_array (info->descriptor))
      {
        if (TREE_CODE (info->descriptor) == COMPONENT_REF)
! 	decl = info->descriptor;
        else if (TREE_CODE (info->descriptor) == INDIRECT_REF)
  	decl = TREE_OPERAND (info->descriptor, 0);
  
*************** gfc_conv_array_ref (gfc_se * se, gfc_arr
*** 3659,3669 ****
        && 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;
! 	}
        else if (TREE_CODE (se->expr) == INDIRECT_REF)
  	decl = TREE_OPERAND (se->expr, 0);
        else
--- 3655,3661 ----
        && is_pointer_array (se->expr))
      {
        if (TREE_CODE (se->expr) == COMPONENT_REF)
! 	decl = se->expr;
        else if (TREE_CODE (se->expr) == INDIRECT_REF)
  	decl = TREE_OPERAND (se->expr, 0);
        else
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 263916)
--- gcc/fortran/trans-expr.c	(working copy)
*************** trans_class_assignment (stmtblock_t *blo
*** 9922,9933 ****
      {
        stmtblock_t alloc;
        tree class_han;
  
-       tmp = gfc_vptr_size_get (vptr);
        class_han = GFC_CLASS_TYPE_P (TREE_TYPE (lse->expr))
  	  ? gfc_class_data_get (lse->expr) : lse->expr;
        gfc_init_block (&alloc);
!       gfc_allocate_using_malloc (&alloc, class_han, tmp, NULL_TREE);
        tmp = fold_build2_loc (input_location, EQ_EXPR,
  			     logical_type_node, class_han,
  			     build_int_cst (prvoid_type_node, 0));
--- 9922,9948 ----
      {
        stmtblock_t alloc;
        tree class_han;
+       tree size;
+       tree ctmp;
+ 
+       size = gfc_vptr_size_get (vptr);
+       if (UNLIMITED_POLY (lhs))
+         {
+ 	  tmp = fold_convert (gfc_array_index_type,
+ 			      gfc_class_len_get (TREE_OPERAND (vptr, 0)));
+ 	  ctmp = fold_build2_loc (input_location, MULT_EXPR,
+ 				  gfc_array_index_type, size, tmp);
+ 	  tmp = fold_build2_loc (input_location, GT_EXPR,
+ 				 logical_type_node, tmp,
+ 				 build_zero_cst (TREE_TYPE (tmp)));
+ 	  size = fold_build3_loc (input_location, COND_EXPR,
+ 			      gfc_array_index_type, tmp, ctmp, size);
+ 	}
  
        class_han = GFC_CLASS_TYPE_P (TREE_TYPE (lse->expr))
  	  ? gfc_class_data_get (lse->expr) : lse->expr;
        gfc_init_block (&alloc);
!       gfc_allocate_using_malloc (&alloc, class_han, size, NULL_TREE);
        tmp = fold_build2_loc (input_location, EQ_EXPR,
  			     logical_type_node, class_han,
  			     build_int_cst (prvoid_type_node, 0));
*************** gfc_trans_assignment_1 (gfc_expr * expr1
*** 10306,10315 ****
    tmp = NULL_TREE;
  
    if (is_poly_assign)
!     tmp = trans_class_assignment (&body, expr1, expr2, &lse, &rse,
! 				  use_vptr_copy || (lhs_attr.allocatable
! 						    && !lhs_attr.dimension),
! 				  flag_realloc_lhs && !lhs_attr.pointer);
    else if (flag_coarray == GFC_FCOARRAY_LIB
  	   && lhs_caf_attr.codimension && rhs_caf_attr.codimension
  	   && ((lhs_caf_attr.allocatable && lhs_refs_comp)
--- 10321,10351 ----
    tmp = NULL_TREE;
  
    if (is_poly_assign)
!     {
!       if (lhs_attr.allocatable && dealloc && lss == gfc_ss_terminator)
! 	{
! 	  tree ptr;
! 
! 	  ptr = lse.expr;
! 	  if (GFC_CLASS_TYPE_P (TREE_TYPE (ptr)))
! 	    ptr = gfc_class_data_get (ptr);
! 
! 	  /* This provides finalization of the lhs before the assignment.  */
! 	  tmp = gfc_deallocate_scalar_with_status (ptr, NULL_TREE,
! 						   NULL_TREE, true,
! 						   expr1, expr1->ts);
! 	  gfc_add_expr_to_block (&block, tmp);
! 	  tmp = fold_build2_loc (input_location, MODIFY_EXPR,
! 				 void_type_node, ptr,
! 				 build_int_cst (TREE_TYPE (ptr), 0));
! 	  gfc_add_expr_to_block (&block, tmp);
! 	}
! 
!       tmp = trans_class_assignment (&body, expr1, expr2, &lse, &rse,
! 				    use_vptr_copy || (lhs_attr.allocatable
! 						      && !lhs_attr.dimension),
! 				    flag_realloc_lhs && !lhs_attr.pointer);
!     }
    else if (flag_coarray == GFC_FCOARRAY_LIB
  	   && lhs_caf_attr.codimension && rhs_caf_attr.codimension
  	   && ((lhs_caf_attr.allocatable && lhs_refs_comp)
Index: gcc/fortran/trans.c
===================================================================
*** gcc/fortran/trans.c	(revision 263915)
--- gcc/fortran/trans.c	(working copy)
*************** gfc_build_array_ref (tree base, tree off
*** 407,413 ****
    if (vptr)
      span = gfc_vptr_size_get (vptr);
    else if (decl)
!     span = get_array_span (type, decl);
  
    /* If a non-null span has been generated reference the element with
       pointer arithmetic.  */
--- 407,418 ----
    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.  */
Index: gcc/testsuite/gfortran.dg/pr86328.f90
===================================================================
*** gcc/testsuite/gfortran.dg/pr86328.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/pr86328.f90	(working copy)
***************
*** 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
Index: gcc/testsuite/gfortran.dg/pr86328_12.f90
===================================================================
*** gcc/testsuite/gfortran.dg/pr86328_12.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/pr86328_12.f90	(working copy)
***************
*** 0 ****
--- 1,61 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR86328 comment 12. This had nothing to do with
+ ! the original PR. See below.
+ !
+ ! Contributed by Martin  <mscfd@gmx.net>
+ !
+ program classstar_alloc3
+ 
+    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='01')
+    end do
+ 
+    call rrr(a)
+ 
+    do i = 1,2
+       deallocate(a%ll(i)%val)
+    end do
+ 
+    deallocate(a%ll)
+ 
+ contains
+ 
+    subroutine rrr(a)
+       type(list), intent(in) :: a
+       class(*), allocatable :: c
+ 
+       allocate(c, source=a%ll(2)%val)
+       select type (c)
+         type is (character(len=*))
+           if (len (c) .ne. 2) stop 1
+           if (c .ne. '01') stop 2
+       end select
+ 
+       c = a%ll(2)%val ! This caused invalid reads.
+       select type (c)
+         type is (character(len=*))
+           if (len (c) .ne. 2) stop 3
+           if (c .ne. '01') stop 4
+       end select
+ 
+       c = '123456' ! 'c' remained size 2.
+       select type (c)
+         type is (character(len=*))
+           if (len (c) .ne. 6) stop 5
+           if (c .ne. '123456') stop 6
+       end select
+    end subroutine
+ end program classstar_alloc3
Index: gcc/testsuite/gfortran.dg/pr86760.f90
===================================================================
*** gcc/testsuite/gfortran.dg/pr86760.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/pr86760.f90	(working copy)
***************
*** 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