1! { dg-do run { target fd_truncate } } 2! { dg-options "-fdec" } 3! 4! Run-time tests for values of DEC I/O parameters (doesn't test functionality). 5! 6 7subroutine check_cc (fd, cc) 8 implicit none 9 character(*), intent(in) :: cc 10 integer, intent(in) :: fd 11 character(20) :: cc_inq 12 inquire(unit=fd, carriagecontrol=cc_inq) 13 if (cc_inq .ne. cc) then 14 print *, '(', fd, ') cc expected ', cc, ' was ', cc_inq 15 STOP 1 16 endif 17endsubroutine 18 19subroutine check_share (fd, share) 20 implicit none 21 character(*), intent(in) :: share 22 integer, intent(in) :: fd 23 character(20) :: share_inq 24 inquire(unit=fd, share=share_inq) 25 if (share_inq .ne. share) then 26 print *, '(', fd, ') share expected ', share, ' was ', share_inq 27 STOP 2 28 endif 29endsubroutine 30 31subroutine check_action (fd, acc) 32 implicit none 33 character(*), intent(in) :: acc 34 integer, intent(in) :: fd 35 character(20) acc_inq 36 inquire(unit=fd, action=acc_inq) 37 if (acc_inq .ne. acc) then 38 print *, '(', fd, ') access expected ', acc, ' was ', acc_inq 39 STOP 3 40 endif 41endsubroutine 42 43implicit none 44 45integer, parameter :: fd=3 46character(*), parameter :: fname = 'dec_io_1.txt' 47 48!!!! <default> 49 50open(unit=fd, file=fname, action='WRITE') 51call check_cc(fd, 'LIST') 52call check_share(fd, 'NODENY') 53write (fd,*) 'test' 54close(unit=fd) 55 56!!!! READONLY 57 58open (unit=fd, file=fname, readonly) 59call check_action(fd, 'READ') 60close (unit=fd) 61 62!!!! SHARED / SHARE='DENYNONE' 63 64open (unit=fd, file=fname, action='read', shared) 65call check_share(fd, 'DENYNONE') 66close (unit=fd) 67 68open (unit=fd, file=fname, action='read', share='DENYNONE') 69call check_share(fd, 'DENYNONE') 70close (unit=fd) 71 72!!!! NOSHARED / SHARE='DENYRW' 73 74open (unit=fd, file=fname, action='write', noshared) 75call check_share(fd, 'DENYRW') 76close (unit=fd) 77 78open (unit=fd, file=fname, action='write', share='DENYRW') 79call check_share(fd, 'DENYRW') 80close (unit=fd) 81 82!!!! CC=FORTRAN 83 84open(unit=fd, file=fname, action ='WRITE', carriagecontrol='FORTRAN') 85call check_cc(fd, 'FORTRAN') 86close(unit=fd) 87 88!!!! CC=LIST 89 90open(unit=fd, file=fname, action ='WRITE', carriagecontrol='LIST') 91call check_cc(fd, 'LIST') 92close(unit=fd) 93 94!!!! CC=NONE 95 96open(unit=fd, file=fname, action ='WRITE', carriagecontrol='NONE') 97call check_cc(fd, 'NONE') 98close(unit=fd, status='delete') ! cleanup temp file 99 100 101end 102