blob: ebe26d55d2bdfa7c852eff7912da1a89763c80c5 [file] [log] [blame]
! { dg-do run { target i?86-*-linux* x86_64-*-linux* } }
! { dg-additional-sources set_vm_limit.c }
!
! This test calls set_vm_limit to set an artificially low address space
! limit. set_vm_limit calls setrlimit, which has some portability
! considerations. setrlimit gets errors on arm*linux and aarch64*linux,
! and when the main program calls malloc(), it in turn fails on Darwin.
! The code being tested is portable, calling ALLOCATED() or ASSOCIATED()
! to verify that allocation was successful, so the operating assumption
! is that as long as this test runs on at least one system, we can call
! it good.
USE :: ISO_C_BINDING !, only: C_INT
IMPLICIT NONE
INTERFACE
SUBROUTINE set_vm_limit(n) bind(C)
import
integer(C_INT), value, intent(in) :: n
END SUBROUTINE set_vm_limit
END INTERFACE
TYPE foo
INTEGER, DIMENSION(10000) :: data = 42
END TYPE
TYPE(foo), POINTER :: foo_ptr
TYPE(foo), ALLOCATABLE :: foo_obj
TYPE(foo), ALLOCATABLE, DIMENSION(:) :: foo_array
INTEGER istat
CALL set_vm_limit(1000000)
DO
ALLOCATE(foo_ptr, stat = istat)
IF (istat .NE. 0) THEN
PRINT *, "foo_ptr allocation failed"
EXIT
ENDIF
ENDDO
ALLOCATE(foo_obj, stat = istat)
IF (istat .NE. 0) THEN
PRINT *, "foo_obj allocation failed"
ENDIF
ALLOCATE(foo_array(5), stat = istat)
IF (istat .NE. 0) THEN
PRINT *, "foo_array allocation failed"
ENDIF
END
! { dg-output " *foo_ptr allocation failed(\n|\r\n|\r)" }
! { dg-output " *foo_obj allocation failed(\n|\r\n|\r)" }
! { dg-output " *foo_array allocation failed(\n|\r\n|\r)" }