1! { dg-do run { target i?86-*-linux* x86_64-*-linux* } }
2! { dg-additional-sources set_vm_limit.c }
3!
4! This test calls set_vm_limit to set an artificially low address space
5! limit.  set_vm_limit calls setrlimit, which has some portability
6! considerations.  setrlimit gets errors on arm*linux and aarch64*linux,
7! and when the main program calls malloc(), it in turn fails on Darwin.
8! The code being tested is portable, calling ALLOCATED() or ASSOCIATED()
9! to verify that allocation was successful, so the operating assumption
10! is that as long as this test runs on at least one system, we can call
11! it good.
12
13USE :: ISO_C_BINDING !, only: C_INT
14IMPLICIT NONE
15
16INTERFACE
17  SUBROUTINE set_vm_limit(n) bind(C)
18  import
19  integer(C_INT), value, intent(in) :: n
20  END SUBROUTINE set_vm_limit
21END INTERFACE
22
23TYPE foo
24  INTEGER, DIMENSION(10000) :: data = 42
25END TYPE
26TYPE(foo), POINTER :: foo_ptr
27TYPE(foo), ALLOCATABLE :: foo_obj
28TYPE(foo), ALLOCATABLE, DIMENSION(:) :: foo_array
29
30INTEGER istat
31
32CALL set_vm_limit(1000000)
33
34DO
35  ALLOCATE(foo_ptr, stat = istat)
36  IF (istat .NE. 0) THEN
37    PRINT *, "foo_ptr allocation failed"
38    EXIT
39  ENDIF
40ENDDO
41
42ALLOCATE(foo_obj, stat = istat)
43IF (istat .NE. 0) THEN
44  PRINT *, "foo_obj allocation failed"
45ENDIF
46
47ALLOCATE(foo_array(5), stat = istat)
48IF (istat .NE. 0) THEN
49  PRINT *, "foo_array allocation failed"
50ENDIF
51
52END
53! { dg-output " *foo_ptr allocation failed(\n|\r\n|\r)" }
54! { dg-output " *foo_obj allocation failed(\n|\r\n|\r)" }
55! { dg-output " *foo_array allocation failed(\n|\r\n|\r)" }
56