1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
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
|
