3 ! Emit a diagnostic for too small PUT array at compile time
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).
10 ! Updated to check for arrays of unexpected size,
11 ! this also works for -fdefault-integer-8.
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))
26 INTEGER, PARAMETER :: nbytes
= MERGE(48, 32, k4
== 16)
28 ! '+1' to avoid out-of-bounds warnings
29 INTEGER, PARAMETER :: n
= nbytes
/ KIND(n
) + 1
30 INTEGER, DIMENSION(n
) :: seed
32 ! Get seed, array too small
33 CALL RANDOM_SEED(GET
=seed(1:(n
-2))) ! { dg-error "too small" }
35 ! Get seed, array bigger than necessary
36 CALL RANDOM_SEED(GET
=seed(1:n
))
38 ! Get seed, proper size
39 CALL RANDOM_SEED(GET
=seed(1:(n
-1)))
42 CALL RANDOM_SEED(PUT
=seed(1:(n
-2))) ! { dg-error "too small" }
45 CALL RANDOM_SEED(PUT
=seed(1:n
))
47 ! Put the right amount of bytes
48 CALL RANDOM_SEED(PUT
=seed(1:(n
-1)))
49 END PROGRAM random_seed_1