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