gcc/testsuite/gfortran.dg/dec_io_1.f90

   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
   7 subroutine 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
  17 endsubroutine
  18
  19 subroutine 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
  29 endsubroutine
  30
  31 subroutine 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
  41 endsubroutine
  42
  43 implicit none
  44
  45 integer, parameter :: fd=3
  46 character(*), parameter :: fname  = 'dec_io_1.txt'
  47
  48 !!!! <default>
  49
  50 open(unit=fd,  file=fname, action='WRITE')
  51 call check_cc(fd, 'LIST')
  52 call check_share(fd, 'NODENY')
  53 write (fd,*) 'test'
  54 close(unit=fd)
  55
  56 !!!! READONLY
  57
  58 open (unit=fd, file=fname, readonly)
  59 call check_action(fd, 'READ')
  60 close (unit=fd)
  61
  62 !!!! SHARED / SHARE='DENYNONE'
  63
  64 open (unit=fd, file=fname, action='read', shared)
  65 call check_share(fd, 'DENYNONE')
  66 close (unit=fd)
  67
  68 open (unit=fd, file=fname, action='read', share='DENYNONE')
  69 call check_share(fd, 'DENYNONE')
  70 close (unit=fd)
  71
  72 !!!! NOSHARED / SHARE='DENYRW'
  73
  74 open (unit=fd, file=fname, action='write', noshared)
  75 call check_share(fd, 'DENYRW')
  76 close (unit=fd)
  77
  78 open (unit=fd, file=fname, action='write', share='DENYRW')
  79 call check_share(fd, 'DENYRW')
  80 close (unit=fd)
  81
  82 !!!! CC=FORTRAN
  83
  84 open(unit=fd,  file=fname, action ='WRITE', carriagecontrol='FORTRAN')
  85 call check_cc(fd, 'FORTRAN')
  86 close(unit=fd)
  87
  88 !!!! CC=LIST
  89
  90 open(unit=fd,  file=fname, action ='WRITE', carriagecontrol='LIST')
  91 call check_cc(fd, 'LIST')
  92 close(unit=fd)
  93
  94 !!!! CC=NONE
  95
  96 open(unit=fd,  file=fname, action ='WRITE', carriagecontrol='NONE')
  97 call check_cc(fd, 'NONE')
  98 close(unit=fd, status='delete') ! cleanup temp file
  99
 100
 101 end