Correct overwrite of alloc_comp_result_2.f90 in fix of PR96495.
2020-26-09 Paul Thomas <pault@gcc.gnu.org> gcc/testsuite/ PR fortran/96495 * gfortran.dg/alloc_comp_result_2.f90 : Restore original. * gfortran.dg/alloc_comp_result_3.f90 : New test.
This commit is contained in:
Paul Thomas
parent
a8d2d89de2
commit
5b26b3b3f5
2 changed files with 98 additions and 71 deletions
|
|
@ -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 <juergen.reuter@desy.de>
|
||||
! Reduced testcase from Tobias Burnus <burnus@gcc.gnu.org>
|
||||
!
|
||||
! Contributed by Paul Luckner <paul.luckner@rwth-aachen.de>
|
||||
!
|
||||
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
|
||||
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
|
||||
|
|
|
|||
75
gcc/testsuite/gfortran.dg/alloc_comp_result_3.f90
Normal file
75
gcc/testsuite/gfortran.dg/alloc_comp_result_3.f90
Normal file
|
|
@ -0,0 +1,75 @@
|
|||
! { dg-do run }
|
||||
!
|
||||
! Test the fix for PR96495 - segfaults at runtime at locations below.
|
||||
!
|
||||
! Contributed by Paul Luckner <paul.luckner@rwth-aachen.de>
|
||||
!
|
||||
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
|
||||
Loading…
Add table
Reference in a new issue