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. --- .../gfortran.dg/alloc_comp_result_2.f90 | 94 +++++-------------- .../gfortran.dg/alloc_comp_result_3.f90 | 75 +++++++++++++++ 2 files changed, 98 insertions(+), 71 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/alloc_comp_result_3.f90 diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 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 } +! Tests the fix for PR40440, in which gfortran tried to deallocate +! the allocatable components of the actual argument of CALL SUB ! -! Test the fix for PR96495 - segfaults at runtime at locations below. +! Contributed by Juergen Reuter +! Reduced testcase from Tobias Burnus ! -! 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 - + type t + integer, allocatable :: A(:) + end type t + type (t) :: arg + arg = t ([1,2,3]) + call sub (func (arg)) 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 + 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_3.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_result_3.f90 new file mode 100644 index 00000000000..8c4c982c67f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_result_3.f90 @@ -0,0 +1,75 @@ +! { 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 -- 2.30.2