gcc/testsuite/gfortran.dg/random_init_3.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fcoarray=single" }
   3 program rantest
   4
   5    implicit none
   6
   7    logical, parameter :: debug = .false.
   8    character(len=20) name
   9    integer fd, i, n
  10    integer, allocatable :: n1(:), n2(:), n3(:)
  11    real x(4), y(4), z(4)
  12
  13    if (debug) then
  14       write(name,'(A,I0)') 'dat', this_image()
  15       open(newunit=fd, file=name)
  16    end if
  17
  18    call random_seed(size=n)
  19    allocate(n1(n), n2(n), n3(n))
  20    !
  21    ! Setup repeatable sequences (if co-arrays the seeds should be distinct
  22    ! are different).  Get the seeds.
  23    !
  24    call random_init(.true., .true.)
  25    call random_seed(get=n1)
  26    call random_number(x)               ! This changes internal state.
  27    if (debug) then
  28       write(fd,'(A,4F12.6)') 'x = ', x
  29    end if
  30
  31    call random_seed(get=n2)            ! Grab current state.
  32    !
  33    ! Use the gotten seed to reseed PRNG and grab sequence.
  34    ! It should be the same sequence.
  35    !
  36    call random_seed(put=n1)
  37    call random_number(y)
  38    if (debug) then
  39       write(fd,'(A,4F12.6)') 'y = ', y
  40    end if
  41    !
  42    ! Setup repeatable sequences (if co-arrays the seeds should be distinct
  43    ! are different).  Get the seeds.  It should be the same sequence.
  44    !
  45    call random_init(.true., .true.)
  46    call random_seed(get=n3)
  47    call random_number(z)
  48    if (debug) then
  49       write(fd,'(A,4F12.6)') 'z = ', z
  50    end if
  51
  52    x = int(1e6*x) ! Convert to integer with at most 6 digits.
  53    y = int(1e6*y) ! Convert to integer with at most 6 digits.
  54    z = int(1e6*z) ! Convert to integer with at most 6 digits.
  55
  56    if (any(x /= y)) call abort
  57    if (any(x /= z)) call abort
  58
  59    if (debug) then
  60       write(fd,*)
  61       do i = 1, n
  62          if (n1(i) - n2(i) /= 0) then
  63             write(fd,*) 'n1 /= n2', i, n1(i), n2(i)
  64          end if
  65       end do
  66       write(fd,*)
  67       do i = 1, n
  68          if (n1(i) - n3(i) /= 0) then
  69             write(fd,*) 'n1 /= n3', i, n1(i), n3(i)
  70          end if
  71       end do
  72    end if
  73
  74 end program rantest