Mercurial > hg > CbC > CbC_gcc

annotate gcc/testsuite/gfortran.dg/substr_4.f @ 158:494b0b89df80 default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 25 May 2020 18:13:55 +0900
parents 84e7813d76e9
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ! { dg-do run }
kono
parents:
diff changeset
2 subroutine test_lower
kono
parents:
diff changeset
3 implicit none
kono
parents:
diff changeset
4 character(3), dimension(3) :: zsymel,zsymelr
kono
parents:
diff changeset
5 common /xx/ zsymel, zsymelr
kono
parents:
diff changeset
6 integer :: znsymelr
kono
parents:
diff changeset
7 zsymel = (/ 'X', 'Y', ' ' /)
kono
parents:
diff changeset
8 zsymelr= (/ 'X', 'Y', ' ' /)
kono
parents:
diff changeset
9 znsymelr=2
kono
parents:
diff changeset
10 call check_zsymel(zsymel,zsymelr,znsymelr)
kono
parents:
diff changeset
11
kono
parents:
diff changeset
12 contains
kono
parents:
diff changeset
13
kono
parents:
diff changeset
14 subroutine check_zsymel(zsymel,zsymelr,znsymelr)
kono
parents:
diff changeset
15 implicit none
kono
parents:
diff changeset
16 integer znsymelr, isym
kono
parents:
diff changeset
17 character(*) zsymel(*),zsymelr(*)
kono
parents:
diff changeset
18 character(len=80) buf
kono
parents:
diff changeset
19 zsymel(3)(lenstr(zsymel(3))+1:)='X'
kono
parents:
diff changeset
20 write (buf,10) (trim(zsymelr(isym)),isym=1,znsymelr)
kono
parents:
diff changeset
21 10 format(3(a,:,','))
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
22 if (trim(buf) /= 'X,Y') STOP 1
111
kono
parents:
diff changeset
23 end subroutine check_zsymel
kono
parents:
diff changeset
24
kono
parents:
diff changeset
25 function lenstr(s)
kono
parents:
diff changeset
26 character(len=*),intent(in) :: s
kono
parents:
diff changeset
27 integer :: lenstr
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
28 if (len_trim(s) /= 0) STOP 2
111
kono
parents:
diff changeset
29 lenstr = len_trim(s)
kono
parents:
diff changeset
30 end function lenstr
kono
parents:
diff changeset
31
kono
parents:
diff changeset
32 end subroutine test_lower
kono
parents:
diff changeset
33
kono
parents:
diff changeset
34 subroutine test_upper
kono
parents:
diff changeset
35 implicit none
kono
parents:
diff changeset
36 character(3), dimension(3) :: zsymel,zsymelr
kono
parents:
diff changeset
37 common /xx/ zsymel, zsymelr
kono
parents:
diff changeset
38 integer :: znsymelr
kono
parents:
diff changeset
39 zsymel = (/ 'X', 'Y', ' ' /)
kono
parents:
diff changeset
40 zsymelr= (/ 'X', 'Y', ' ' /)
kono
parents:
diff changeset
41 znsymelr=2
kono
parents:
diff changeset
42 call check_zsymel(zsymel,zsymelr,znsymelr)
kono
parents:
diff changeset
43
kono
parents:
diff changeset
44 contains
kono
parents:
diff changeset
45
kono
parents:
diff changeset
46 subroutine check_zsymel(zsymel,zsymelr,znsymelr)
kono
parents:
diff changeset
47 implicit none
kono
parents:
diff changeset
48 integer znsymelr, isym
kono
parents:
diff changeset
49 character(*) zsymel(*),zsymelr(*)
kono
parents:
diff changeset
50 character(len=80) buf
kono
parents:
diff changeset
51 zsymel(3)(:lenstr(zsymel(3))+1)='X'
kono
parents:
diff changeset
52 write (buf,20) (trim(zsymelr(isym)),isym=1,znsymelr)
kono
parents:
diff changeset
53 20 format(3(a,:,','))
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
54 if (trim(buf) /= 'X,Y') STOP 3
111
kono
parents:
diff changeset
55 end subroutine check_zsymel
kono
parents:
diff changeset
56
kono
parents:
diff changeset
57 function lenstr(s)
kono
parents:
diff changeset
58 character(len=*),intent(in) :: s
kono
parents:
diff changeset
59 integer :: lenstr
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
60 if (len_trim(s) /= 0) STOP 4
111
kono
parents:
diff changeset
61 lenstr = len_trim(s)
kono
parents:
diff changeset
62 end function lenstr
kono
parents:
diff changeset
63
kono
parents:
diff changeset
64 end subroutine test_upper
kono
parents:
diff changeset
65
kono
parents:
diff changeset
66 program test
kono
parents:
diff changeset
67 call test_lower
kono
parents:
diff changeset
68 call test_upper
kono
parents:
diff changeset
69 end program test