gcc/testsuite/gfortran.dg/pr68078.f90

   1 ! { dg-do run { target 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
  13 USE :: ISO_C_BINDING !, only: C_INT
  14 IMPLICIT NONE
  15
  16 INTERFACE
  17   SUBROUTINE set_vm_limit(n) bind(C)
  18   import
  19   integer(C_INT), value, intent(in) :: n
  20   END SUBROUTINE set_vm_limit
  21 END INTERFACE
  22
  23 TYPE foo
  24   INTEGER, DIMENSION(10000) :: data = 42
  25 END TYPE
  26 TYPE(foo), POINTER :: foo_ptr
  27 TYPE(foo), ALLOCATABLE :: foo_obj
  28 TYPE(foo), ALLOCATABLE, DIMENSION(:) :: foo_array
  29
  30 INTEGER istat
  31
  32 CALL set_vm_limit(1000000)
  33
  34 DO
  35   ALLOCATE(foo_ptr, stat = istat)
  36   IF (istat .NE. 0) THEN
  37     PRINT *, "foo_ptr allocation failed"
  38     EXIT
  39   ENDIF
  40 ENDDO
  41
  42 ALLOCATE(foo_obj, stat = istat)
  43 IF (istat .NE. 0) THEN
  44   PRINT *, "foo_obj allocation failed"
  45 ENDIF
  46
  47 ALLOCATE(foo_array(5), stat = istat)
  48 IF (istat .NE. 0) THEN
  49   PRINT *, "foo_array allocation failed"
  50 ENDIF
  51
  52 END
  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)" }