1! { dg-do run }
2! { dg-skip-if "PR libfortran/78314" { aarch64*-*-gnu* arm*-*-gnueabi arm*-*-gnueabihf } }
3
4module foo
5  use :: ieee_exceptions
6  use :: ieee_arithmetic
7end module foo
8
9module bar
10  use foo
11  use :: ieee_arithmetic, yyy => ieee_support_rounding
12  use :: ieee_arithmetic, zzz => ieee_selected_real_kind
13end module
14
15program test
16  use :: bar
17  use :: ieee_arithmetic, xxx => ieee_support_rounding
18  implicit none
19
20  ! IEEE functions allowed in constant expressions
21
22  integer, parameter :: n1 = ieee_selected_real_kind(0, 0)
23  logical, parameter :: l1 = ieee_support_halting(ieee_overflow)
24  logical, parameter :: l2 = ieee_support_flag(ieee_overflow)
25  logical, parameter :: l3 = ieee_support_flag(ieee_overflow, 0.)
26  logical, parameter :: l4 = ieee_support_rounding(ieee_to_zero)
27  logical, parameter :: l5 = ieee_support_rounding(ieee_to_zero, 0.d0)
28
29  logical, parameter :: l6 = xxx(ieee_to_zero, 0.d0)
30  logical, parameter :: l7 = yyy(ieee_to_zero, 0.d0)
31  integer, parameter :: n2 = zzz(0, 0)
32
33  call gee(8, ieee_to_zero, ieee_overflow)
34
35end
36
37! IEEE functions allowed in specification expressions
38
39subroutine gee(n, rounding, flag)
40  use :: bar
41  implicit none
42
43  integer :: n
44  type(ieee_round_type) :: rounding
45  type(ieee_flag_type) :: flag
46
47  character(len=ieee_selected_real_kind(n)) :: s1
48  character(len=ieee_selected_real_kind(n,2*n)) :: s2
49  character(len=ieee_selected_real_kind(n,2*n,2)) :: s3
50
51  character(len=merge(4,2,ieee_support_rounding(rounding))) :: s4
52  character(len=merge(4,2,ieee_support_rounding(rounding, 0.d0))) :: s5
53
54  character(len=merge(4,2,ieee_support_flag(flag))) :: s6
55  character(len=merge(4,2,ieee_support_flag(flag, 0.))) :: s7
56
57  character(len=merge(4,2,ieee_support_halting(flag))) :: s8
58
59  character(len=merge(4,2,ieee_support_datatype())) :: s9
60  character(len=merge(4,2,ieee_support_datatype(0.))) :: s10
61
62  character(len=merge(4,2,ieee_support_denormal())) :: s11
63  character(len=merge(4,2,ieee_support_denormal(0.))) :: s12
64
65  character(len=merge(4,2,ieee_support_divide())) :: s13
66  character(len=merge(4,2,ieee_support_divide(0.))) :: s14
67
68  character(len=merge(4,2,ieee_support_inf())) :: s15
69  character(len=merge(4,2,ieee_support_inf(0.))) :: s16
70
71  character(len=merge(4,2,ieee_support_io())) :: s17
72  character(len=merge(4,2,ieee_support_io(0.))) :: s18
73
74  character(len=merge(4,2,ieee_support_nan())) :: s19
75  character(len=merge(4,2,ieee_support_nan(0.))) :: s20
76
77  character(len=merge(4,2,ieee_support_sqrt())) :: s21
78  character(len=merge(4,2,ieee_support_sqrt(0.))) :: s22
79
80  character(len=merge(4,2,ieee_support_standard())) :: s23
81  character(len=merge(4,2,ieee_support_standard(0.))) :: s24
82
83  character(len=merge(4,2,ieee_support_underflow_control())) :: s25
84  character(len=merge(4,2,ieee_support_underflow_control(0.))) :: s26
85
86  ! Now, check that runtime values match compile-time constants
87  ! (for those that are allowed)
88
89  integer, parameter :: x1 = ieee_selected_real_kind(8)
90  integer, parameter :: x2 = ieee_selected_real_kind(8,2*8)
91  integer, parameter :: x3 = ieee_selected_real_kind(8,2*8,2)
92
93  integer, parameter :: x4 = merge(4,2,ieee_support_rounding(rounding))
94  integer, parameter :: x5 = merge(4,2,ieee_support_rounding(rounding, 0.d0))
95
96  integer, parameter :: x6 = merge(4,2,ieee_support_flag(ieee_overflow))
97  integer, parameter :: x7 = merge(4,2,ieee_support_flag(ieee_overflow, 0.))
98
99  integer, parameter :: x8 = merge(4,2,ieee_support_halting(ieee_overflow))
100
101  if (len(s1) /= x1) STOP 1
102  if (len(s2) /= x2) STOP 2
103  if (len(s3) /= x3) STOP 3
104
105  if (len(s4) /= x4) STOP 4
106  if (len(s5) /= x5) STOP 5
107
108  if (len(s6) /= x6) STOP 6
109  if (len(s7) /= x7) STOP 7
110
111  if (len(s8) /= x8) STOP 8
112
113end subroutine
114