1! { dg-do run }
2! { dg-additional-sources implicit_pure_5.c }
3! PR fortran/96018 - a wrongly marked implicit_pure
4! function caused wrong code.
5module wrapper
6  use, intrinsic :: iso_c_binding, only : c_int
7  implicit none
8  integer(kind=c_int), bind(C) :: num_calls
9contains
10
11  integer function call_side_effect() result(ierr)
12    call side_effect(ierr)
13  end function call_side_effect
14
15  integer function inner_3d(array) result(ierr)
16    real, intent(in) :: array(:,:,:)
17    integer dimensions(3)
18    dimensions = shape(array)
19    ierr = call_side_effect()
20  end function inner_3d
21
22  integer function inner_4d(array) result(ierr)
23    real, intent(in) :: array(:,:,:,:)
24    integer dimensions(4)
25    dimensions = shape(array)
26    ierr = call_side_effect()
27  end function inner_4d
28
29  subroutine write_3d()
30    real :: array(1,1,1)
31    integer ierr
32    ierr = inner_3d(array)
33    ierr = call_side_effect()
34  end subroutine write_3d
35
36  subroutine write_4d()
37    real array(1,1,1,1)
38    integer ierr
39    ierr = inner_4d(array)
40    ierr = call_side_effect()
41  end subroutine write_4d
42
43  subroutine side_effect(ierr)
44    integer, intent(out) :: ierr        ! Error code
45    interface
46       integer(c_int) function side_effect_c() bind(C,name='side_effect_c')
47         use, intrinsic :: iso_c_binding, only: c_int
48       end function side_effect_c
49    end interface
50    ierr = side_effect_c()
51  end subroutine side_effect
52
53end module wrapper
54
55program self_contained
56  use wrapper
57  implicit none
58  call write_3d()
59  if (num_calls /= 2) stop 1
60  call write_4d()
61  if (num_calls /= 4) stop 2
62end program self_contained
63
64