URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [substr_4.f] - Rev 827
Go to most recent revision | Compare with Previous | Blame | View Log
! { dg-do run } subroutine test_lower implicit none character(3), dimension(3) :: zsymel,zsymelr common /xx/ zsymel, zsymelr integer :: znsymelr zsymel = (/ 'X', 'Y', ' ' /) zsymelr= (/ 'X', 'Y', ' ' /) znsymelr=2 call check_zsymel(zsymel,zsymelr,znsymelr) contains subroutine check_zsymel(zsymel,zsymelr,znsymelr) implicit none integer znsymelr, isym character(*) zsymel(*),zsymelr(*) character(len=80) buf zsymel(3)(lenstr(zsymel(3))+1:)='X' write (buf,10) (trim(zsymelr(isym)),isym=1,znsymelr) 10 format(3(a,:,',')) if (trim(buf) /= 'X,Y') call abort end subroutine check_zsymel function lenstr(s) character(len=*),intent(in) :: s integer :: lenstr if (len_trim(s) /= 0) call abort lenstr = len_trim(s) end function lenstr end subroutine test_lower subroutine test_upper implicit none character(3), dimension(3) :: zsymel,zsymelr common /xx/ zsymel, zsymelr integer :: znsymelr zsymel = (/ 'X', 'Y', ' ' /) zsymelr= (/ 'X', 'Y', ' ' /) znsymelr=2 call check_zsymel(zsymel,zsymelr,znsymelr) contains subroutine check_zsymel(zsymel,zsymelr,znsymelr) implicit none integer znsymelr, isym character(*) zsymel(*),zsymelr(*) character(len=80) buf zsymel(3)(:lenstr(zsymel(3))+1)='X' write (buf,20) (trim(zsymelr(isym)),isym=1,znsymelr) 20 format(3(a,:,',')) if (trim(buf) /= 'X,Y') call abort end subroutine check_zsymel function lenstr(s) character(len=*),intent(in) :: s integer :: lenstr if (len_trim(s) /= 0) call abort lenstr = len_trim(s) end function lenstr end subroutine test_upper program test call test_lower call test_upper end program test
Go to most recent revision | Compare with Previous | Blame | View Log