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
  17   ! Find out what the's largest kind size
  18   INTEGER, PARAMETER :: k1 = kind (0.d0)
  19   INTEGER, PARAMETER :: &
  20     k2 = max (k1, selected_real_kind (precision (0._k1) + 1))
  21   INTEGER, PARAMETER :: &
  22     k3 = max (k2, selected_real_kind (precision (0._k2) + 1))
  23   INTEGER, PARAMETER :: &
  24     k4 = max (k3, selected_real_kind (precision (0._k3) + 1))
  25
  26   INTEGER, PARAMETER :: nbytes = MERGE(48, 32, k4 == 16)
  27
  28   ! '+1' to avoid out-of-bounds warnings
  29   INTEGER, PARAMETER    :: n = nbytes / KIND(n) + 1
  30   INTEGER, DIMENSION(n) :: seed
  31
  32   ! Get seed, array too small
  33   CALL RANDOM_SEED(GET=seed(1:(n-2)))  ! { dg-error "too small" }
  34
  35   ! Get seed, array bigger than necessary
  36   CALL RANDOM_SEED(GET=seed(1:n))
  37
  38   ! Get seed, proper size
  39   CALL RANDOM_SEED(GET=seed(1:(n-1)))
  40
  41   ! Put too few bytes
  42   CALL RANDOM_SEED(PUT=seed(1:(n-2)))  ! { dg-error "too small" }
  43
  44   ! Put too many bytes
  45   CALL RANDOM_SEED(PUT=seed(1:n))
  46
  47   ! Put the right amount of bytes
  48   CALL RANDOM_SEED(PUT=seed(1:(n-1)))
  49 END PROGRAM random_seed_1