1! { dg-do run }
2! Test the fix for PR61459 and PR58883.
3!
4! Contributed by John Wingate  <johnww@tds.net>
5!             and Tao Song  <songtao.thu@gmail.com>
6!
7module a
8
9   implicit none
10   private
11   public :: f_segfault, f_segfault_plus, f_workaround
12   integer, dimension(2,2) :: b = reshape([1,-1,1,1],[2,2])
13
14contains
15
16   function f_segfault(x)
17      real, dimension(:), allocatable :: f_segfault
18      real, dimension(:), intent(in)  :: x
19      allocate(f_segfault(2))
20      f_segfault = matmul(b,x)
21   end function f_segfault
22
23! Sefaulted without the ALLOCATE as well.
24   function f_segfault_plus(x)
25      real, dimension(:), allocatable :: f_segfault_plus
26      real, dimension(:), intent(in)  :: x
27      f_segfault_plus = matmul(b,x)
28   end function f_segfault_plus
29
30   function f_workaround(x)
31      real, dimension(:), allocatable :: f_workaround
32      real, dimension(:), intent(in)  :: x
33      real, dimension(:), allocatable :: tmp
34      allocate(f_workaround(2),tmp(2))
35      tmp = matmul(b,x)
36      f_workaround = tmp
37   end function f_workaround
38
39end module a
40
41program main
42   use a
43   implicit none
44   real, dimension(2) :: x = 1.0, y
45! PR61459
46   y = f_workaround (x)
47   if (any (f_segfault (x) .ne. y)) call abort
48   if (any (f_segfault_plus (x) .ne. y)) call abort
49! PR58883
50   if (any (foo () .ne. reshape([1,2,3,4,5,6,7,8],[2,4]))) call abort
51contains
52  function foo()
53    integer, allocatable  :: foo(:,:)
54    integer, allocatable  :: temp(:)
55
56    temp = [1,2,3,4,5,6,7,8]
57    foo = reshape(temp,[2,4])
58  end function
59end program main
60