1! { dg-do run }
2      subroutine test_lower
3      implicit none
4      character(3), dimension(3) :: zsymel,zsymelr
5      common /xx/ zsymel, zsymelr
6      integer :: znsymelr
7      zsymel = (/ 'X', 'Y', ' ' /)
8      zsymelr= (/ 'X', 'Y', ' ' /)
9      znsymelr=2
10      call check_zsymel(zsymel,zsymelr,znsymelr)
11
12      contains
13
14      subroutine check_zsymel(zsymel,zsymelr,znsymelr)
15        implicit none
16        integer znsymelr, isym
17        character(*) zsymel(*),zsymelr(*)
18        character(len=80) buf
19        zsymel(3)(lenstr(zsymel(3))+1:)='X'
20        write (buf,10) (trim(zsymelr(isym)),isym=1,znsymelr)
2110      format(3(a,:,','))
22        if (trim(buf) /= 'X,Y') call abort
23      end subroutine check_zsymel
24
25      function lenstr(s)
26        character(len=*),intent(in) :: s
27        integer :: lenstr
28        if (len_trim(s) /= 0) call abort
29        lenstr = len_trim(s)
30      end function lenstr
31
32      end subroutine test_lower
33
34      subroutine test_upper
35      implicit none
36      character(3), dimension(3) :: zsymel,zsymelr
37      common /xx/ zsymel, zsymelr
38      integer :: znsymelr
39      zsymel = (/ 'X', 'Y', ' ' /)
40      zsymelr= (/ 'X', 'Y', ' ' /)
41      znsymelr=2
42      call check_zsymel(zsymel,zsymelr,znsymelr)
43
44      contains
45
46      subroutine check_zsymel(zsymel,zsymelr,znsymelr)
47        implicit none
48        integer znsymelr, isym
49        character(*) zsymel(*),zsymelr(*)
50        character(len=80) buf
51        zsymel(3)(:lenstr(zsymel(3))+1)='X'
52        write (buf,20) (trim(zsymelr(isym)),isym=1,znsymelr)
5320      format(3(a,:,','))
54        if (trim(buf) /= 'X,Y') call abort
55      end subroutine check_zsymel
56
57      function lenstr(s)
58        character(len=*),intent(in) :: s
59        integer :: lenstr
60        if (len_trim(s) /= 0) call abort
61        lenstr = len_trim(s)
62      end function lenstr
63
64      end subroutine test_upper
65
66      program test
67        call test_lower
68        call test_upper
69      end program test
70