1! { dg-do run } 2! { dg-skip-if "PR libfortran/78314" { aarch64*-*-gnu* arm*-*-gnueabi arm*-*-gnueabihf } } 3! 4! This test will fail on older x86_64 glibc (< 2.20), due to this bug: 5! https://sourceware.org/bugzilla/show_bug.cgi?id=16198 6! We usually won't see it anyway, because on such systems x86_64 assembly 7! (libgfortran/config/fpu-387.h) is used. 8! 9 use :: ieee_arithmetic 10 implicit none 11 12 type(ieee_status_type) :: s1, s2 13 logical :: flags(5), halt(5), haltworks 14 type(ieee_round_type) :: mode 15 real :: x 16 17 ! Test IEEE_GET_STATUS and IEEE_SET_STATUS 18 19 call ieee_set_flag(ieee_all, .false.) 20 call ieee_set_rounding_mode(ieee_down) 21 call ieee_set_halting_mode(ieee_all, .false.) 22 haltworks = ieee_support_halting(ieee_overflow) 23 24 call ieee_get_status(s1) 25 call ieee_set_status(s1) 26 27 call ieee_get_flag(ieee_all, flags) 28 if (any(flags)) STOP 1 29 call ieee_get_rounding_mode(mode) 30 if (mode /= ieee_down) STOP 2 31 call ieee_get_halting_mode(ieee_all, halt) 32 if (any(halt)) STOP 3 33 34 call ieee_set_rounding_mode(ieee_to_zero) 35 call ieee_set_flag(ieee_underflow, .true.) 36 call ieee_set_halting_mode(ieee_overflow, .true.) 37 x = -1 38 x = sqrt(x) 39 if (.not. ieee_is_nan(x)) STOP 4 40 41 call ieee_get_status(s2) 42 43 call ieee_get_flag(ieee_all, flags) 44 if (.not. (all(flags .eqv. [.false.,.false.,.true.,.true.,.false.]) & 45 .or. all(flags .eqv. [.false.,.false.,.true.,.true.,.true.]) & 46 .or. all(flags .eqv. [.false.,.false.,.true.,.false.,.false.]) & 47 .or. all(flags .eqv. [.false.,.false.,.true.,.false.,.true.]))) STOP 5 48 call ieee_get_rounding_mode(mode) 49 if (mode /= ieee_to_zero) STOP 6 50 call ieee_get_halting_mode(ieee_all, halt) 51 if ((haltworks .and. .not. halt(1)) .or. any(halt(2:))) STOP 7 52 53 call ieee_set_status(s2) 54 55 call ieee_get_flag(ieee_all, flags) 56 if (.not. (all(flags .eqv. [.false.,.false.,.true.,.true.,.false.]) & 57 .or. all(flags .eqv. [.false.,.false.,.true.,.true.,.true.]) & 58 .or. all(flags .eqv. [.false.,.false.,.true.,.false.,.false.]) & 59 .or. all(flags .eqv. [.false.,.false.,.true.,.false.,.true.]))) STOP 8 60 call ieee_get_rounding_mode(mode) 61 if (mode /= ieee_to_zero) STOP 9 62 call ieee_get_halting_mode(ieee_all, halt) 63 if ((haltworks .and. .not. halt(1)) .or. any(halt(2:))) STOP 10 64 65 call ieee_set_status(s1) 66 67 call ieee_get_flag(ieee_all, flags) 68 if (any(flags)) STOP 11 69 call ieee_get_rounding_mode(mode) 70 if (mode /= ieee_down) STOP 12 71 call ieee_get_halting_mode(ieee_all, halt) 72 if (any(halt)) STOP 13 73 74 call ieee_set_status(s2) 75 76 call ieee_get_flag(ieee_all, flags) 77 if (.not. (all(flags .eqv. [.false.,.false.,.true.,.true.,.false.]) & 78 .or. all(flags .eqv. [.false.,.false.,.true.,.true.,.true.]) & 79 .or. all(flags .eqv. [.false.,.false.,.true.,.false.,.false.]) & 80 .or. all(flags .eqv. [.false.,.false.,.true.,.false.,.true.]))) STOP 14 81 call ieee_get_rounding_mode(mode) 82 if (mode /= ieee_to_zero) STOP 15 83 call ieee_get_halting_mode(ieee_all, halt) 84 if ((haltworks .and. .not. halt(1)) .or. any(halt(2:))) STOP 16 85 86end 87