https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114001

            Bug ID: 114001
           Summary: is_contiguous considers unlimited polymorphic dummy
                    always as contiguous
           Product: gcc
           Version: 14.0
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
          Assignee: unassigned at gcc dot gnu.org
          Reporter: anlauf at gcc dot gnu.org
  Target Milestone: ---

While discussing pr105868 I found the following issue:

program main
  implicit none
  integer :: i
  integer, target  :: m(10) = [(i,i=1,size(m))]
  integer, pointer :: p(:)
  p => m(1::3)
  print *, "main: is_contiguous (p)=", is_contiguous (p)
  print *, p
  print *
  call sub (p)
contains
  subroutine sub (x)
    class(*), intent(in) :: x(:)
    print *, "sub(1): is_contiguous (x)=", is_contiguous (x)  ! <- always true
    select type (x)
    type is (integer)
       print *, "sub(2): is_contiguous (x)=", is_contiguous (x)
       print *, x
    end select
  end
end

This prints (since gcc-9 when is_contiguous was added):

 main: is_contiguous (p)= F
           1           4           7          10

 sub(1): is_contiguous (x)= T
 sub(2): is_contiguous (x)= F
           1           4           7          10

The dump-tree clearly has:

      _gfortran_transfer_character_write (&dt_parm.4, &"sub(1): is_contiguous
(x)="[1]{lb: 1 sz: 1}, 26);
      {
        static logical(kind=4) C.4341 = 1;

        _gfortran_transfer_logical_write (&dt_parm.4, &C.4341, 4);
      }

So we aren't actually testing the argument outside the select type block,
whereas:

              _gfortran_transfer_character_write (&dt_parm.5, &"sub(2):
is_contiguous (x)="[1]{lb: 1 sz: 1}, 26);
              {
                struct array01_integer(kind=4) D.4353;
                logical(kind=4) D.4354;

                D.4353 = __tmp_INTEGER_4;
                D.4354 = D.4353.dim[0].stride == 1;
                _gfortran_transfer_logical_write (&dt_parm.5, &D.4354, 4);
              }

Reply via email to