gcc/testsuite/gfortran.dg/pr39865.f90

   1 ! PR fortran/39865
   2 ! { dg-do run }
   3
   4 subroutine f1 (a)
   5   character(len=1) :: a(7:)
   6   character(len=12) :: b
   7   character(len=1) :: c(2:10)
   8   write (b, a) 'Hell', 'o wo', 'rld!'
   9   if (b .ne. 'Hello world!') call abort
  10   write (b, a(:)) 'hell', 'o Wo', 'rld!'
  11   if (b .ne. 'hello World!') call abort
  12   write (b, a(8:)) 'Hell', 'o wo', 'rld!'
  13   if (b .ne. 'Hello world!') call abort
  14   c(2) = ' '
  15   c(3) = '('
  16   c(4) = '3'
  17   c(5) = 'A'
  18   c(6) = '4'
  19   c(7) = ')'
  20   write (b, c) 'hell', 'o Wo', 'rld!'
  21   if (b .ne. 'hello World!') call abort
  22   write (b, c(:)) 'Hell', 'o wo', 'rld!'
  23   if (b .ne. 'Hello world!') call abort
  24   write (b, c(3:)) 'hell', 'o Wo', 'rld!'
  25   if (b .ne. 'hello World!') call abort
  26 end subroutine f1
  27
  28 subroutine f2 (a)
  29   character(len=1) :: a(10:,20:)
  30   character(len=12) :: b
  31   write (b, a) 'Hell', 'o wo', 'rld!'
  32   if (b .ne. 'Hello world!') call abort
  33   write (b, a) 'hell', 'o Wo', 'rld!'
  34   if (b .ne. 'hello World!') call abort
  35 end subroutine f2
  36
  37 function f3 ()
  38   character(len=1) :: f3(5)
  39   f3(1) = '('
  40   f3(2) = '3'
  41   f3(3) = 'A'
  42   f3(4) = '4'
  43   f3(5) = ')'
  44 end function f3
  45
  46   interface
  47     subroutine f1 (a)
  48       character(len=1) :: a(:)
  49     end
  50   end interface
  51   interface
  52     subroutine f2 (a)
  53       character(len=1) :: a(:,:)
  54     end
  55   end interface
  56   interface
  57     function f3 ()
  58       character(len=1) :: f3(5)
  59     end
  60   end interface
  61   integer :: i, j
  62   character(len=1) :: e (6, 7:9), f (3,2), g (10)
  63   character(len=12) :: b
  64   e = 'X'
  65   e(2,8) = ' '
  66   e(3,8) = '('
  67   e(4,8) = '3'
  68   e(2,9) = 'A'
  69   e(3,9) = '4'
  70   e(4,9) = ')'
  71   f = e(2:4,8:9)
  72   g = 'X'
  73   g(2) = ' '
  74   g(3) = '('
  75   g(4) = '3'
  76   g(5) = 'A'
  77   g(6) = '4'
  78   g(7) = ')'
  79   call f1 (g(2:7))
  80   call f2 (f)
  81   call f2 (e(2:4,8:9))
  82   write (b, f3 ()) 'Hell', 'o wo', 'rld!'
  83   if (b .ne. 'Hello world!') call abort
  84 end