gcc/testsuite/gfortran.dg/x_slash_1.f

   1 c { dg-do run }
   2 c This program tests the fixes to PR22570.
   3 c
   4 c Provided by Paul Thomas - pault@gcc.gnu.org
   5 c
   6        program x_slash
   7        character*60 a
   8        character*1  b, c
   9
  10        open (10, status = "scratch")
  11
  12 c Check that lines with only x-editing followed by a slash generate
  13 c spaces and that subsequent lines have spaces where they should.
  14 c Line 1 we ignore.
  15 c Line 2 has nothing but x editing, followed by a slash.
  16 c Line 3 has x editing finished off by a 1h*
  17
  18        write (10, 100)
  19  100   format (1h1,58x,1h!,/,60x,/,59x,1h*,/)
  20        rewind (10)
  21
  22        read (10, 200) a
  23        read (10, 200) a
  24        do i = 1,60
  25          if (ichar(a(i:i)).ne.32) call abort ()
  26        end do
  27        read (10, 200) a
  28  200   format (a60)
  29        do i = 1,59
  30          if (ichar(a(i:i)).ne.32) call abort ()
  31        end do
  32        if (a(60:60).ne."*") call abort ()
  33        rewind (10)
  34
  35 c Check that sequences of t- and x-editing generate the correct
  36 c number of spaces.
  37 c Line 1 we ignore.
  38 c Line 2 has tabs to the right of present position.
  39 c Line 3 has tabs to the left of present position.
  40
  41        write (10, 101)
  42  101   format (1h1,58x,1h#,/,t38,2x,1h ,tr10,9x,1h$,/,
  43      >         6habcdef,tl4,2x,6hghijkl,t1,59x,1h*)
  44        rewind (10)
  45
  46        read (10, 200) a
  47        read (10, 200) a
  48        do i = 1,59
  49          if (ichar(a(i:i)).ne.32) call abort ()
  50        end do
  51        if (a(60:60).ne."$") call abort ()
  52        read (10, 200) a
  53        if (a(1:10).ne."abcdghijkl") call abort ()
  54        do i = 11,59
  55          if (ichar(a(i:i)).ne.32) call abort ()
  56        end do
  57        if (a(60:60).ne."*") call abort ()
  58        rewind (10)
  59
  60 c Now repeat the first test, with the write broken up into three
  61 c separate statements. This checks that the position counters are
  62 c correctly reset for each statement.
  63
  64        write (10,102) "#"
  65        write (10,103)
  66        write (10,102) "$"
  67  102   format(59x,a1)
  68  103   format(60x)
  69        rewind (10)
  70        read (10, 200) a
  71        read (10, 200) a
  72        read (10, 200) a
  73        do i = 11,59
  74          if (ichar(a(i:i)).ne.32) call abort ()
  75        end do
  76        if (a(60:60).ne."$") call abort ()
  77        rewind (10)
  78
  79 c Next we check multiple read x- and t-editing.
  80 c First, tab to the right.
  81
  82        read (10, 201) b, c
  83 201    format (tr10,49x,a1,/,/,2x,t60,a1)
  84        if ((b.ne."#").or.(c.ne."$")) call abort ()
  85        rewind (10)
  86
  87 c Now break it up into three reads and use left tabs.
  88
  89        read (10, 202) b
  90 202    format (10x,tl10,59x,a1)
  91        read (10, 203)
  92 203    format ()
  93        read (10, 204) c
  94 204    format (10x,t5,55x,a1)
  95        if ((b.ne."#").or.(c.ne."$")) call abort ()
  96        close (10)
  97
  98 c Now, check that trailing spaces are not transmitted when we have
  99 c run out of data (Thanks to Jack Howarth for finding this one:
 100 c http://gcc.gnu.org/ml/fortran/2005-07/msg00395.html).
 101
 102        open (10, pad = "no", status = "scratch")
 103        b = achar (0)
 104        write (10, 105) 42
 105   105  format (i10,1x,i10)
 106        write (10, 106)
 107   106  format ("============================")
 108        rewind (10)
 109        read (10, 205, iostat = ier) i, b
 110   205  format (i10,a1)
 111        if ((ier.eq.0).or.(ichar(b).ne.0)) call abort ()
 112
 113 c That's all for now, folks!
 114
 115        end
 116