From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001
From: upstream source tree <ports@midipix.org>
Date: Sun, 15 Mar 2015 20:14:05 -0400
Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified
 gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream
 tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
---
 .../allocate_deferred_char_scalar_1.f03            | 267 +++++++++++++++++++++
 1 file changed, 267 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/allocate_deferred_char_scalar_1.f03

(limited to 'gcc/testsuite/gfortran.dg/allocate_deferred_char_scalar_1.f03')

diff --git a/gcc/testsuite/gfortran.dg/allocate_deferred_char_scalar_1.f03 b/gcc/testsuite/gfortran.dg/allocate_deferred_char_scalar_1.f03
new file mode 100644
index 000000000..b9b704014
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_deferred_char_scalar_1.f03
@@ -0,0 +1,267 @@
+! { 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
-- 
cgit v1.2.3