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
14PROGRAM 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)))
49END PROGRAM random_seed_1
50