Subversion Repositories openrisc

! { dg-do run }

! { dg-options "-std=f2008 -fall-intrinsics" }

!

! Passing a null pointer or deallocated variable to an

! optional, non-pointer, non-allocatable dummy.

!

program test

  implicit none

  integer, pointer :: ps => NULL(), pa(:) => NULL()

  integer, allocatable :: as, aa(:)

  call scalar(ps)

  call scalar(as)

  call scalar()

  call scalar(NULL())

  call assumed_size(pa)

  call assumed_size(aa)

  call assumed_size()

  call assumed_size(NULL(pa))

  call assumed_shape(pa)

  call assumed_shape(aa)

  call assumed_shape()

  call assumed_shape(NULL())

  call ptr_func(.true., ps)

  call ptr_func(.true., null())

  call ptr_func(.false.)

contains

  subroutine scalar(a)

    integer, optional :: a

    if (present(a)) call abort()

  end subroutine scalar

  subroutine assumed_size(a)

    integer, optional :: a(*)

    if (present(a)) call abort()

  end subroutine assumed_size

  subroutine assumed_shape(a)

    integer, optional :: a(:)

    if (present(a)) call abort()

  end subroutine assumed_shape

  subroutine ptr_func(is_psnt, a)

    integer, optional, pointer :: a

    logical :: is_psnt

    if (is_psnt .neqv. present(a)) call abort()

  end subroutine ptr_func

end program test