------- Comment #10 from jakub at gcc dot gnu dot org  2009-05-11 17:30 -------
Testcase:

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

  interface
    subroutine f1 (a)
      character(len=1) :: a(:)
    end
  end interface
  interface
    subroutine f2 (a)
      character(len=1) :: a(:,:)
    end
  end interface
  integer :: i, j
  character(len=1) :: e (6, 7:9), f (3,2), g (10)
  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))
end


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=39865

Reply via email to