1! { dg-do run }
2!
3! PR fortran/47775
4!
5! Contributed by Fran Martinez Fadrique
6!
7! Before, a temporary was missing for generic procedured (cf. test())
8! as the allocatable attribute was ignored for the check whether a
9! temporary is required
10!
11module m
12type t
13contains
14  procedure, NOPASS :: foo => foo
15  generic :: gen => foo
16end type t
17contains
18  function foo(i)
19    integer, allocatable :: foo(:)
20    integer :: i
21    allocate(foo(2))
22    foo(1) = i
23    foo(2) = i + 10
24  end function foo
25end module m
26
27use m
28type(t) :: x
29integer, pointer :: ptr1, ptr2
30integer, target              :: bar1(2)
31integer, target, allocatable :: bar2(:)
32
33allocate(bar2(2))
34ptr1 => bar1(2)
35ptr2 => bar2(2)
36
37bar1 = x%gen(1)
38if (ptr1 /= 11) STOP 1
39bar1 = x%foo(2)
40if (ptr1 /= 12) STOP 2
41bar2 = x%gen(3)
42if (ptr2 /= 13) STOP 3
43bar2 = x%foo(4)
44if (ptr2 /= 14) STOP 4
45bar2(:) = x%gen(5)
46if (ptr2 /= 15) STOP 5
47bar2(:) = x%foo(6)
48if (ptr2 /= 16) STOP 6
49
50call test()
51end
52
53subroutine test
54interface gen
55  procedure foo
56end interface gen
57
58integer, target :: bar(2)
59integer, pointer :: ptr
60bar = [1,2]
61ptr => bar(2)
62if (ptr /= 2) STOP 7
63bar = gen()
64if (ptr /= 77) STOP 8
65contains
66  function foo()
67    integer, allocatable :: foo(:)
68    allocate(foo(2))
69    foo = [33, 77]
70  end function foo
71end subroutine test
72