OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [coarray/] [allocate_errgmsg.f90] - Rev 749

Go to most recent revision | Compare with Previous | Blame | View Log

! { dg-do run }
!
! Check handling of errmsg.
!
implicit none
integer, allocatable :: a[:], b(:)[:], c, d(:)
integer :: stat
character(len=300) :: str

allocate(a[*], b(1)[*], c, d(2), stat=stat)

str = repeat('X', len(str))
allocate(a[*], stat=stat, errmsg=str)
!print *, stat, trim(str)
if (stat == 0 .or. str /= "Attempt to allocate an allocated object") &
  call abort ()

str = repeat('Y', len(str))
allocate(b(2)[*], stat=stat, errmsg=str)
!print *, stat, trim(str)
if (stat == 0 .or. str /= "Attempt to allocate an allocated object") &
  call abort ()

str = repeat('Q', len(str))
allocate(c, stat=stat, errmsg=str)
!print *, stat, trim(str)
if (stat == 0 .or. str /= "Attempt to allocate an allocated object") &
  call abort ()

str = repeat('P', len(str))
allocate(d(3), stat=stat, errmsg=str)
!print *, stat, trim(str)
if (stat == 0 .or. str /= "Attempt to allocate an allocated object") &
  call abort ()

end

Go to most recent revision | Compare with Previous | Blame | View Log

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.