Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/gfortran.dg/substr_4.f @ 131:84e7813d76e9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children
comparison
equal deleted inserted replaced
111:04ced10e8804 131:84e7813d76e9
17 character(*) zsymel(*),zsymelr(*) 17 character(*) zsymel(*),zsymelr(*)
18 character(len=80) buf 18 character(len=80) buf
19 zsymel(3)(lenstr(zsymel(3))+1:)='X' 19 zsymel(3)(lenstr(zsymel(3))+1:)='X'
20 write (buf,10) (trim(zsymelr(isym)),isym=1,znsymelr) 20 write (buf,10) (trim(zsymelr(isym)),isym=1,znsymelr)
21 10 format(3(a,:,',')) 21 10 format(3(a,:,','))
22 if (trim(buf) /= 'X,Y') call abort 22 if (trim(buf) /= 'X,Y') STOP 1
23 end subroutine check_zsymel 23 end subroutine check_zsymel
24 24
25 function lenstr(s) 25 function lenstr(s)
26 character(len=*),intent(in) :: s 26 character(len=*),intent(in) :: s
27 integer :: lenstr 27 integer :: lenstr
28 if (len_trim(s) /= 0) call abort 28 if (len_trim(s) /= 0) STOP 2
29 lenstr = len_trim(s) 29 lenstr = len_trim(s)
30 end function lenstr 30 end function lenstr
31 31
32 end subroutine test_lower 32 end subroutine test_lower
33 33
49 character(*) zsymel(*),zsymelr(*) 49 character(*) zsymel(*),zsymelr(*)
50 character(len=80) buf 50 character(len=80) buf
51 zsymel(3)(:lenstr(zsymel(3))+1)='X' 51 zsymel(3)(:lenstr(zsymel(3))+1)='X'
52 write (buf,20) (trim(zsymelr(isym)),isym=1,znsymelr) 52 write (buf,20) (trim(zsymelr(isym)),isym=1,znsymelr)
53 20 format(3(a,:,',')) 53 20 format(3(a,:,','))
54 if (trim(buf) /= 'X,Y') call abort 54 if (trim(buf) /= 'X,Y') STOP 3
55 end subroutine check_zsymel 55 end subroutine check_zsymel
56 56
57 function lenstr(s) 57 function lenstr(s)
58 character(len=*),intent(in) :: s 58 character(len=*),intent(in) :: s
59 integer :: lenstr 59 integer :: lenstr
60 if (len_trim(s) /= 0) call abort 60 if (len_trim(s) /= 0) STOP 4
61 lenstr = len_trim(s) 61 lenstr = len_trim(s)
62 end function lenstr 62 end function lenstr
63 63
64 end subroutine test_upper 64 end subroutine test_upper
65 65