! { dg-do run }
|
! { dg-do run }
|
! { dg-options "-Wall -pedantic" }
|
! { dg-options "-Wall -pedantic" }
|
!
|
!
|
! PR fortran/41872
|
! PR fortran/41872
|
!
|
!
|
! More tests for allocatable scalars
|
! More tests for allocatable scalars
|
!
|
!
|
program test
|
program test
|
implicit none
|
implicit none
|
integer, allocatable :: a
|
integer, allocatable :: a
|
integer :: b
|
integer :: b
|
|
|
if (allocated (a)) call abort ()
|
if (allocated (a)) call abort ()
|
if (allocated (func (.false.))) call abort ()
|
if (allocated (func (.false.))) call abort ()
|
if (.not.allocated (func (.true.))) call abort ()
|
if (.not.allocated (func (.true.))) call abort ()
|
b = 7
|
b = 7
|
b = func(.true.)
|
b = func(.true.)
|
if (b /= 5332) call abort ()
|
if (b /= 5332) call abort ()
|
b = 7
|
b = 7
|
b = func(.true.) + 1
|
b = func(.true.) + 1
|
if (b /= 5333) call abort ()
|
if (b /= 5333) call abort ()
|
|
|
call intout (a, .false.)
|
call intout (a, .false.)
|
if (allocated (a)) call abort ()
|
if (allocated (a)) call abort ()
|
call intout (a, .true.)
|
call intout (a, .true.)
|
if (.not.allocated (a)) call abort ()
|
if (.not.allocated (a)) call abort ()
|
if (a /= 764) call abort ()
|
if (a /= 764) call abort ()
|
call intout2 (a)
|
call intout2 (a)
|
if (allocated (a)) call abort ()
|
if (allocated (a)) call abort ()
|
|
|
if (allocated (func2 ())) call abort ()
|
if (allocated (func2 ())) call abort ()
|
contains
|
contains
|
|
|
function func (alloc)
|
function func (alloc)
|
integer, allocatable :: func
|
integer, allocatable :: func
|
logical :: alloc
|
logical :: alloc
|
if (allocated (func)) call abort ()
|
if (allocated (func)) call abort ()
|
if (alloc) then
|
if (alloc) then
|
allocate(func)
|
allocate(func)
|
func = 5332
|
func = 5332
|
end if
|
end if
|
end function func
|
end function func
|
|
|
function func2 ()
|
function func2 ()
|
integer, allocatable :: func2
|
integer, allocatable :: func2
|
end function func2
|
end function func2
|
|
|
subroutine intout (dum, alloc)
|
subroutine intout (dum, alloc)
|
implicit none
|
implicit none
|
integer, allocatable,intent(out) :: dum
|
integer, allocatable,intent(out) :: dum
|
logical :: alloc
|
logical :: alloc
|
if (allocated (dum)) call abort()
|
if (allocated (dum)) call abort()
|
if (alloc) then
|
if (alloc) then
|
allocate (dum)
|
allocate (dum)
|
dum = 764
|
dum = 764
|
end if
|
end if
|
end subroutine intout
|
end subroutine intout
|
|
|
subroutine intout2 (dum) ! { dg-warning "declared INTENT.OUT. but was not set" }
|
subroutine intout2 (dum) ! { dg-warning "declared INTENT.OUT. but was not set" }
|
integer, allocatable,intent(out) :: dum
|
integer, allocatable,intent(out) :: dum
|
end subroutine intout2
|
end subroutine intout2
|
end program test
|
end program test
|
|
|
