gcc/testsuite/gfortran.dg/namelist_19.f90

   1 !{ dg-do run }
   2 ! Test namelist error trapping.
   3 ! provided by Paul Thomas - pault@gcc.gnu.org
   4
   5 program namelist_19
   6   character*80 wrong, right
   7
   8 ! "=" before any object name
   9   wrong = "&z = i = 1,2 /"
  10   right = "&z i = 1,2 /"
  11   call test_err(wrong, right)
  12
  13 ! &* instead of &end for termination
  14   wrong = "&z i = 1,2 &xxx"
  15   right = "&z i = 1,2 &end"
  16   call test_err(wrong, right)
  17
  18 ! bad data
  19   wrong = "&z i = 1,q /"
  20   right = "&z i = 1,2 /"
  21   call test_err(wrong, right)
  22
  23 ! object name not matched
  24   wrong = "&z j = 1,2 /"
  25   right = "&z i = 1,2 /"
  26   call test_err(wrong, right)
  27
  28 ! derived type component for intrinsic type
  29   wrong = "&z i%j = 1,2 /"
  30   right = "&z i = 1,2 /"
  31   call test_err(wrong, right)
  32
  33 ! step other than 1 for substring qualifier
  34   wrong = "&z ch(1:2:2) = 'a'/"
  35   right = "&z ch(1:2) = 'ab' /"
  36   call test_err(wrong, right)
  37
  38 ! qualifier for scalar
  39   wrong = "&z k(2) = 1 /"
  40   right = "&z k    = 1 /"
  41   call test_err(wrong, right)
  42
  43 ! no '=' after object name
  44   wrong = "&z i   1,2 /"
  45   right = "&z i = 1,2 /"
  46   call test_err(wrong, right)
  47
  48 ! repeat count too large
  49   wrong = "&z i = 3*2 /"
  50   right = "&z i = 2*2 /"
  51   call test_err(wrong, right)
  52
  53 ! too much data
  54   wrong = "&z i = 1 2 3 /"
  55   right = "&z i = 1 2 /"
  56   call test_err(wrong, right)
  57
  58 ! no '=' after object name
  59   wrong = "&z i   1,2 /"
  60   right = "&z i = 1,2 /"
  61   call test_err(wrong, right)
  62
  63 ! bad number of index fields
  64   wrong = "&z i(1,2) = 1 /"
  65   right = "&z i(1)   = 1 /"
  66   call test_err(wrong, right)
  67
  68 ! bad character in index field
  69   wrong = "&z i(x) = 1 /"
  70   right = "&z i(1) = 1 /"
  71   call test_err(wrong, right)
  72
  73 ! null index field
  74   wrong = "&z i( ) = 1 /"
  75   right = "&z i(1) = 1 /"
  76   call test_err(wrong, right)
  77
  78 ! null index field
  79   wrong = "&z i(1::)   = 1 2/"
  80   right = "&z i(1:2:1) = 1 2 /"
  81   call test_err(wrong, right)
  82
  83 ! null index field
  84   wrong = "&z i(1:2:)  = 1 2/"
  85   right = "&z i(1:2:1) = 1 2 /"
  86   call test_err(wrong, right)
  87
  88 ! index out of range
  89   wrong = "&z i(10) = 1 /"
  90   right = "&z i(1)  = 1 /"
  91   call test_err(wrong, right)
  92
  93 ! index out of range
  94   wrong = "&z i(0:1) = 1 /"
  95   right = "&z i(1:1) = 1 /"
  96   call test_err(wrong, right)
  97
  98 ! bad range
  99   wrong = "&z i(1:2:-1) = 1 2 /"
 100   right = "&z i(1:2: 1) = 1 2 /"
 101   call test_err(wrong, right)
 102
 103 ! bad range
 104   wrong = "&z i(2:1: 1) = 1 2 /"
 105   right = "&z i(2:1:-1) = 1 2 /"
 106   call test_err(wrong, right)
 107
 108 contains
 109   subroutine test_err(wrong, right)
 110     character*80 wrong, right
 111     integer            :: i(2) = (/0, 0/)
 112     integer            :: k =0
 113     character*2        :: ch = "  "
 114     namelist /z/ i, k, ch
 115
 116 ! Check that wrong namelist input gives an error
 117
 118     open (10, status = "scratch")
 119     write (10, '(A)') wrong
 120     rewind (10)
 121     read (10, z, iostat = ier)
 122     close(10)
 123     if (ier == 0) call abort ()
 124
 125 ! Check that right namelist input gives no error
 126
 127     open (10, status = "scratch")
 128     write (10, '(A)') right
 129     rewind (10)
 130     read (10, z, iostat = ier)
 131     close(10)
 132     if (ier /= 0) call abort ()
 133   end subroutine test_err
 134
 135 end program namelist_19