gcc/testsuite/gfortran.dg/implicit_pure_5.f90

! { dg-do run }
! { dg-additional-sources implicit_pure_5.c }
! PR fortran/96018 - a wrongly marked implicit_pure
! function caused wrong code.
module wrapper
  use, intrinsic :: iso_c_binding, only : c_int
  implicit none
  integer(kind=c_int), bind(C) :: num_calls
contains

  integer function call_side_effect() result(ierr)
    call side_effect(ierr)
  end function call_side_effect

  integer function inner_3d(array) result(ierr)
    real, intent(in) :: array(:,:,:)
    integer dimensions(3)
    dimensions = shape(array)
    ierr = call_side_effect()
  end function inner_3d

  integer function inner_4d(array) result(ierr)
    real, intent(in) :: array(:,:,:,:)
    integer dimensions(4)
    dimensions = shape(array)
    ierr = call_side_effect()
  end function inner_4d

  subroutine write_3d()
    real :: array(1,1,1)
    integer ierr
    ierr = inner_3d(array)
    ierr = call_side_effect()
  end subroutine write_3d

  subroutine write_4d()
    real array(1,1,1,1)
    integer ierr
    ierr = inner_4d(array)
    ierr = call_side_effect()
  end subroutine write_4d

  subroutine side_effect(ierr)
    integer, intent(out) :: ierr        ! Error code
    interface
       integer(c_int) function side_effect_c() bind(C,name='side_effect_c')
         use, intrinsic :: iso_c_binding, only: c_int
       end function side_effect_c
    end interface
    ierr = side_effect_c()
  end subroutine side_effect

end module wrapper

program self_contained
  use wrapper
  implicit none
  call write_3d()
  if (num_calls /= 2) stop 1
  call write_4d()
  if (num_calls /= 4) stop 2
end program self_contained