2 ! { dg-additional-options "-fdump-tree-original" }
3 ! PR fortran/91300 - runtime error message with allocate and errmsg=
4 ! Contributed by zed.three
7 use, intrinsic :: iso_c_binding
, only
: C_INTPTR_T
9 real(4), dimension(:), allocatable
:: array
, bigarray
10 integer :: stat1
, stat2
11 character(len
=100) :: errmsg1
, errmsg2
12 character(*), parameter :: no_error
= "no error"
13 integer(8), parameter :: n1
= huge (1_4) / 3 ! request more than 2GB
14 integer(8), parameter :: n2
= huge (1_C_INTPTR_T
) / 4 ! "safe" for 64bit
15 integer(8), parameter :: bignumber
= max (n1
, n2
)
21 allocate (array(1), stat
=stat1
, errmsg
=errmsg1
)
22 if (stat1
/= 0 ) stop 1
23 if (errmsg1
/= no_error
) stop 1
25 ! Obtain stat, errmsg for attempt to allocate an allocated object
26 allocate (array(1), stat
=stat1
, errmsg
=errmsg1
)
27 if (stat1
== 0 ) stop 2
28 if (errmsg1
== no_error
) stop 2
30 ! Try to allocate very large object
31 allocate (bigarray(bignumber
), stat
=stat2
, errmsg
=errmsg2
)
33 print *, "stat1 =", stat1
34 print *, "errmsg: ", trim (errmsg1
)
35 print *, "stat2 =", stat2
36 print *, "errmsg: ", trim (errmsg2
)
37 ! Ensure different results for stat, errmsg variables (all compilers)
38 if (stat2
== stat1
) stop 3
39 if (errmsg2
== no_error
.or
. errmsg2
== errmsg1
) stop 4
41 ! Finally verify gfortran-specific error messages
42 if (errmsg1
/= "Attempt to allocate an allocated object") stop 5
43 if (errmsg2
/= "Insufficient virtual memory" ) stop 6
46 end program bigarray_prog
48 ! { dg-final { scan-tree-dump-times "Attempt to allocate an allocated object" 4 "original" } }
49 ! { dg-final { scan-tree-dump-times "Insufficient virtual memory" 4 "original" } }