gcc/testsuite/gfortran.dg/PR95214.f90

! { dg-do run }
!
! PR fortran/95214
!

program chr_p

  implicit none

  integer, parameter :: u = 65
  
  integer, parameter :: n = 26
  
  character :: c(n)
  integer   :: i

  c = [(achar(i), i=u,u+n-1)]
  call chr_s(c, c)
  call gfc_descriptor_c_char(c)
  call s1(c)
  call s1s_a(c)
  call s1s_b(c)
  call s2(c)
  stop
  
contains

  subroutine chr_s(a, b)
    character, intent(in) :: a(..)
    character, intent(in) :: b(:)

    integer :: i

    select rank(a)
    rank(1)
      do i = 1, size(a)
        if(a(i)/=b(i)) stop 1
      end do
    rank default
      stop 2
    end select
    return
  end subroutine chr_s

  ! From Bug 66833
  ! Contributed by Damian Rouson <damian@sourceryinstitute.org>
  subroutine gfc_descriptor_c_char(a)
    character a(..)
    if(rank(a)/=1) stop 3 ! ICE (also for lbound, ubound, and c_loc)
  end subroutine gfc_descriptor_c_char


  ! From Bug 67938
  ! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fortran@t-online.de>
  
  ! example z1.f90
  subroutine s1(x)
    character(1) :: x(..)
    if(any(lbound(x)/=[1])) stop 4
    if(any(ubound(x)/=[n])) stop 5
  end subroutine s1
  
  ! example z1s.f90
  subroutine s1s_a(x)
    character :: x(..)
    if(size(x)/=n) stop 6
  end subroutine s1s_a
  
  subroutine s1s_b(x)
    character(77) :: x(..)
    if(size(x)/=n) stop 7
  end subroutine s1s_b
  
  ! example z2.f90
  subroutine s2(x)
    character(1) :: x(..)
    if(lbound(x, dim=1)/=1) stop 8
    if(ubound(x, dim=1)/=n) stop 9
    if(size(x, dim=1)/=n)   stop 10
  end subroutine s2
  
end program chr_p