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!') STOP 1
  10   write (b, a(:)) 'hell', 'o Wo', 'rld!'
  11   if (b .ne. 'hello World!') STOP 2
  12   write (b, a(8:)) 'Hell', 'o wo', 'rld!'
  13   if (b .ne. 'Hello world!') STOP 3
  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!') STOP 4
  22   write (b, c(:)) 'Hell', 'o wo', 'rld!'
  23   if (b .ne. 'Hello world!') STOP 5
  24   write (b, c(3:)) 'hell', 'o Wo', 'rld!'
  25   if (b .ne. 'hello World!') STOP 6
  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!') STOP 7
  33   write (b, a) 'hell', 'o Wo', 'rld!'
  34   if (b .ne. 'hello World!') STOP 8
  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!') STOP 9
  84 end