! { dg-do run }
! PR fortran/83079 - ICE and wrong code with TRANSFER and character(kind=4)
! Exercise TRANSFER intrinsic to check character result length and shape

program p
  implicit none
  character(len=*,kind=4), parameter :: a = 4_'ABCDEF'
  character(len=6,kind=4)            :: b = 4_'abcdef'
  character(len=*,kind=4), parameter :: c = 4_'XY'
  character(len=2,kind=4)            :: d = 4_'xy'
  integer :: k, l
  k = len (a)
  l = len (c)

! print *, transfer(4_'xy', [4_'a'])

  ! TRANSFER with rank-0 result
  call chk0 (transfer (4_'ABCD', 4_'XY'), 2, 1)
  call chk0 (transfer (4_'ABCD', c     ), l, 2)
  call chk0 (transfer (4_'ABCD', d     ), l, 3)
  call chk0 (transfer (a       , 4_'XY'), 2, 4)
  call chk0 (transfer (a       , c     ), l, 5)
  call chk0 (transfer (a       , d     ), l, 6)
  call chk0 (transfer (b       , 4_'XY'), 2, 7)
  call chk0 (transfer (b       , c     ), l, 8)
  call chk0 (transfer (b       , d     ), l, 9)

  call chk0 (transfer ([4_'ABCD'], 4_'XY'), 2, 11)
  call chk0 (transfer ([4_'ABCD'], c     ), l, 12)
  call chk0 (transfer ([4_'ABCD'], d     ), l, 13)
  call chk0 (transfer ([a       ], 4_'XY'), 2, 14)
  call chk0 (transfer ([a       ], c     ), l, 15)
  call chk0 (transfer ([a       ], d     ), l, 16)
  call chk0 (transfer ([b       ], 4_'XY'), 2, 17)
  call chk0 (transfer ([b       ], c     ), l, 18)
  call chk0 (transfer ([b       ], d     ), l, 19)

  ! TRANSFER with rank-1 result
  call chk1 (transfer (4_'ABCD', [4_'XY']), 2,   2, 21)
  call chk1 (transfer (4_'ABCD', [c]     ), 2,   2, 22)
  call chk1 (transfer (4_'ABCD', [d]     ), 2,   2, 23)
  call chk1 (transfer (a       , [4_'XY']), 2, k/2, 24)
  call chk1 (transfer (a       , [c]     ), l, k/l, 25)
  call chk1 (transfer (a       , [d]     ), l, k/l, 26)
  call chk1 (transfer (b       , [4_'XY']), 2, k/2, 27)
  call chk1 (transfer (b       , [c]     ), l, k/l, 28)
  call chk1 (transfer (b       , [d]     ), l, k/l, 29)

  call chk1 (transfer (4_'ABCD', 4_'XY',size=2), 2, 2, 31)
  call chk1 (transfer (4_'ABCD', c     ,size=2), 2, 2, 32)
  call chk1 (transfer (4_'ABCD', d     ,size=2), 2, 2, 33)
  call chk1 (transfer (a       , 4_'XY',size=3), 2, 3, 34)
  call chk1 (transfer (a       , c     ,size=3), l, 3, 35)
  call chk1 (transfer (a       , d     ,size=3), l, 3, 36)
  call chk1 (transfer (b       , 4_'XY',size=3), 2, 3, 37)
  call chk1 (transfer (b       , c     ,size=3), l, 3, 38)
  call chk1 (transfer (b       , d     ,size=3), l, 3, 39)

  call chk1 (transfer (4_'ABCD', [4_'XY'],size=2), 2, 2, 41)
  call chk1 (transfer (4_'ABCD', [c]     ,size=2), 2, 2, 42)
  call chk1 (transfer (4_'ABCD', [d]     ,size=2), 2, 2, 43)
  call chk1 (transfer (a       , [4_'XY'],size=3), 2, 3, 44)
  call chk1 (transfer (a       , [c]     ,size=3), l, 3, 45)
  call chk1 (transfer (a       , [d]     ,size=3), l, 3, 46)
  call chk1 (transfer (b       , [4_'XY'],size=3), 2, 3, 47)
  call chk1 (transfer (b       , [c]     ,size=3), l, 3, 48)
  call chk1 (transfer (b       , [d]     ,size=3), l, 3, 49)

  call chk1 (transfer ([4_'ABCD'], [4_'XY']), 2,   2, 51)
  call chk1 (transfer ([4_'ABCD'], [c]     ), 2,   2, 52)
  call chk1 (transfer ([4_'ABCD'], [d]     ), 2,   2, 53)
  call chk1 (transfer ([a       ], [4_'XY']), 2, k/2, 54)
  call chk1 (transfer ([a       ], [c]     ), l, k/l, 55)
  call chk1 (transfer ([a       ], [d]     ), l, k/l, 56)
  call chk1 (transfer ([b       ], [4_'XY']), 2, k/2, 57)
  call chk1 (transfer ([b       ], [c]     ), l, k/l, 58)
  call chk1 (transfer ([b       ], [d]     ), l, k/l, 59)

  call chk1 (transfer (4_'ABCD', c     ,size=4/l), l, 4/l, 62)
  call chk1 (transfer (4_'ABCD', d     ,size=4/l), l, 4/l, 63)
  call chk1 (transfer (a       , 4_'XY',size=k/2), 2, k/2, 64)
  call chk1 (transfer (a       , c     ,size=k/l), l, k/l, 65)
  call chk1 (transfer (a       , d     ,size=k/l), l, k/l, 66)
  call chk1 (transfer (b       , 4_'XY',size=k/2), 2, k/2, 67)
  call chk1 (transfer (b       , c     ,size=k/l), l, k/l, 68)
  call chk1 (transfer (b       , d     ,size=k/l), l, k/l, 69)

contains
  ! Validate rank-0 result
  subroutine chk0 (str, l, stopcode)
    character(kind=4,len=*), intent(in) :: str
    integer,                 intent(in) :: l, stopcode
    integer :: i, p
    i = len  (str)
    p = verify (str, a // b) ! Check for junk characters
    if (i /= l .or. p > 0) then
       print *, stopcode, "len=", i, i == l, ">", str, "<"
       stop stopcode
    end if
  end subroutine chk0

  ! Validate rank-1 result
  subroutine chk1 (str, l, m, stopcode)
    character(kind=4,len=*), intent(in) :: str(:)
    integer,                 intent(in) :: l, m, stopcode
    integer :: i, j, p
    i = len  (str)
    j = size (str)
    p = maxval (verify (str, a // b)) ! Check for junk characters
    if (i /= l .or. j /= m .or. p > 0) then
       print *, stopcode, "len=", i, i == l, "size=", j, j == m, ">", str, "<"
       stop stopcode
    end if
  end subroutine chk1
end