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 ! Possible improvement:
   7 ! Provide a separate testcase for systems that support REAL(16),
   8 ! to test the minimum size of 12 (instead of 8).
   9 !
  10 ! Updated to check for arrays of unexpected size,
  11 ! this also works for -fdefault-integer-8.
  12 !
  13
  14 PROGRAM random_seed_1
  15   IMPLICIT NONE
  16   INTEGER, PARAMETER :: k = selected_real_kind (precision (0.0_8) + 1)
  17   INTEGER, PARAMETER :: nbytes = MERGE(48, 32, k == 16)
  18
  19   ! '+1' to avoid out-of-bounds warnings
  20   INTEGER, PARAMETER    :: n = nbytes / KIND(n) + 1
  21   INTEGER, DIMENSION(n) :: seed
  22
  23   ! Get seed, array too small
  24   CALL RANDOM_SEED(GET=seed(1:(n-2)))  ! { dg-error "too small" }
  25
  26   ! Get seed, array bigger than necessary
  27   CALL RANDOM_SEED(GET=seed(1:n))
  28
  29   ! Get seed, proper size
  30   CALL RANDOM_SEED(GET=seed(1:(n-1)))
  31
  32   ! Put too few bytes
  33   CALL RANDOM_SEED(PUT=seed(1:(n-2)))  ! { dg-error "too small" }
  34
  35   ! Put too many bytes
  36   CALL RANDOM_SEED(PUT=seed(1:n))
  37
  38   ! Put the right amount of bytes
  39   CALL RANDOM_SEED(PUT=seed(1:(n-1)))
  40 END PROGRAM random_seed_1