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