https://gcc.gnu.org/bugzilla/show_bug.cgi?id=113471
Bug ID: 113471
Summary: [14 regression] wrong array bound check failure on
valid code
Product: gcc
Version: 14.0
Status: UNCONFIRMED
Severity: normal
Priority: P3
Component: fortran
Assignee: unassigned at gcc dot gnu.org
Reporter: juergen.reuter at desy dot de
Target Milestone: ---
Created attachment 57136
--> https://gcc.gnu.org/bugzilla/attachment.cgi?id=57136&action=edit
Reproducer, 154 lines
Very likely in the time period between March and late fall 2023 a regression
appeared with flags in the following reproducer a Fortran runtime error
(invalidly, I'd say):
Fortran runtime error: Index '3' of dimension 1 of array 'cc' outside of
expected range (1:2)
The code is here and attached, needs to be compiled with -fcheck=all or
-fcheck=bounds:
module cs
implicit none
type :: c_t
integer, dimension(2) :: c1 = 0, c2 = 0
contains
generic :: init => &
c_init_trivial, &
c_init_array, &
c_init_arrays
procedure, private :: c_init_trivial
procedure, private :: c_init_array
procedure, private :: c_init_arrays
procedure :: init_col_acl => c_init_col_acl
procedure :: add_offset => c_add_offset
generic :: operator(.merge.) => merge_cs
procedure, private :: merge_cs
end type c_t
contains
pure subroutine c_init_trivial (col)
class(c_t), intent(inout) :: col
col%c1 = 0
col%c2 = 0
end subroutine c_init_trivial
pure subroutine c_init_array (col, c1)
class(c_t), intent(inout) :: col
integer, dimension(:), intent(in) :: c1
col%c1 = pack (c1, c1 /= 0, [0,0])
col%c2 = col%c1
end subroutine c_init_array
pure subroutine c_init_arrays (col, c1, c2)
class(c_t), intent(inout) :: col
integer, dimension(:), intent(in) :: c1, c2
if (size (c1) == size (c2)) then
col%c1 = pack (c1, c1 /= 0, [0,0])
col%c2 = pack (c2, c2 /= 0, [0,0])
else if (size (c1) /= 0) then
col%c1 = pack (c1, c1 /= 0, [0,0])
col%c2 = col%c1
else if (size (c2) /= 0) then
col%c1 = pack (c2, c2 /= 0, [0,0])
col%c2 = col%c1
end if
end subroutine c_init_arrays
elemental subroutine c_init_col_acl (col, col_in, acl_in)
class(c_t), intent(inout) :: col
integer, intent(in) :: col_in, acl_in
integer, dimension(0) :: null_array
select case (col_in)
case (0)
select case (acl_in)
case (0)
call c_init_array (col, null_array)
case default
call c_init_array (col, [-acl_in])
end select
case default
select case (acl_in)
case (0)
call c_init_array (col, [col_in])
case default
call c_init_array (col, [col_in, -acl_in])
end select
end select
end subroutine c_init_col_acl
elemental subroutine c_add_offset (col, offset)
class(c_t), intent(inout) :: col
integer, intent(in) :: offset
where (col%c1 /= 0) col%c1 = col%c1 + sign (offset, col%c1)
where (col%c2 /= 0) col%c2 = col%c2 + sign (offset, col%c2)
end subroutine c_add_offset
elemental function merge_cs (col1, col2) result (col)
type(c_t) :: col
class(c_t), intent(in) :: col1, col2
call c_init_arrays (col, col1%c1, col2%c1)
end function merge_cs
function count_c_loops (col) result (count)
integer :: count
type(c_t), dimension(:), intent(in) :: col
type(c_t), dimension(size(col)) :: cc
integer :: i, n, offset, ii
cc = col
n = size (cc)
offset = n
call c_add_offset (cc, offset)
count = 0
SCAN_LOOPS: do
do i = 1, n
if (any (cc(i)%c1 > offset)) then
count = count + 1
ii = pick_new_line (cc(i)%c1, count, 1)
cycle SCAN_LOOPS
end if
end do
exit SCAN_LOOPS
end do SCAN_LOOPS
contains
function pick_new_line (c, reset_val, sgn) result (line)
integer :: line
integer, dimension(:), intent(inout) :: c
integer, intent(in) :: reset_val
integer, intent(in) :: sgn
integer :: i
if (any (c == count)) then
line = count
else
do i = 1, size (c)
if (sign (1, c(i)) == sgn .and. abs (c(i)) > offset) then
line = c(i)
c(i) = reset_val
return
end if
end do
end if
end function pick_new_line
end function count_c_loops
end module cs
module cs_uti
use cs
implicit none
private
public :: c_1
contains
subroutine c_1 (u)
integer, intent(in) :: u
type(c_t), dimension(4) :: col1, col2, col
type(c_t), dimension(:), allocatable :: col3
type(c_t), dimension(:,:), allocatable :: col_array
integer :: count, i
call col1%init_col_acl ([1, 0, 2, 3], [0, 1, 3, 2])
col2 = col1
col = col1 .merge. col2
count = count_c_loops (col)
end subroutine c_1
end module cs_uti
program main_ut
use cs_uti, only: c_1
implicit none
call c_1 (6)
end program main_ut
