1! { dg-do run } 2! 3! PR fortran/41872 4! 5! 6program test 7 implicit none 8 integer, allocatable :: a 9 integer, allocatable :: b 10 allocate(a) 11 call foo(a) 12 if(.not. allocated(a)) STOP 1 13 if (a /= 5) STOP 2 14 15 call bar(a) 16 if (a /= 7) STOP 3 17 18 deallocate(a) 19 if(allocated(a)) STOP 4 20 call check3(a) 21 if(.not. allocated(a)) STOP 5 22 if(a /= 6874) STOP 6 23 call check4(a) 24 if(.not. allocated(a)) STOP 7 25 if(a /= -478) STOP 8 26 27 allocate(b) 28 b = 7482 29 call checkOptional(.false.,.true., 7482) 30 if (b /= 7482) STOP 9 31 call checkOptional(.true., .true., 7482, b) 32 if (b /= 46) STOP 10 33contains 34 subroutine foo(a) 35 integer, allocatable, intent(out) :: a 36 if(allocated(a)) STOP 11 37 allocate(a) 38 a = 5 39 end subroutine foo 40 41 subroutine bar(a) 42 integer, allocatable, intent(inout) :: a 43 if(.not. allocated(a)) STOP 12 44 if (a /= 5) STOP 13 45 a = 7 46 end subroutine bar 47 48 subroutine check3(a) 49 integer, allocatable, intent(inout) :: a 50 if(allocated(a)) STOP 14 51 allocate(a) 52 a = 6874 53 end subroutine check3 54 55 subroutine check4(a) 56 integer, allocatable, intent(inout) :: a 57 if(.not.allocated(a)) STOP 15 58 if (a /= 6874) STOP 1 59 deallocate(a) 60 if(allocated(a)) STOP 16 61 allocate(a) 62 if(.not.allocated(a)) STOP 17 63 a = -478 64 end subroutine check4 65 66 subroutine checkOptional(prsnt, alloc, val, x) 67 logical, intent(in) :: prsnt, alloc 68 integer, allocatable, optional :: x 69 integer, intent(in) :: val 70 if (present(x) .neqv. prsnt) STOP 18 71 if (present(x)) then 72 if (allocated(x) .neqv. alloc) STOP 19 73 end if 74 if (present(x)) then 75 if (allocated(x)) then 76 if (x /= val) STOP 20 77 end if 78 end if 79 call checkOptional2(x) 80 if (present(x)) then 81 if (.not. allocated(x)) STOP 21 82 if (x /= -6784) STOP 22 83 x = 46 84 end if 85 call checkOptional2() 86 end subroutine checkOptional 87 subroutine checkOptional2(x) 88 integer, allocatable, optional, intent(out) :: x 89 if (present(x)) then 90 if (allocated(x)) STOP 23 91 allocate(x) 92 x = -6784 93 end if 94 end subroutine checkOptional2 95end program test 96