gcc/testsuite/gfortran.dg/write_recursive.f90

   1 ! { dg-do run }
   2 ! PR26766 Recursive I/O with internal units
   3 ! Test case derived from example in PR
   4 ! Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
   5 program pr26766
   6   implicit none
   7   character (len=8) :: str, tmp
   8   write (str, '(a)')  bar (1234)
   9   if (str.ne."abcd") call abort()
  10   str = "wxyz"
  11   write (str, '(2a4)') foo (1), bar (1)
  12   if (str.ne."abcdabcd") call abort()
  13
  14 contains
  15
  16   function foo (i) result (s)
  17     integer, intent(in) :: i
  18     character (len=4)   :: s, t
  19     if (i < 0) then
  20        s = "1234"
  21     else
  22        ! Internal I/O, allowed recursive in f2003, see section 9.11
  23        write (s, '(a)') "abcd"
  24     end if
  25   end function foo
  26
  27   function bar (i) result (s)
  28     integer, intent(in) :: i
  29     character (len=4)   :: s, t
  30     if (i < 0) then
  31       s = "4567"
  32     else
  33       write (s, '(a)') foo(i)
  34     end if
  35   end function bar
  36
  37 end program pr26766
  38
  39