! { dg-do run }
!
! Automatic reallocate on assignment, deferred length parameter for char
!
! PR fortran/45170
! PR fortran/35810
! PR fortran/47350
!
! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
!
program test
  implicit none
  call mold_check()
  call mold_check4()
  call source_check()
  call source_check4()
  call ftn_test()
  call ftn_test4()
  call source3()
contains
  subroutine source_check()
    character(len=:), allocatable :: str, str2
    target :: str
    character(len=8) :: str3
    character(len=:), pointer :: str4, str5
    nullify(str4)
    str3 = 'AbCdEfGhIj'
    if(allocated(str)) STOP 1
    allocate(str, source=str3)
    if(.not.allocated(str)) STOP 2
    if(len(str) /= 8) STOP 3
    if(str /= 'AbCdEfGh') STOP 4
    if(associated(str4)) STOP 5
    str4 => str
    if(str4 /= str .or. len(str4)/=8) STOP 6
    if(.not.associated(str4, str)) STOP 7
    str4 => null()
    str = '12a56b78'
    if(str4 == '12a56b78') STOP 8
    str4 = 'ABCDEFGH'
    if(str == 'ABCDEFGH') STOP 9
    allocate(str5, source=str)
    if(associated(str5, str)) STOP 10
    if(str5 /= '12a56b78' .or. len(str5)/=8) STOP 11
    str = 'abcdef'
    if(str5 == 'abcdef') STOP 12
    str5 = 'ABCDEF'
    if(str == 'ABCDEF') STOP 13
  end subroutine source_check
  subroutine source_check4()
    character(kind=4,len=:), allocatable :: str, str2
    target :: str
    character(kind=4,len=8) :: str3
    character(kind=4,len=:), pointer :: str4, str5
    nullify(str4)
    str3 = 4_'AbCdEfGhIj'
    if(allocated(str)) STOP 14
    allocate(str, source=str3)
    if(.not.allocated(str)) STOP 15
    if(len(str) /= 8) STOP 16
    if(str /= 4_'AbCdEfGh') STOP 17
    if(associated(str4)) STOP 18
    str4 => str
    if(str4 /= str .or. len(str4)/=8) STOP 19
    if(.not.associated(str4, str)) STOP 20
    str4 => null()
    str = 4_'12a56b78'
    if(str4 == 4_'12a56b78') STOP 21
    str4 = 4_'ABCDEFGH'
    if(str == 4_'ABCDEFGH') STOP 22
    allocate(str5, source=str)
    if(associated(str5, str)) STOP 23
    if(str5 /= 4_'12a56b78' .or. len(str5)/=8) STOP 24
    str = 4_'abcdef'
    if(str5 == 4_'abcdef') STOP 25
    str5 = 4_'ABCDEF'
    if(str == 4_'ABCDEF') STOP 26
  end subroutine source_check4
  subroutine mold_check()
    character(len=:), allocatable :: str, str2
    character(len=8) :: str3
    character(len=:), pointer :: str4, str5
    nullify(str4)
    str2 = "ABCE"
    ALLOCATE( str, MOLD=str3)
    if (len(str) /= 8) STOP 27
    DEALLOCATE(str)
    ALLOCATE( str, MOLD=str2)
    if (len(str) /= 4) STOP 28

    IF (associated(str4)) STOP 29
    ALLOCATE( str4, MOLD=str3)
    IF (.not.associated(str4)) STOP 30
    str4 = '12345678'
    if (len(str4) /= 8) STOP 31
    if(str4 /= '12345678') STOP 32
    DEALLOCATE(str4)
    ALLOCATE( str4, MOLD=str2)
    str4 = 'ABCD'
    if (len(str4) /= 4) STOP 33
    if (str4 /= 'ABCD') STOP 34
    str5 => str4
    if(.not.associated(str4,str5)) STOP 35
    if(len(str5) /= 4 .or. len(str4) /= len(str5)) STOP 36
    if(str5 /= str4) STOP 37
    deallocate(str4) 
  end subroutine mold_check
  subroutine mold_check4()
    character(len=:,kind=4), allocatable :: str, str2
    character(len=8,kind=4) :: str3
    character(len=:,kind=4), pointer :: str4, str5
    nullify(str4)
    str2 = 4_"ABCE"
    ALLOCATE( str, MOLD=str3)
    if (len(str) /= 8) STOP 38
    DEALLOCATE(str)
    ALLOCATE( str, MOLD=str2)
    if (len(str) /= 4) STOP 39

    IF (associated(str4)) STOP 40
    ALLOCATE( str4, MOLD=str3)
    IF (.not.associated(str4)) STOP 41
    str4 = 4_'12345678'
    if (len(str4) /= 8) STOP 42
    if(str4 /= 4_'12345678') STOP 43
    DEALLOCATE(str4)
    ALLOCATE( str4, MOLD=str2)
    str4 = 4_'ABCD'
    if (len(str4) /= 4) STOP 44
    if (str4 /= 4_'ABCD') STOP 45
    str5 => str4
    if(.not.associated(str4,str5)) STOP 46
    if(len(str5) /= 4 .or. len(str4) /= len(str5)) STOP 47
    if(str5 /= str4) STOP 48
    deallocate(str4) 
  end subroutine mold_check4
  subroutine ftn_test()
    character(len=:), allocatable :: str_a
    character(len=:), pointer     :: str_p
    nullify(str_p) 
    call proc_test(str_a, str_p, .false.)
    if (str_p /= '123457890abcdef') STOP 49
    if (len(str_p) /= 50) STOP 50
    if (str_a(1:5) /= 'ABCDE ') STOP 51
    if (len(str_a) /= 50) STOP 52
    deallocate(str_p)
    str_a = '1245'
    if(len(str_a) /= 4) STOP 53
    if(str_a /= '1245') STOP 54
    allocate(character(len=6) :: str_p)
    if(len(str_p) /= 6) STOP 55
    str_p = 'AbCdEf'
    call proc_test(str_a, str_p, .true.)
    if (str_p /= '123457890abcdef') STOP 56
    if (len(str_p) /= 50) STOP 57
    if (str_a(1:5) /= 'ABCDE ') STOP 58
    if (len(str_a) /= 50) STOP 59
    deallocate(str_p)
  end subroutine ftn_test
  subroutine proc_test(a, p, alloc)
    character(len=:), allocatable :: a
    character(len=:), pointer     :: p
    character(len=5), target :: loc
    logical :: alloc
    if (.not.  alloc) then
      if(associated(p)) STOP 60
      if(allocated(a)) STOP 61
    else
      if(len(a) /= 4) STOP 62
      if(a /= '1245') STOP 63
      if(len(p) /= 6) STOP 64
      if(p /= 'AbCdEf') STOP 65
      deallocate(a)
      nullify(p)
    end if
    allocate(character(len=50) :: a)
    a(1:5) = 'ABCDE'
    if(len(a) /= 50) STOP 66
    if(a(1:5) /= "ABCDE") STOP 67
    loc = '12345'
    p => loc
    if (len(p) /= 5) STOP 68
    if (p /= '12345') STOP 69
    p = '12345679'
    if (len(p) /= 5) STOP 70
    if (p /= '12345') STOP 71
    p = 'ABC'
    if (loc /= 'ABC  ') STOP 72
    allocate(p, mold=a)
    if (.not.associated(p)) STOP 73
    p = '123457890abcdef'
    if (p /= '123457890abcdef') STOP 74
    if (len(p) /= 50) STOP 75
  end subroutine proc_test
  subroutine ftn_test4()
    character(len=:,kind=4), allocatable :: str_a
    character(len=:,kind=4), pointer     :: str_p
    nullify(str_p) 
    call proc_test4(str_a, str_p, .false.)
    if (str_p /= 4_'123457890abcdef') STOP 76
    if (len(str_p) /= 50) STOP 77
    if (str_a(1:5) /= 4_'ABCDE ') STOP 78
    if (len(str_a) /= 50) STOP 79
    deallocate(str_p)
    str_a = 4_'1245'
    if(len(str_a) /= 4) STOP 80
    if(str_a /= 4_'1245') STOP 81
    allocate(character(len=6, kind = 4) :: str_p)
    if(len(str_p) /= 6) STOP 82
    str_p = 4_'AbCdEf'
    call proc_test4(str_a, str_p, .true.)
    if (str_p /= 4_'123457890abcdef') STOP 83
    if (len(str_p) /= 50) STOP 84
    if (str_a(1:5) /= 4_'ABCDE ') STOP 85
    if (len(str_a) /= 50) STOP 86
    deallocate(str_p)
  end subroutine ftn_test4
  subroutine proc_test4(a, p, alloc)
    character(len=:,kind=4), allocatable :: a
    character(len=:,kind=4), pointer     :: p
    character(len=5,kind=4), target :: loc
    logical :: alloc
    if (.not.  alloc) then
      if(associated(p)) STOP 87
      if(allocated(a)) STOP 88
    else
      if(len(a) /= 4) STOP 89
      if(a /= 4_'1245') STOP 90
      if(len(p) /= 6) STOP 91
      if(p /= 4_'AbCdEf') STOP 92
      deallocate(a)
      nullify(p)
    end if
    allocate(character(len=50,kind=4) :: a)
    a(1:5) = 4_'ABCDE'
    if(len(a) /= 50) STOP 93
    if(a(1:5) /= 4_"ABCDE") STOP 94
    loc = '12345'
    p => loc
    if (len(p) /= 5) STOP 95
    if (p /= 4_'12345') STOP 96
    p = 4_'12345679'
    if (len(p) /= 5) STOP 97
    if (p /= 4_'12345') STOP 98
    p = 4_'ABC'
    if (loc /= 4_'ABC  ') STOP 99
    allocate(p, mold=a)
    if (.not.associated(p)) STOP 100
    p = 4_'123457890abcdef'
    if (p /= 4_'123457890abcdef') STOP 101
    if (len(p) /= 50) STOP 102
  end subroutine proc_test4
  subroutine source3()
     character(len=:, kind=1), allocatable :: a1
     character(len=:, kind=4), allocatable :: a4
     character(len=:, kind=1), pointer     :: p1
     character(len=:, kind=4), pointer     :: p4
     allocate(a1, source='ABC') ! << ICE
     if(len(a1) /= 3 .or. a1 /= 'ABC') STOP 103
     allocate(a4, source=4_'12345') ! << ICE
     if(len(a4) /= 5 .or. a4 /= 4_'12345') STOP 104
     allocate(p1, mold='AB') ! << ICE
     if(len(p1) /= 2) STOP 105
     allocate(p4, mold=4_'145') ! << ICE
     if(len(p4) /= 3) STOP 106
  end subroutine source3
end program test
! Spurious -Wstringop-overflow warning with -O1
! { dg-prune-output "\\\[-Wstringop-overflow=]" }