Subversion Repositories openrisc

! { 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)) call abort()
    allocate(str, source=str3)
    if(.not.allocated(str)) call abort()
    if(len(str) /= 8) call abort()
    if(str /= 'AbCdEfGh') call abort()
    if(associated(str4)) call abort()
    str4 => str
    if(str4 /= str .or. len(str4)/=8) call abort()
    if(.not.associated(str4, str)) call abort()
    str4 => null()
    str = '12a56b78'
    if(str4 == '12a56b78') call abort()
    str4 = 'ABCDEFGH'
    if(str == 'ABCDEFGH') call abort()
    allocate(str5, source=str)
    if(associated(str5, str)) call abort()
    if(str5 /= '12a56b78' .or. len(str5)/=8) call abort()
    str = 'abcdef'
    if(str5 == 'abcdef') call abort()
    str5 = 'ABCDEF'
    if(str == 'ABCDEF') call abort()
  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)) call abort()
    allocate(str, source=str3)
    if(.not.allocated(str)) call abort()
    if(len(str) /= 8) call abort()
    if(str /= 4_'AbCdEfGh') call abort()
    if(associated(str4)) call abort()
    str4 => str
    if(str4 /= str .or. len(str4)/=8) call abort()
    if(.not.associated(str4, str)) call abort()
    str4 => null()
    str = 4_'12a56b78'
    if(str4 == 4_'12a56b78') call abort()
    str4 = 4_'ABCDEFGH'
    if(str == 4_'ABCDEFGH') call abort()
    allocate(str5, source=str)
    if(associated(str5, str)) call abort()
    if(str5 /= 4_'12a56b78' .or. len(str5)/=8) call abort()
    str = 4_'abcdef'
    if(str5 == 4_'abcdef') call abort()
    str5 = 4_'ABCDEF'
    if(str == 4_'ABCDEF') call abort()
  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) call abort()
    DEALLOCATE(str)
    ALLOCATE( str, MOLD=str2)
    if (len(str) /= 4) call abort()

    IF (associated(str4)) call abort()
    ALLOCATE( str4, MOLD=str3)
    IF (.not.associated(str4)) call abort()
    str4 = '12345678'
    if (len(str4) /= 8) call abort()
    if(str4 /= '12345678') call abort()
    DEALLOCATE(str4)
    ALLOCATE( str4, MOLD=str2)
    str4 = 'ABCD'
    if (len(str4) /= 4) call abort()
    if (str4 /= 'ABCD') call abort()
    str5 => str4
    if(.not.associated(str4,str5)) call abort()
    if(len(str5) /= 4 .or. len(str4) /= len(str5)) call abort()
    if(str5 /= str4) call abort()
    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) call abort()
    DEALLOCATE(str)
    ALLOCATE( str, MOLD=str2)
    if (len(str) /= 4) call abort()

    IF (associated(str4)) call abort()
    ALLOCATE( str4, MOLD=str3)
    IF (.not.associated(str4)) call abort()
    str4 = 4_'12345678'
    if (len(str4) /= 8) call abort()
    if(str4 /= 4_'12345678') call abort()
    DEALLOCATE(str4)
    ALLOCATE( str4, MOLD=str2)
    str4 = 4_'ABCD'
    if (len(str4) /= 4) call abort()
    if (str4 /= 4_'ABCD') call abort()
    str5 => str4
    if(.not.associated(str4,str5)) call abort()
    if(len(str5) /= 4 .or. len(str4) /= len(str5)) call abort()
    if(str5 /= str4) call abort()
    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') call abort()
    if (len(str_p) /= 50) call abort()
    if (str_a(1:5) /= 'ABCDE ') call abort()
    if (len(str_a) /= 50) call abort()
    deallocate(str_p)
    str_a = '1245'
    if(len(str_a) /= 4) call abort()
    if(str_a /= '1245') call abort()
    allocate(character(len=6) :: str_p)
    if(len(str_p) /= 6) call abort()
    str_p = 'AbCdEf'
    call proc_test(str_a, str_p, .true.)
    if (str_p /= '123457890abcdef') call abort()
    if (len(str_p) /= 50) call abort()
    if (str_a(1:5) /= 'ABCDE ') call abort()
    if (len(str_a) /= 50) call abort()
    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)) call abort()
      if(allocated(a)) call abort()
    else
      if(len(a) /= 4) call abort()
      if(a /= '1245') call abort()
      if(len(p) /= 6) call abort()
      if(p /= 'AbCdEf') call abort()
      deallocate(a)
      nullify(p)
    end if
    allocate(character(len=50) :: a)
    a(1:5) = 'ABCDE'
    if(len(a) /= 50) call abort()
    if(a(1:5) /= "ABCDE") call abort()
    loc = '12345'
    p => loc
    if (len(p) /= 5) call abort()
    if (p /= '12345') call abort()
    p = '12345679'
    if (len(p) /= 5) call abort()
    if (p /= '12345') call abort()
    p = 'ABC'
    if (loc /= 'ABC  ') call abort()
    allocate(p, mold=a)
    if (.not.associated(p)) call abort()
    p = '123457890abcdef'
    if (p /= '123457890abcdef') call abort()
    if (len(p) /= 50) call abort()
  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') call abort()
    if (len(str_p) /= 50) call abort()
    if (str_a(1:5) /= 4_'ABCDE ') call abort()
    if (len(str_a) /= 50) call abort()
    deallocate(str_p)
    str_a = 4_'1245'
    if(len(str_a) /= 4) call abort()
    if(str_a /= 4_'1245') call abort()
    allocate(character(len=6, kind = 4) :: str_p)
    if(len(str_p) /= 6) call abort()
    str_p = 4_'AbCdEf'
    call proc_test4(str_a, str_p, .true.)
    if (str_p /= 4_'123457890abcdef') call abort()
    if (len(str_p) /= 50) call abort()
    if (str_a(1:5) /= 4_'ABCDE ') call abort()
    if (len(str_a) /= 50) call abort()
    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)) call abort()
      if(allocated(a)) call abort()
    else
      if(len(a) /= 4) call abort()
      if(a /= 4_'1245') call abort()
      if(len(p) /= 6) call abort()
      if(p /= 4_'AbCdEf') call abort()
      deallocate(a)
      nullify(p)
    end if
    allocate(character(len=50,kind=4) :: a)
    a(1:5) = 4_'ABCDE'
    if(len(a) /= 50) call abort()
    if(a(1:5) /= 4_"ABCDE") call abort()
    loc = '12345'
    p => loc
    if (len(p) /= 5) call abort()
    if (p /= 4_'12345') call abort()
    p = 4_'12345679'
    if (len(p) /= 5) call abort()
    if (p /= 4_'12345') call abort()
    p = 4_'ABC'
    if (loc /= 4_'ABC  ') call abort()
    allocate(p, mold=a)
    if (.not.associated(p)) call abort()
    p = 4_'123457890abcdef'
    if (p /= 4_'123457890abcdef') call abort()
    if (len(p) /= 50) call abort()
  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') call abort()
     allocate(a4, source=4_'12345') ! << ICE
     if(len(a4) /= 5 .or. a4 /= 4_'12345') call abort()
     allocate(p1, mold='AB') ! << ICE
     if(len(p1) /= 2) call abort()
     allocate(p4, mold=4_'145') ! << ICE
     if(len(p4) /= 3) call abort()
  end subroutine source3
end program test