! Start of test program.
!
program test
+ use ISO_C_BINDING, only: C_NULL_PTR, C_SIZEOF
+
interface
subroutine do_test (lb, ub)
integer*4, dimension (:) :: lb
integer, parameter :: b1_o = 127 + 2
integer, parameter :: b2 = 32767 - 10
integer, parameter :: b2_o = 32767 + 3
- integer*8, parameter :: b4 = 2147483647 - 10
- integer*8, parameter :: b4_o = 2147483647 + 5
+
+ ! This tests the GDB overflow behavior when using a KIND parameter too small
+ ! to hold the actual output argument. This is done for 1, 2, and 4 byte
+ ! overflow. On 32-bit machines most compilers will complain when trying to
+ ! allocate an array with ranges outside the 4 byte integer range.
+ ! We take the byte size of a C pointer as indication as to whether or not we
+ ! are on a 32 bit machine an skip the 4 byte overflow tests in that case.
+ integer, parameter :: bytes_c_ptr = C_SIZEOF(C_NULL_PTR)
+
+ integer*8, parameter :: max_signed_4byte_int = 2147483647
+ integer*8, parameter :: b4 = max_signed_4byte_int - 10
+ integer*8 :: b4_o
+ logical :: is_64_bit
integer, allocatable :: array_1d_1bytes_overflow (:)
integer, allocatable :: array_1d_2bytes_overflow (:)
integer, allocatable :: array_2d_2bytes_overflow (:,:)
integer, allocatable :: array_3d_1byte_overflow (:,:,:)
+ ! Set the 4 byte overflow only on 64 bit machines.
+ if (bytes_c_ptr < 8) then
+ b4_o = 0
+ is_64_bit = .FALSE.
+ else
+ b4_o = max_signed_4byte_int + 5
+ is_64_bit = .TRUE.
+ end if
+
! Allocate or associate any variables as needed.
allocate (other (-5:4, -2:7))
pointer2d => tarray
allocate (array_1d_1bytes_overflow (-b1_o:-b1))
allocate (array_1d_2bytes_overflow (b2:b2_o))
- allocate (array_1d_4bytes_overflow (-b4_o:-b4))
-
+ if (is_64_bit) then
+ allocate (array_1d_4bytes_overflow (-b4_o:-b4))
+ end if
allocate (array_2d_1byte_overflow (-b1_o:-b1,b1:b1_o))
allocate (array_2d_2bytes_overflow (b2:b2_o,-b2_o:b2))
DO_TEST (array_1d_1bytes_overflow)
DO_TEST (array_1d_2bytes_overflow)
- DO_TEST (array_1d_4bytes_overflow)
+ if (is_64_bit) then
+ DO_TEST (array_1d_4bytes_overflow)
+ end if
DO_TEST (array_2d_1byte_overflow)
DO_TEST (array_2d_2bytes_overflow)
DO_TEST (array_3d_1byte_overflow)
deallocate (array_2d_2bytes_overflow)
deallocate (array_2d_1byte_overflow)
- deallocate (array_1d_4bytes_overflow)
+ if (is_64_bit) then
+ deallocate (array_1d_4bytes_overflow)
+ end if
deallocate (array_1d_2bytes_overflow)
deallocate (array_1d_1bytes_overflow)
gdb_test "p ubound(array_1d_2bytes_overflow, 1, 2)" "= -32766"
gdb_test "p ubound(array_1d_2bytes_overflow, 1, 4)" "= 32770"
-gdb_test "p lbound(array_1d_4bytes_overflow, 1, 4)" "= 2147483644"
-gdb_test "p lbound(array_1d_4bytes_overflow, 1, 8)" "= -2147483652"
-gdb_test "p ubound(array_1d_4bytes_overflow, 1, 4)" "= -2147483637"
-gdb_test "p lbound(array_1d_4bytes_overflow)" "= \\(2147483644\\)"
+# On 32-bit machines most compilers will complain when trying to allocate an
+# array with ranges outside the 4 byte integer range. As the behavior is
+# compiler implementation dependent, we do not run these test on 32 bit targets.
+if {[is_64_target]} {
+ gdb_test "p lbound(array_1d_4bytes_overflow, 1, 4)" "= 2147483644"
+ gdb_test "p lbound(array_1d_4bytes_overflow, 1, 8)" "= -2147483652"
+ gdb_test "p ubound(array_1d_4bytes_overflow, 1, 4)" "= -2147483637"
+ gdb_test "p lbound(array_1d_4bytes_overflow)" "= \\(2147483644\\)"
+}
# Ensure we reached the final breakpoint. If more tests have been added
# to the test script, and this starts failing, then the safety 'while'
! Start of test program.
!
program test
+ use ISO_C_BINDING, only: C_NULL_PTR, C_SIZEOF
! Things to perform tests on.
integer, target :: array_1d (1:10) = 0
integer, parameter :: b1_o = 127 + 1
integer, parameter :: b2_o = 32767 + 3
- integer*8, parameter :: b4_o = 2147483647 + 5
+
+ ! This test tests the GDB overflow behavior when using a KIND parameter
+ ! too small to hold the actual output argument. This is done for 1, 2, and
+ ! 4 byte overflow. On 32-bit machines most compilers will complain when
+ ! trying to allocate an array with ranges outside the 4 byte integer range.
+ ! We take the byte size of a C pointer as indication as to whether or not we
+ ! are on a 32 bit machine an skip the 4 byte overflow tests in that case.
+ integer, parameter :: bytes_c_ptr = C_SIZEOF(C_NULL_PTR)
+ integer*8, parameter :: max_signed_4byte_int = 2147483647
+ integer*8 :: b4_o
+ logical :: is_64_bit
integer, allocatable :: array_1d_1byte_overflow (:)
integer, allocatable :: array_1d_2bytes_overflow (:)
! Loop counters.
integer :: s1, s2
+ ! Set the 4 byte overflow only on 64 bit machines.
+ if (bytes_c_ptr < 8) then
+ b4_o = 0
+ is_64_bit = .FALSE.
+ else
+ b4_o = max_signed_4byte_int + 5
+ is_64_bit = .TRUE.
+ end if
+
allocate (array_1d_1byte_overflow (1:b1_o))
allocate (array_1d_2bytes_overflow (1:b2_o))
- allocate (array_1d_4bytes_overflow (1:b4_o))
-
+ if (is_64_bit) then
+ allocate (array_1d_4bytes_overflow (b4_o-b2_o:b4_o))
+ end if
allocate (array_2d_1byte_overflow (1:b1_o, 1:b1_o))
- allocate (array_2d_2bytes_overflow (1:b2_o, 1:b2_o))
+ allocate (array_2d_2bytes_overflow (b2_o-b1_o:b2_o, b2_o-b1_o:b2_o))
allocate (array_3d_1byte_overflow (1:b1_o, 1:b1_o, 1:b1_o))
call test_size_4 (size (array_1d_1byte_overflow, 1))
call test_size_4 (size (array_1d_2bytes_overflow, 1))
- call test_size_4 (size (array_1d_4bytes_overflow))
- call test_size_4 (size (array_1d_4bytes_overflow, 1))
+ if (is_64_bit) then
+ call test_size_4 (size (array_1d_4bytes_overflow))
+ call test_size_4 (size (array_1d_4bytes_overflow, 1))
+ end if
call test_size_4 (size (array_2d_1byte_overflow, 1))
call test_size_4 (size (array_2d_1byte_overflow, 2))
call test_size_1 (size (array_1d_1byte_overflow, 1, 1))
call test_size_1 (size (array_1d_2bytes_overflow, 1, 1))
- call test_size_1 (size (array_1d_4bytes_overflow, 1, 1))
+ if (is_64_bit) then
+ call test_size_1 (size (array_1d_4bytes_overflow, 1, 1))
+ end if
call test_size_1 (size (array_2d_1byte_overflow, 1, 1))
call test_size_1 (size (array_2d_1byte_overflow, 2, 1))
! Kind 2.
call test_size_2 (size (array_1d_1byte_overflow, 1, 2))
call test_size_2 (size (array_1d_2bytes_overflow, 1, 2))
- call test_size_2 (size (array_1d_4bytes_overflow, 1, 2))
+ if (is_64_bit) then
+ call test_size_2 (size (array_1d_4bytes_overflow, 1, 2))
+ end if
call test_size_2 (size (array_2d_1byte_overflow, 1, 2))
call test_size_2 (size (array_2d_1byte_overflow, 2, 2))
! Kind 4.
call test_size_4 (size (array_1d_1byte_overflow, 1, 4))
call test_size_4 (size (array_1d_2bytes_overflow, 1, 4))
- call test_size_4 (size (array_1d_4bytes_overflow, 1, 4))
+ if (is_64_bit) then
+ call test_size_4 (size (array_1d_4bytes_overflow, 1, 4))
+ end if
call test_size_4 (size (array_2d_1byte_overflow, 1, 4))
call test_size_4 (size (array_2d_1byte_overflow, 2, 4))
! Kind 8.
call test_size_8 (size (array_1d_1byte_overflow, 1, 8))
call test_size_8 (size (array_1d_2bytes_overflow, 1, 8))
- call test_size_8 (size (array_1d_4bytes_overflow, 1, 8))
+ if (is_64_bit) then
+ call test_size_8 (size (array_1d_4bytes_overflow, 1, 8))
+ end if
call test_size_8 (size (array_2d_1byte_overflow, 1, 8))
call test_size_8 (size (array_2d_1byte_overflow, 2, 8))
deallocate (array_2d_2bytes_overflow)
deallocate (array_2d_1byte_overflow)
- deallocate (array_1d_4bytes_overflow)
+ if (is_64_bit) then
+ deallocate (array_1d_4bytes_overflow)
+ end if
deallocate (array_1d_2bytes_overflow)
deallocate (array_1d_1byte_overflow)