libgomp/testsuite/libgomp.fortran/rwlock_3.f90

   1 ! { dg-do run }
   2 ! Find or create the same unit number in concurrency,
   3 ! at beginning, threads cannot find the unit in cache or unit list,
   4 ! then threads will acquire the write lock to insert unit.
   5 ! This test case is used to ensure that no duplicate unit number will be
   6 ! inserted into cache nor unit list when same unit was accessed in concurrency.
   7 program main
   8   use omp_lib
   9   implicit none
  10   integer:: i
  11   !$omp parallel private (i)
  12     do i = 1, 100
  13       open (10, file='tst.dat', asynchronous="yes")
  14       ! Delete the unit number from cache and unit list to stress write lock.
  15       close (10, status="delete")
  16     end do
  17   !$omp end parallel
  18 end program