OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [random_seed_1.f90] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { 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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.