Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/gfortran.dg/pr55086_1.f90 @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 ! { dg-do run }
2 !
3 implicit none
4 character(len=5), pointer :: a(:), b(:)
5 character(len=5), pointer :: c, d
6 allocate (a(2), b(2), c, d)
7 a = [ "abcde", "ABCDE" ]
8 call aloct_pointer_copy_4 (b, a)
9 !print *, b(1)
10 !print *, b(2)
11 if (any (a /= b)) stop 'WRONG'
12
13 call aloct_copy_4 (b, a)
14 !print *, b(1)
15 !print *, b(2)
16 if (any (a /= b)) stop 'WRONG'
17
18 d = '12345'
19 c = "abcde"
20 call test2 (d, c)
21 !print *, d
22 if (d /= '1cb15') stop 'WRONG'
23
24 call test2p (d, c)
25 !print *, d
26 if (d /= '1cb15') stop 'WRONG'
27
28 contains
29 subroutine aloct_pointer_copy_4(o, i)
30 character(len=*), pointer :: o(:), i(:)
31 integer :: nl1, nu1
32 integer :: i1
33 nl1 = lbound(i,dim=1)
34 nu1 = ubound(i,dim=1)
35 forall (i1 = nl1:nu1) o(i1) = i(i1)
36 end subroutine aloct_pointer_copy_4
37 subroutine aloct_copy_4(o, i)
38 character(len=*), pointer :: o(:), i(:)
39 integer :: nl1, nu1
40 integer :: i1
41 nl1 = lbound(i,dim=1)
42 nu1 = ubound(i,dim=1)
43 forall (i1 = nl1:nu1) o(i1) = i(i1)
44 end subroutine aloct_copy_4
45 subroutine test2(o, i)
46 character(len=*) :: o, i
47 integer :: nl1, nu1
48 integer :: i1
49 nl1 = 2
50 nu1 = 4
51 forall (i1 = nl1:nu1) o(i1:i1) = i(i1:i1)
52 forall (i1 = nl1:nu1) o(i1:i1) = o(nu1+1-i1:nu1+1-i1)
53 end subroutine test2
54 subroutine test2p(o, i)
55 character(len=*), pointer :: o, i
56 integer :: nl1, nu1
57 integer :: i1
58 nl1 = 2
59 nu1 = 4
60 forall (i1 = nl1:nu1) o(i1:i1) = i(i1:i1) ! <<<< ICE
61 forall (i1 = nl1:nu1) o(i1:i1) = o(nu1+1-i1:nu1+1-i1)
62 end subroutine test2p
63 end