From 5b26b3b3f5c75a86a5a3e851866247ac7fcb6c8b Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 26 Sep 2020 12:32:35 +0100 Subject: [PATCH] Correct overwrite of alloc_comp_result_2.f90 in fix of PR96495. 2020-26-09 Paul Thomas gcc/testsuite/ PR fortran/96495 * gfortran.dg/alloc_comp_result_2.f90 : Restore original. * gfortran.dg/alloc_comp_result_3.f90 : New test. --- gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 | 102 ++++++--------------- ...c_comp_result_2.f90 => alloc_comp_result_3.f90} | 2 +- 2 files changed, 28 insertions(+), 76 deletions(-) rewrite gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 (98%) copy gcc/testsuite/gfortran.dg/{alloc_comp_result_2.f90 => alloc_comp_result_3.f90} (99%) diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 dissimilarity index 98% index 6b0918715d7..2e907e31558 100644 --- a/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 +++ b/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 @@ -1,75 +1,27 @@ -! { dg-do run } -! -! Test the fix for PR96495 - segfaults at runtime at locations below. -! -! Contributed by Paul Luckner -! -module foo_m - - implicit none - - type foo - integer, allocatable :: j(:) - end type - - interface operator(.unary.) - module procedure neg_foo - end interface - - interface operator(.binary.) - module procedure foo_sub_foo - end interface - - interface operator(.binaryElemental.) - module procedure foo_add_foo - end interface - -contains - - elemental function foo_add_foo(f, g) result(h) - !! an example for an elemental binary operator - type(foo), intent(in) :: f, g - type(foo) :: h - - allocate (h%j(size(f%j)), source = f%j+g%j) - end function - - elemental function foo_sub_foo(f, g) result(h) - !! an example for an elemental binary operator - type(foo), intent(in) :: f, g - type(foo) :: h - - allocate (h%j(size(f%j)), source = f%j-3*g%j) - end function - - pure function neg_foo(f) result(g) - !! an example for a unary operator - type(foo), intent(in) :: f - type(foo) :: g - - allocate (g%j(size(f%j)), source = -f%j) - end function - -end module - -program main_tmp - - use foo_m - - implicit none - - type(foo) f, g(2) - - allocate (f%j(3)) - f%j = [2, 3, 4] - - g = f - if (any (g(2)%j .ne. [2, 3, 4])) stop 1 - - g = g .binaryElemental. (f .binary. f) ! threw "Segmentation fault" - if (any (g(2)%j .ne. [-2,-3,-4])) stop 2 - - g = g .binaryElemental. ( .unary. f) ! threw "Segmentation fault" - if (any (g(2)%j .ne. [-4,-6,-8])) stop 3 - -end program \ No newline at end of file +! Tests the fix for PR40440, in which gfortran tried to deallocate +! the allocatable components of the actual argument of CALL SUB +! +! Contributed by Juergen Reuter +! Reduced testcase from Tobias Burnus +! + implicit none + type t + integer, allocatable :: A(:) + end type t + type (t) :: arg + arg = t ([1,2,3]) + call sub (func (arg)) +contains + function func (a) + type(t), pointer :: func + type(t), target :: a + integer, save :: i = 0 + if (i /= 0) STOP 1! multiple calls would cause this abort + i = i + 1 + func => a + end function func + subroutine sub (a) + type(t), intent(IN), target :: a + if (any (a%A .ne. [1,2,3])) STOP 2 + end subroutine sub +end diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_result_3.f90 similarity index 99% copy from gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 copy to gcc/testsuite/gfortran.dg/alloc_comp_result_3.f90 index 6b0918715d7..8c4c982c67f 100644 --- a/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 +++ b/gcc/testsuite/gfortran.dg/alloc_comp_result_3.f90 @@ -72,4 +72,4 @@ program main_tmp g = g .binaryElemental. ( .unary. f) ! threw "Segmentation fault" if (any (g(2)%j .ne. [-4,-6,-8])) stop 3 -end program \ No newline at end of file +end program -- 2.11.4.GIT