public inbox for gcc-bugs@sourceware.org
help / color / mirror / Atom feed
* [Bug fortran/113471] New: [14 regression] wrong array bound check failure on valid code
@ 2024-01-18  9:34 juergen.reuter at desy dot de
  2024-01-18 10:49 ` [Bug fortran/113471] " rguenth at gcc dot gnu.org
                   ` (6 more replies)
  0 siblings, 7 replies; 8+ messages in thread
From: juergen.reuter at desy dot de @ 2024-01-18  9:34 UTC (permalink / raw)
  To: gcc-bugs

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

^ permalink raw reply	[flat|nested] 8+ messages in thread
end of thread, other threads:[~2024-01-19 22:14 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-01-18  9:34 [Bug fortran/113471] New: [14 regression] wrong array bound check failure on valid code juergen.reuter at desy dot de
2024-01-18 10:49 ` [Bug fortran/113471] " rguenth at gcc dot gnu.org
2024-01-18 18:02 ` anlauf at gcc dot gnu.org
2024-01-18 19:44 ` anlauf at gcc dot gnu.org
2024-01-18 22:12 ` juergen.reuter at desy dot de
2024-01-18 22:19 ` anlauf at gcc dot gnu.org
2024-01-19 20:24 ` cvs-commit at gcc dot gnu.org
2024-01-19 22:14 ` anlauf at gcc dot gnu.org

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).