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