forked from Imagelibrary/binutils-gdb
6dc7160b2d
This commit fixes two regressions introduced by
891e4190ba.
Reason for the failures was, that on a 32 bit machine the maximum
array length as well as the maximum allocatable memory for arrays
(in bytes) both seem to be limited by the maximum value of a 4
byte (signed) Fortran integer. This lead to compiler errors/unexpected
behavior when compiling/running the test with the -m32 board. This
behavior is compiler dependent and can differ for different compiler
implementations, but generally, it seemed like a good idea to simply
avoid such situations.
The affected tests check for GDB's overflow behavior when using KIND
parameters with GDB implemented Fortran intrinsic functions. If these
KIND parameters are too small to fit the actual intrinsic function's
result, an overflow is expected. This was done for 1, 2, and 4
byte overflows. The last one caused problems, as it tried to allocate
arrays of length/byte-size bigger than the 4 byte signed integers which
would then be used with the LBOUND/UBOUND/SIZE intrinsics.
The tests were adapted to only execute the 4 byte overflow tests when
running on targets with 64 bit. For this, the compiled tests evaluate the
byte size of a C_NULL_PTR via C_SIZEOF, both defined in the ISO_C_BINDING
module. The ISO_C_BINDING constant C_NULL_PTR is a Fortran 2003, the
C_SIZEOF a Fortran 2008 extension. Both have been implemented in their
respective compilers for while (e.g. C_SIZEOF is available since
gfortran 4.6). If this byte size evaluates to less than 8 we skip the
4 byte overflow tests in the compiled tests of size.f90 and
lbound-ubound.f90. Similarly, in the lbound-ubound.exp testsfile we skip
the 4 byte overflow tests if the procedure is_64_target evaluates to false.
In size.f90, additionally, the to-be-allocated amount of bytes did not
fit into 4 byte signed integers for some of the arrays, as it was
approximately 4 times the maximum size of a 4 byte signed integer. We
adapted the dimensions of the arrays in question as the meaningfulness
of the test does not suffer from this.
With this patch both test run fine with the unix/-m32 board and
gcc/gfortran (9.4) as well as the standard board file.
We also thought about completely removing the affected test from the
testsuite. We decided against this as the 32 bit identification comes
with Fortran 2008 and removing tests would have decreased coverage.
A last change that happened with this patch was due to gfortran's and
ifx's type resolution when assigning big constants to Fortran Integer*8
variables. Before the above changes this happened in a parameter
statement. Here, both compilers happily accepted a line like
integer*8, parameter :: var = 2147483647 + 5.
After this change the assignment is not done as a parameter
anymore, as this triggered compile time overflow errors. Instead,
the assignment is done dynamically, depending on the kind of machine one
is on. Sadly, just changing this line to
integer*8 :: var
var = 2147483647 + 5
does not work with ifx (or flang for that matter, they behave similarly
here). It will create an integer overflow in the addition as ifx deduces
the type the additon is done in as Integer*4. So var will actually
contain the value -2147483644 after this. The lines
integer*8 :: var
var = 2147483652
on the other hand fail to compile with gfortran (9.4.0) as the compiler
identifies an Integer overflow here. Finally, to make this work with
all three compilers an additional parameter has been introduced
integer*8, parameter :: helper = 2147483647
integer*8 :: var
var = helper + 5.
This works on all 3 compilers as expected.
Bug: https://sourceware.org/bugzilla/show_bug.cgi?id=29053
Bug: https://sourceware.org/bugzilla/show_bug.cgi?id=29054
279 lines
9.8 KiB
Fortran
279 lines
9.8 KiB
Fortran
! Copyright 2021-2022 Free Software Foundation, Inc.
|
|
!
|
|
! This program is free software; you can redistribute it and/or modify
|
|
! it under the terms of the GNU General Public License as published by
|
|
! the Free Software Foundation; either version 3 of the License, or
|
|
! (at your option) any later version.
|
|
!
|
|
! This program is distributed in the hope that it will be useful,
|
|
! but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
! GNU General Public License for more details.
|
|
!
|
|
! You should have received a copy of the GNU General Public License
|
|
! along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
!
|
|
! 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, target :: array_2d (1:4, 1:3) = 0
|
|
integer :: an_integer = 0
|
|
real :: a_real = 0.0
|
|
integer, pointer :: array_1d_p (:) => null ()
|
|
integer, pointer :: array_2d_p (:,:) => null ()
|
|
integer, allocatable :: allocatable_array_1d (:)
|
|
integer, allocatable :: allocatable_array_2d (:,:)
|
|
|
|
integer, parameter :: b1_o = 127 + 1
|
|
integer, parameter :: b2_o = 32767 + 3
|
|
|
|
! 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 (:)
|
|
integer, allocatable :: array_1d_4bytes_overflow (:)
|
|
integer, allocatable :: array_2d_1byte_overflow (:,:)
|
|
integer, allocatable :: array_2d_2bytes_overflow (:,:)
|
|
integer, allocatable :: array_3d_1byte_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))
|
|
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 (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))
|
|
|
|
|
|
! The start of the tests.
|
|
call test_size_4 (size (array_1d))
|
|
call test_size_4 (size (array_1d, 1))
|
|
do s1=1, SIZE (array_1d, 1), 1
|
|
call test_size_4 (size (array_1d (1:10:s1)))
|
|
call test_size_4 (size (array_1d (1:10:s1), 1))
|
|
call test_size_4 (size (array_1d (10:1:-s1)))
|
|
call test_size_4 (size (array_1d (10:1:-s1), 1))
|
|
end do
|
|
|
|
do s2=1, SIZE (array_2d, 2), 1
|
|
do s1=1, SIZE (array_2d, 1), 1
|
|
call test_size_4 (size (array_2d (1:4:s1, 1:3:s2)))
|
|
call test_size_4 (size (array_2d (4:1:-s1, 1:3:s2)))
|
|
call test_size_4 (size (array_2d (1:4:s1, 3:1:-s2)))
|
|
call test_size_4 (size (array_2d (4:1:-s1, 3:1:-s2)))
|
|
|
|
call test_size_4 (size (array_2d (1:4:s1, 1:3:s2), 1))
|
|
call test_size_4 (size (array_2d (4:1:-s1, 1:3:s2), 1))
|
|
call test_size_4 (size (array_2d (1:4:s1, 3:1:-s2), 1))
|
|
call test_size_4 (size (array_2d (4:1:-s1, 3:1:-s2), 1))
|
|
|
|
call test_size_4 (size (array_2d (1:4:s1, 1:3:s2), 2))
|
|
call test_size_4 (size (array_2d (4:1:-s1, 1:3:s2), 2))
|
|
call test_size_4 (size (array_2d (1:4:s1, 3:1:-s2), 2))
|
|
call test_size_4 (size (array_2d (4:1:-s1, 3:1:-s2), 2))
|
|
end do
|
|
end do
|
|
|
|
allocate (allocatable_array_1d (-10:-5))
|
|
call test_size_4 (size (allocatable_array_1d))
|
|
do s1=1, SIZE (allocatable_array_1d, 1), 1
|
|
call test_size_4 (size (allocatable_array_1d (-10:-5:s1)))
|
|
call test_size_4 (size (allocatable_array_1d (-5:-10:-s1)))
|
|
|
|
call test_size_4 (size (allocatable_array_1d (-10:-5:s1), 1))
|
|
call test_size_4 (size (allocatable_array_1d (-5:-10:-s1), 1))
|
|
end do
|
|
|
|
allocate (allocatable_array_2d (-3:3, 8:12))
|
|
do s2=1, SIZE (allocatable_array_2d, 2), 1
|
|
do s1=1, SIZE (allocatable_array_2d, 1), 1
|
|
call test_size_4 (size (allocatable_array_2d (-3:3:s1, 8:12:s2)))
|
|
call test_size_4 (size (allocatable_array_2d (3:-3:-s1, 8:12:s2)))
|
|
call test_size_4 (size (allocatable_array_2d (-3:3:s1, 12:8:-s2)))
|
|
call test_size_4 (size (allocatable_array_2d (3:-3:-s1, 12:8:-s2)))
|
|
|
|
call test_size_4 (size (allocatable_array_2d (-3:3:s1, 8:12:s2), 1))
|
|
call test_size_4 (size (allocatable_array_2d (3:-3:-s1, 8:12:s2), 2))
|
|
call test_size_4 (size (allocatable_array_2d (-3:3:s1, 12:8:-s2), 1))
|
|
call test_size_4 (size (allocatable_array_2d (3:-3:-s1, 12:8:-s2), 2))
|
|
end do
|
|
end do
|
|
|
|
array_1d_p => array_1d
|
|
call test_size_4 (size (array_1d_p))
|
|
call test_size_4 (size (array_1d_p, 1))
|
|
|
|
array_2d_p => array_2d
|
|
call test_size_4 (size (array_2d_p))
|
|
call test_size_4 (size (array_2d_p, 1))
|
|
call test_size_4 (size (array_2d_p, 2))
|
|
|
|
! Test kind parameters - compiler requires these to be compile time constant
|
|
! so sadly there cannot be a loop over the kinds 1, 2, 4, 8.
|
|
call test_size_4 (size (array_1d_1byte_overflow))
|
|
call test_size_4 (size (array_1d_2bytes_overflow))
|
|
|
|
call test_size_4 (size (array_1d_1byte_overflow, 1))
|
|
call test_size_4 (size (array_1d_2bytes_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_4 (size (array_2d_2bytes_overflow, 1))
|
|
call test_size_4 (size (array_2d_2bytes_overflow, 2))
|
|
|
|
call test_size_4 (size (array_3d_1byte_overflow, 1))
|
|
call test_size_4 (size (array_3d_1byte_overflow, 2))
|
|
call test_size_4 (size (array_3d_1byte_overflow, 3))
|
|
|
|
! Kind 1.
|
|
|
|
call test_size_1 (size (array_1d_1byte_overflow, 1, 1))
|
|
call test_size_1 (size (array_1d_2bytes_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))
|
|
call test_size_1 (size (array_2d_2bytes_overflow, 1, 1))
|
|
call test_size_1 (size (array_2d_2bytes_overflow, 2, 1))
|
|
|
|
call test_size_1 (size (array_3d_1byte_overflow, 1, 1))
|
|
call test_size_1 (size (array_3d_1byte_overflow, 2, 1))
|
|
call test_size_1 (size (array_3d_1byte_overflow, 3, 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))
|
|
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))
|
|
call test_size_2 (size (array_2d_2bytes_overflow, 1, 2))
|
|
call test_size_2 (size (array_2d_2bytes_overflow, 2, 2))
|
|
|
|
call test_size_2 (size (array_3d_1byte_overflow, 1, 2))
|
|
call test_size_2 (size (array_3d_1byte_overflow, 2, 2))
|
|
call test_size_2 (size (array_3d_1byte_overflow, 3, 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))
|
|
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))
|
|
call test_size_4 (size (array_2d_2bytes_overflow, 1, 4))
|
|
call test_size_4 (size (array_2d_2bytes_overflow, 2, 4))
|
|
|
|
call test_size_4 (size (array_3d_1byte_overflow, 1, 4))
|
|
call test_size_4 (size (array_3d_1byte_overflow, 2, 4))
|
|
call test_size_4 (size (array_3d_1byte_overflow, 3, 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))
|
|
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))
|
|
call test_size_8 (size (array_2d_2bytes_overflow, 1, 8))
|
|
call test_size_8 (size (array_2d_2bytes_overflow, 2, 8))
|
|
|
|
call test_size_8 (size (array_3d_1byte_overflow, 1, 8))
|
|
call test_size_8 (size (array_3d_1byte_overflow, 2, 8))
|
|
call test_size_8 (size (array_3d_1byte_overflow, 3, 8))
|
|
|
|
print *, "" ! Breakpoint before deallocate.
|
|
|
|
deallocate (allocatable_array_1d)
|
|
deallocate (allocatable_array_2d)
|
|
|
|
deallocate (array_3d_1byte_overflow)
|
|
|
|
deallocate (array_2d_2bytes_overflow)
|
|
deallocate (array_2d_1byte_overflow)
|
|
|
|
if (is_64_bit) then
|
|
deallocate (array_1d_4bytes_overflow)
|
|
end if
|
|
deallocate (array_1d_2bytes_overflow)
|
|
deallocate (array_1d_1byte_overflow)
|
|
|
|
array_1d_p => null ()
|
|
array_2d_p => null ()
|
|
|
|
print *, "" ! Final Breakpoint
|
|
print *, an_integer
|
|
print *, a_real
|
|
print *, associated (array_1d_p)
|
|
print *, associated (array_2d_p)
|
|
print *, allocated (allocatable_array_1d)
|
|
print *, allocated (allocatable_array_2d)
|
|
|
|
contains
|
|
subroutine test_size_1 (answer)
|
|
integer*1 :: answer
|
|
|
|
print *, answer ! Test Breakpoint 1
|
|
end subroutine test_size_1
|
|
|
|
subroutine test_size_2 (answer)
|
|
integer*2 :: answer
|
|
|
|
print *, answer ! Test Breakpoint 2
|
|
end subroutine test_size_2
|
|
|
|
subroutine test_size_4 (answer)
|
|
integer*4 :: answer
|
|
|
|
print *, answer ! Test Breakpoint 3
|
|
end subroutine test_size_4
|
|
|
|
subroutine test_size_8 (answer)
|
|
integer*8 :: answer
|
|
|
|
print *, answer ! Test Breakpoint 4
|
|
end subroutine test_size_8
|
|
|
|
end program test
|