mirror of
https://sourceware.org/git/binutils-gdb.git
synced 2025-02-05 12:53:16 +08:00
9bde221fec
gdb.fortran/array-slices.exp and gdb.fortran/lbound-ubound.exp were recently disabled unless testing with the native target, because they rely on inferior I/O. However, when testing against gdbserver using the native-gdbserver/native-extended-gdbserver boards, we do have access to inferior I/O. The right way to check whether the board can do I/O, is via checking the gdb,noinferiorio board variable. Switch to using that. And then, tweak the testcases to expect output to appear in inferior_spawn_id, instead of gdb_spawn_id. When testing against the native target, inferior_spawn_id is the same as gdb_spawn_id. When testing against gdbserver, it maps to gdbserver_spawn_id. This exposed a buglet in gdb.fortran/array-slices.f90's show_1d subroutine -- it was missing printing newline at the end of the "Expected GDB Output" text, leading to a test timeout. All other subroutines end with advance=yes, except this one. Fix it by using advance=yes here too. Change-Id: I4640729f334431cfc24b0917e7d3977b677c6ca5
381 lines
11 KiB
Fortran
381 lines
11 KiB
Fortran
! Copyright 2019-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/>.
|
|
|
|
subroutine show_elem (array)
|
|
integer :: array
|
|
|
|
print *, ""
|
|
print *, "Expected GDB Output:"
|
|
print *, ""
|
|
|
|
write(*, fmt="(A)", advance="no") "GDB = "
|
|
write(*, fmt="(I0)", advance="no") array
|
|
write(*, fmt="(A)", advance="yes") ""
|
|
|
|
print *, "" ! Display Element
|
|
end subroutine show_elem
|
|
|
|
subroutine show_str (array)
|
|
character (len=*) :: array
|
|
|
|
print *, ""
|
|
print *, "Expected GDB Output:"
|
|
print *, ""
|
|
write (*, fmt="(A)", advance="no") "GDB = '"
|
|
write (*, fmt="(A)", advance="no") array
|
|
write (*, fmt="(A)", advance="yes") "'"
|
|
|
|
print *, "" ! Display String
|
|
end subroutine show_str
|
|
|
|
subroutine show_1d (array)
|
|
integer, dimension (:) :: array
|
|
|
|
print *, "Array Contents:"
|
|
print *, ""
|
|
|
|
do i=LBOUND (array, 1), UBOUND (array, 1), 1
|
|
write(*, fmt="(i4)", advance="no") array (i)
|
|
end do
|
|
|
|
print *, ""
|
|
print *, "Expected GDB Output:"
|
|
print *, ""
|
|
|
|
write(*, fmt="(A)", advance="no") "GDB = ("
|
|
do i=LBOUND (array, 1), UBOUND (array, 1), 1
|
|
if (i > LBOUND (array, 1)) then
|
|
write(*, fmt="(A)", advance="no") ", "
|
|
end if
|
|
write(*, fmt="(I0)", advance="no") array (i)
|
|
end do
|
|
write(*, fmt="(A)", advance="yes") ")"
|
|
|
|
print *, "" ! Display Array Slice 1D
|
|
end subroutine show_1d
|
|
|
|
subroutine show_2d (array)
|
|
integer, dimension (:,:) :: array
|
|
|
|
print *, "Array Contents:"
|
|
print *, ""
|
|
|
|
do i=LBOUND (array, 2), UBOUND (array, 2), 1
|
|
do j=LBOUND (array, 1), UBOUND (array, 1), 1
|
|
write(*, fmt="(i4)", advance="no") array (j, i)
|
|
end do
|
|
print *, ""
|
|
end do
|
|
|
|
print *, ""
|
|
print *, "Expected GDB Output:"
|
|
print *, ""
|
|
|
|
write(*, fmt="(A)", advance="no") "GDB = ("
|
|
do i=LBOUND (array, 2), UBOUND (array, 2), 1
|
|
if (i > LBOUND (array, 2)) then
|
|
write(*, fmt="(A)", advance="no") " "
|
|
end if
|
|
write(*, fmt="(A)", advance="no") "("
|
|
do j=LBOUND (array, 1), UBOUND (array, 1), 1
|
|
if (j > LBOUND (array, 1)) then
|
|
write(*, fmt="(A)", advance="no") ", "
|
|
end if
|
|
write(*, fmt="(I0)", advance="no") array (j, i)
|
|
end do
|
|
write(*, fmt="(A)", advance="no") ")"
|
|
end do
|
|
write(*, fmt="(A)", advance="yes") ")"
|
|
|
|
print *, "" ! Display Array Slice 2D
|
|
end subroutine show_2d
|
|
|
|
subroutine show_3d (array)
|
|
integer, dimension (:,:,:) :: array
|
|
|
|
print *, ""
|
|
print *, "Expected GDB Output:"
|
|
print *, ""
|
|
|
|
write(*, fmt="(A)", advance="no") "GDB = ("
|
|
do i=LBOUND (array, 3), UBOUND (array, 3), 1
|
|
if (i > LBOUND (array, 3)) then
|
|
write(*, fmt="(A)", advance="no") " "
|
|
end if
|
|
write(*, fmt="(A)", advance="no") "("
|
|
do j=LBOUND (array, 2), UBOUND (array, 2), 1
|
|
if (j > LBOUND (array, 2)) then
|
|
write(*, fmt="(A)", advance="no") " "
|
|
end if
|
|
write(*, fmt="(A)", advance="no") "("
|
|
do k=LBOUND (array, 1), UBOUND (array, 1), 1
|
|
if (k > LBOUND (array, 1)) then
|
|
write(*, fmt="(A)", advance="no") ", "
|
|
end if
|
|
write(*, fmt="(I0)", advance="no") array (k, j, i)
|
|
end do
|
|
write(*, fmt="(A)", advance="no") ")"
|
|
end do
|
|
write(*, fmt="(A)", advance="no") ")"
|
|
end do
|
|
write(*, fmt="(A)", advance="yes") ")"
|
|
|
|
print *, "" ! Display Array Slice 3D
|
|
end subroutine show_3d
|
|
|
|
subroutine show_4d (array)
|
|
integer, dimension (:,:,:,:) :: array
|
|
|
|
print *, ""
|
|
print *, "Expected GDB Output:"
|
|
print *, ""
|
|
|
|
write(*, fmt="(A)", advance="no") "GDB = ("
|
|
do i=LBOUND (array, 4), UBOUND (array, 4), 1
|
|
if (i > LBOUND (array, 4)) then
|
|
write(*, fmt="(A)", advance="no") " "
|
|
end if
|
|
write(*, fmt="(A)", advance="no") "("
|
|
do j=LBOUND (array, 3), UBOUND (array, 3), 1
|
|
if (j > LBOUND (array, 3)) then
|
|
write(*, fmt="(A)", advance="no") " "
|
|
end if
|
|
write(*, fmt="(A)", advance="no") "("
|
|
|
|
do k=LBOUND (array, 2), UBOUND (array, 2), 1
|
|
if (k > LBOUND (array, 2)) then
|
|
write(*, fmt="(A)", advance="no") " "
|
|
end if
|
|
write(*, fmt="(A)", advance="no") "("
|
|
do l=LBOUND (array, 1), UBOUND (array, 1), 1
|
|
if (l > LBOUND (array, 1)) then
|
|
write(*, fmt="(A)", advance="no") ", "
|
|
end if
|
|
write(*, fmt="(I0)", advance="no") array (l, k, j, i)
|
|
end do
|
|
write(*, fmt="(A)", advance="no") ")"
|
|
end do
|
|
write(*, fmt="(A)", advance="no") ")"
|
|
end do
|
|
write(*, fmt="(A)", advance="no") ")"
|
|
end do
|
|
write(*, fmt="(A)", advance="yes") ")"
|
|
|
|
print *, "" ! Display Array Slice 4D
|
|
end subroutine show_4d
|
|
|
|
!
|
|
! Start of test program.
|
|
!
|
|
program test
|
|
interface
|
|
subroutine show_str (array)
|
|
character (len=*) :: array
|
|
end subroutine show_str
|
|
|
|
subroutine show_1d (array)
|
|
integer, dimension (:) :: array
|
|
end subroutine show_1d
|
|
|
|
subroutine show_2d (array)
|
|
integer, dimension(:,:) :: array
|
|
end subroutine show_2d
|
|
|
|
subroutine show_3d (array)
|
|
integer, dimension(:,:,:) :: array
|
|
end subroutine show_3d
|
|
|
|
subroutine show_4d (array)
|
|
integer, dimension(:,:,:,:) :: array
|
|
end subroutine show_4d
|
|
end interface
|
|
|
|
! Declare variables used in this test.
|
|
integer, dimension (-10:-1,-10:-2) :: neg_array
|
|
integer, dimension (1:10,1:10) :: array
|
|
integer, allocatable :: other (:, :)
|
|
character (len=26) :: str_1 = "abcdefghijklmnopqrstuvwxyz"
|
|
integer, dimension (-2:2,-2:2,-2:2) :: array3d
|
|
integer, dimension (-3:3,7:10,-3:3,-10:-7) :: array4d
|
|
integer, dimension (10:20) :: array1d
|
|
integer, dimension(:,:), pointer :: pointer2d => null()
|
|
integer, dimension(-1:9,-1:9), target :: tarray
|
|
|
|
! Allocate or associate any variables as needed.
|
|
allocate (other (-5:4, -2:7))
|
|
pointer2d => tarray
|
|
|
|
! Fill arrays with contents ready for testing.
|
|
call fill_array_1d (array1d)
|
|
|
|
call fill_array_2d (neg_array)
|
|
call fill_array_2d (array)
|
|
call fill_array_2d (other)
|
|
call fill_array_2d (tarray)
|
|
|
|
call fill_array_3d (array3d)
|
|
call fill_array_4d (array4d)
|
|
|
|
! The tests. Each call to a show_* function must have a unique set
|
|
! of arguments as GDB uses the arguments are part of the test name
|
|
! string, so duplicate arguments will result in duplicate test
|
|
! names.
|
|
!
|
|
! If a show_* line ends with VARS=... where '...' is a comma
|
|
! separated list of variable names, these variables are assumed to
|
|
! be part of the call line, and will be expanded by the test script,
|
|
! for example:
|
|
!
|
|
! do x=1,9,1
|
|
! do y=x,10,1
|
|
! call show_1d (some_array (x,y)) ! VARS=x,y
|
|
! end do
|
|
! end do
|
|
!
|
|
! In this example the test script will automatically expand 'x' and
|
|
! 'y' in order to better test different aspects of GDB. Do take
|
|
! care, the expansion is not very "smart", so try to avoid clashing
|
|
! with other text on the line, in the example above, avoid variables
|
|
! named 'some' or 'array', as these will likely clash with
|
|
! 'some_array'.
|
|
call show_str (str_1)
|
|
call show_str (str_1 (1:20))
|
|
call show_str (str_1 (10:20))
|
|
|
|
call show_elem (array1d (11))
|
|
call show_elem (pointer2d (2,3))
|
|
|
|
call show_1d (array1d)
|
|
call show_1d (array1d (13:17))
|
|
call show_1d (array1d (17:13:-1))
|
|
call show_1d (array (1:5,1))
|
|
call show_1d (array4d (1,7,3,:))
|
|
call show_1d (pointer2d (-1:3, 2))
|
|
call show_1d (pointer2d (-1, 2:4))
|
|
|
|
! Enclosing the array slice argument in (...) causess gfortran to
|
|
! repack the array.
|
|
call show_1d ((array (1:5,1)))
|
|
|
|
call show_2d (pointer2d)
|
|
call show_2d (array)
|
|
call show_2d (array (1:5,1:5))
|
|
do i=1,10,2
|
|
do j=1,10,3
|
|
call show_2d (array (1:10:i,1:10:j)) ! VARS=i,j
|
|
call show_2d (array (10:1:-i,1:10:j)) ! VARS=i,j
|
|
call show_2d (array (10:1:-i,10:1:-j)) ! VARS=i,j
|
|
call show_2d (array (1:10:i,10:1:-j)) ! VARS=i,j
|
|
end do
|
|
end do
|
|
call show_2d (array (6:2:-1,3:9))
|
|
call show_2d (array (1:10:2, 1:10:2))
|
|
call show_2d (other)
|
|
call show_2d (other (-5:0, -2:0))
|
|
call show_2d (other (-5:4:2, -2:7:3))
|
|
call show_2d (neg_array)
|
|
call show_2d (neg_array (-10:-3,-8:-4:2))
|
|
|
|
! Enclosing the array slice argument in (...) causess gfortran to
|
|
! repack the array.
|
|
call show_2d ((array (1:10:3, 1:10:2)))
|
|
call show_2d ((neg_array (-10:-3,-8:-4:2)))
|
|
|
|
call show_3d (array3d)
|
|
call show_3d (array3d(-1:1,-1:1,-1:1))
|
|
call show_3d (array3d(1:-1:-1,1:-1:-1,1:-1:-1))
|
|
|
|
! Enclosing the array slice argument in (...) causess gfortran to
|
|
! repack the array.
|
|
call show_3d ((array3d(1:-1:-1,1:-1:-1,1:-1:-1)))
|
|
|
|
call show_4d (array4d)
|
|
call show_4d (array4d (-3:0,10:7:-1,0:3,-7:-10:-1))
|
|
call show_4d (array4d (3:0:-1, 10:7:-1, :, -7:-10:-1))
|
|
|
|
! Enclosing the array slice argument in (...) causess gfortran to
|
|
! repack the array.
|
|
call show_4d ((array4d (3:-2:-2, 10:7:-2, :, -7:-10:-1)))
|
|
|
|
! All done. Deallocate.
|
|
deallocate (other)
|
|
|
|
! GDB catches this final breakpoint to indicate the end of the test.
|
|
print *, "" ! Final Breakpoint.
|
|
|
|
contains
|
|
|
|
! Fill a 1D array with a unique positive integer in each element.
|
|
subroutine fill_array_1d (array)
|
|
integer, dimension (:) :: array
|
|
integer :: counter
|
|
|
|
counter = 1
|
|
do j=LBOUND (array, 1), UBOUND (array, 1), 1
|
|
array (j) = counter
|
|
counter = counter + 1
|
|
end do
|
|
end subroutine fill_array_1d
|
|
|
|
! Fill a 2D array with a unique positive integer in each element.
|
|
subroutine fill_array_2d (array)
|
|
integer, dimension (:,:) :: array
|
|
integer :: counter
|
|
|
|
counter = 1
|
|
do i=LBOUND (array, 2), UBOUND (array, 2), 1
|
|
do j=LBOUND (array, 1), UBOUND (array, 1), 1
|
|
array (j,i) = counter
|
|
counter = counter + 1
|
|
end do
|
|
end do
|
|
end subroutine fill_array_2d
|
|
|
|
! Fill a 3D array with a unique positive integer in each element.
|
|
subroutine fill_array_3d (array)
|
|
integer, dimension (:,:,:) :: array
|
|
integer :: counter
|
|
|
|
counter = 1
|
|
do i=LBOUND (array, 3), UBOUND (array, 3), 1
|
|
do j=LBOUND (array, 2), UBOUND (array, 2), 1
|
|
do k=LBOUND (array, 1), UBOUND (array, 1), 1
|
|
array (k, j,i) = counter
|
|
counter = counter + 1
|
|
end do
|
|
end do
|
|
end do
|
|
end subroutine fill_array_3d
|
|
|
|
! Fill a 4D array with a unique positive integer in each element.
|
|
subroutine fill_array_4d (array)
|
|
integer, dimension (:,:,:,:) :: array
|
|
integer :: counter
|
|
|
|
counter = 1
|
|
do i=LBOUND (array, 4), UBOUND (array, 4), 1
|
|
do j=LBOUND (array, 3), UBOUND (array, 3), 1
|
|
do k=LBOUND (array, 2), UBOUND (array, 2), 1
|
|
do l=LBOUND (array, 1), UBOUND (array, 1), 1
|
|
array (l, k, j,i) = counter
|
|
counter = counter + 1
|
|
end do
|
|
end do
|
|
end do
|
|
end do
|
|
print *, ""
|
|
end subroutine fill_array_4d
|
|
end program test
|