OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [pr39865.f90] - Rev 694

Compare with Previous | Blame | View Log

! PR fortran/39865
! { dg-do run }

subroutine f1 (a)
  character(len=1) :: a(7:)
  character(len=12) :: b
  character(len=1) :: c(2:10)
  write (b, a) 'Hell', 'o wo', 'rld!'
  if (b .ne. 'Hello world!') call abort
  write (b, a(:)) 'hell', 'o Wo', 'rld!'
  if (b .ne. 'hello World!') call abort
  write (b, a(8:)) 'Hell', 'o wo', 'rld!'
  if (b .ne. 'Hello world!') call abort
  c(2) = ' '
  c(3) = '('
  c(4) = '3'
  c(5) = 'A'
  c(6) = '4'
  c(7) = ')'
  write (b, c) 'hell', 'o Wo', 'rld!'
  if (b .ne. 'hello World!') call abort
  write (b, c(:)) 'Hell', 'o wo', 'rld!'
  if (b .ne. 'Hello world!') call abort
  write (b, c(3:)) 'hell', 'o Wo', 'rld!'
  if (b .ne. 'hello World!') call abort
end subroutine f1

subroutine f2 (a)
  character(len=1) :: a(10:,20:)
  character(len=12) :: b
  write (b, a) 'Hell', 'o wo', 'rld!'
  if (b .ne. 'Hello world!') call abort
  write (b, a) 'hell', 'o Wo', 'rld!'
  if (b .ne. 'hello World!') call abort
end subroutine f2

function f3 ()
  character(len=1) :: f3(5)
  f3(1) = '('
  f3(2) = '3'
  f3(3) = 'A'
  f3(4) = '4'
  f3(5) = ')'
end function f3

  interface
    subroutine f1 (a)
      character(len=1) :: a(:)
    end
  end interface
  interface
    subroutine f2 (a)
      character(len=1) :: a(:,:)
    end
  end interface
  interface
    function f3 ()
      character(len=1) :: f3(5)
    end
  end interface
  integer :: i, j
  character(len=1) :: e (6, 7:9), f (3,2), g (10)
  character(len=12) :: b
  e = 'X'
  e(2,8) = ' '
  e(3,8) = '('
  e(4,8) = '3'
  e(2,9) = 'A'
  e(3,9) = '4'
  e(4,9) = ')'
  f = e(2:4,8:9)
  g = 'X'
  g(2) = ' '
  g(3) = '('
  g(4) = '3'
  g(5) = 'A'
  g(6) = '4'
  g(7) = ')'
  call f1 (g(2:7))
  call f2 (f)
  call f2 (e(2:4,8:9))
  write (b, f3 ()) 'Hell', 'o wo', 'rld!'
  if (b .ne. 'Hello world!') call abort
end

Compare with Previous | Blame | View Log

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.