blob: 945b05505c115c9d7210fc29df46f10155caedb2 [file] [log] [blame]
!{ dg-do run }
!{ dg-options "-std=legacy" }
!
! Test namelist error trapping.
! provided by Paul Thomas - pault@gcc.gnu.org
program namelist_19
character*80 wrong, right
! "=" before any object name
wrong = "&z = i = 1,2 /"
right = "&z i = 1,2 /"
call test_err(wrong, right)
! &* instead of &end for termination
wrong = "&z i = 1,2 &xxx"
right = "&z i = 1,2 &end"
call test_err(wrong, right)
! bad data
wrong = "&z i = 1,q /"
right = "&z i = 1,2 /"
call test_err(wrong, right)
! object name not matched
wrong = "&z j = 1,2 /"
right = "&z i = 1,2 /"
call test_err(wrong, right)
! derived type component for intrinsic type
wrong = "&z i%j = 1,2 /"
right = "&z i = 1,2 /"
call test_err(wrong, right)
! step other than 1 for substring qualifier
wrong = "&z ch(1:2:2) = 'a'/"
right = "&z ch(1:2) = 'ab' /"
call test_err(wrong, right)
! qualifier for scalar
wrong = "&z k(2) = 1 /"
right = "&z k = 1 /"
call test_err(wrong, right)
! no '=' after object name
wrong = "&z i 1,2 /"
right = "&z i = 1,2 /"
call test_err(wrong, right)
! repeat count too large
wrong = "&z i = 3*2 /"
right = "&z i = 2*2 /"
call test_err(wrong, right)
! too much data
wrong = "&z i = 1 2 3 /"
right = "&z i = 1 2 /"
call test_err(wrong, right)
! no '=' after object name
wrong = "&z i 1,2 /"
right = "&z i = 1,2 /"
call test_err(wrong, right)
! bad number of index fields
wrong = "&z i(1,2) = 1 /"
right = "&z i(1) = 1 /"
call test_err(wrong, right)
! bad character in index field
wrong = "&z i(x) = 1 /"
right = "&z i(1) = 1 /"
call test_err(wrong, right)
! null index field
wrong = "&z i( ) = 1 /"
right = "&z i(1) = 1 /"
call test_err(wrong, right)
! null index field
wrong = "&z i(1::) = 1 2/"
right = "&z i(1:2:1) = 1 2 /"
call test_err(wrong, right)
! null index field
wrong = "&z i(1:2:) = 1 2/"
right = "&z i(1:2:1) = 1 2 /"
call test_err(wrong, right)
! index out of range
wrong = "&z i(10) = 1 /"
right = "&z i(1) = 1 /"
call test_err(wrong, right)
! index out of range
wrong = "&z i(0:1) = 1 /"
right = "&z i(1:1) = 1 /"
call test_err(wrong, right)
! bad range
wrong = "&z i(1:2:-1) = 1 2 /"
right = "&z i(1:2: 1) = 1 2 /"
call test_err(wrong, right)
! bad range
wrong = "&z i(2:1: 1) = 1 2 /"
right = "&z i(2:1:-1) = 1 2 /"
call test_err(wrong, right)
contains
subroutine test_err(wrong, right)
character*80 wrong, right
integer :: i(2) = (/0, 0/)
integer :: k =0
character*2 :: ch = " "
namelist /z/ i, k, ch
! Check that wrong namelist input gives an error
open (10, status = "scratch")
write (10, '(A)') wrong
rewind (10)
read (10, z, iostat = ier)
close(10)
if (ier == 0) STOP 1
! Check that right namelist input gives no error
open (10, status = "scratch")
write (10, '(A)') right
rewind (10)
read (10, z, iostat = ier)
close(10)
if (ier /= 0) STOP 2
end subroutine test_err
end program namelist_19