1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
! { dg-do compile }
! Emit a diagnostic for too small PUT array at compile time
! See PR fortran/37159
! Possible improvement:
! Provide a separate testcase for systems that support REAL(16),
! to test the minimum size of 12 (instead of 8).
!
! Updated to check for arrays of unexpected size,
! this also works for -fdefault-integer-8.
!
PROGRAM random_seed_1
IMPLICIT NONE
! Find out what the's largest kind size
INTEGER, PARAMETER :: k1 = kind (0.d0)
INTEGER, PARAMETER :: &
k2 = max (k1, selected_real_kind (precision (0._k1) + 1))
INTEGER, PARAMETER :: &
k3 = max (k2, selected_real_kind (precision (0._k2) + 1))
INTEGER, PARAMETER :: &
k4 = max (k3, selected_real_kind (precision (0._k3) + 1))
INTEGER, PARAMETER :: nbytes = MERGE(48, 32, k4 == 16)
! '+1' to avoid out-of-bounds warnings
INTEGER, PARAMETER :: n = nbytes / KIND(n) + 1
INTEGER, DIMENSION(n) :: seed
! Get seed, array too small
CALL RANDOM_SEED(GET=seed(1:(n-2))) ! { dg-error "too small" }
! Get seed, array bigger than necessary
CALL RANDOM_SEED(GET=seed(1:n))
! Get seed, proper size
CALL RANDOM_SEED(GET=seed(1:(n-1)))
! Put too few bytes
CALL RANDOM_SEED(PUT=seed(1:(n-2))) ! { dg-error "too small" }
! Put too many bytes
CALL RANDOM_SEED(PUT=seed(1:n))
! Put the right amount of bytes
CALL RANDOM_SEED(PUT=seed(1:(n-1)))
END PROGRAM random_seed_1
|
