gcc/testsuite/gfortran.dg/random_seed_1.f90

   1 ! { dg-do compile }
   2
   3 ! Emit a diagnostic for too small PUT array at compile time
   4 ! See PR fortran/37159
   5
   6 ! Updated to check for arrays of unexpected size,
   7 ! this also works for -fdefault-integer-8.
   8 !
   9
  10 PROGRAM random_seed_1
  11   IMPLICIT NONE
  12
  13   INTEGER, PARAMETER :: nbytes = 128
  14
  15   ! +1 due to the special 'p' value in xorshift1024*
  16   ! '+1' to avoid out-of-bounds warnings
  17   INTEGER, PARAMETER    :: n = nbytes / KIND(n) + 2
  18   INTEGER, DIMENSION(n) :: seed
  19
  20   ! Get seed, array too small
  21   CALL RANDOM_SEED(GET=seed(1:(n-2)))  ! { dg-error "too small" }
  22
  23   ! Get seed, array bigger than necessary
  24   CALL RANDOM_SEED(GET=seed(1:n))
  25
  26   ! Get seed, proper size
  27   CALL RANDOM_SEED(GET=seed(1:(n-1)))
  28
  29   ! Put too few bytes
  30   CALL RANDOM_SEED(PUT=seed(1:(n-2)))  ! { dg-error "too small" }
  31
  32   ! Put too many bytes
  33   CALL RANDOM_SEED(PUT=seed(1:n))
  34
  35   ! Put the right amount of bytes
  36   CALL RANDOM_SEED(PUT=seed(1:(n-1)))
  37 END PROGRAM random_seed_1