re PR fortran/64022 ([F2003][IEEE] ieee_support_flag does not handle kind=10 and...

	PR fortran/64022

	* simplify.c (gfc_simplify_ieee_selected_real_kind): Extend IEEE
	support to all real kinds.

	* ieee/ieee_exceptions.F90: Support all real kinds.
	* ieee/ieee_arithmetic.F90: Likewise.
	* ieee/ieee_helper.c (ieee_class_helper_10,
	ieee_class_helper_16): New functions
	* gfortran.map (GFORTRAN_1.7): Add entries.

	* gfortran.dg/ieee/ieee_7.f90: Adjust test.
	* gfortran.dg/ieee/large_1.f90: New test.

From-SVN: r226548

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 36cd6f3b4cd694fc2ca88d80093b713fa048024c..46f9a927938490e3e03c6c42b23413101e4afd47 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2015-08-04  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/64022
+       * simplify.c (gfc_simplify_ieee_selected_real_kind): Extend IEEE
+       support to all real kinds.
+
 2015-08-03  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/66942

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 3fb98873709b284e4c332e95e4c3d9071b497c91..f0fdfbdfa0d48c6d73ad0150d287050109de7f15 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -5556,80 +5556,13 @@ gfc_expr *
 gfc_simplify_ieee_selected_real_kind (gfc_expr *expr)
 {
   gfc_actual_arglist *arg = expr->value.function.actual;
-  gfc_expr *p = arg->expr, *r = arg->next->expr,
-          *rad = arg->next->next->expr;
-  int precision, range, radix, res;
-  int found_precision, found_range, found_radix, i;
+  gfc_expr *p = arg->expr, *q = arg->next->expr,
+          *rdx = arg->next->next->expr;
 
-  if (p)
-  {
-    if (p->expr_type != EXPR_CONSTANT
-       || gfc_extract_int (p, &precision) != NULL)
-      return NULL;
-  }
-  else
-    precision = 0;
-
-  if (r)
-  {
-    if (r->expr_type != EXPR_CONSTANT
-       || gfc_extract_int (r, &range) != NULL)
-      return NULL;
-  }
-  else
-    range = 0;
-
-  if (rad)
-  {
-    if (rad->expr_type != EXPR_CONSTANT
-       || gfc_extract_int (rad, &radix) != NULL)
-      return NULL;
-  }
-  else
-    radix = 0;
-
-  res = INT_MAX;
-  found_precision = 0;
-  found_range = 0;
-  found_radix = 0;
-
-  for (i = 0; gfc_real_kinds[i].kind != 0; i++)
-    {
-      /* We only support the target's float and double types.  */
-      if (!gfc_real_kinds[i].c_float && !gfc_real_kinds[i].c_double)
-       continue;
-
-      if (gfc_real_kinds[i].precision >= precision)
-       found_precision = 1;
-
-      if (gfc_real_kinds[i].range >= range)
-       found_range = 1;
-
-      if (radix == 0 || gfc_real_kinds[i].radix == radix)
-       found_radix = 1;
-
-      if (gfc_real_kinds[i].precision >= precision
-         && gfc_real_kinds[i].range >= range
-         && (radix == 0 || gfc_real_kinds[i].radix == radix)
-         && gfc_real_kinds[i].kind < res)
-       res = gfc_real_kinds[i].kind;
-    }
-
-  if (res == INT_MAX)
-    {
-      if (found_radix && found_range && !found_precision)
-       res = -1;
-      else if (found_radix && found_precision && !found_range)
-       res = -2;
-      else if (found_radix && !found_precision && !found_range)
-       res = -3;
-      else if (found_radix)
-       res = -4;
-      else
-       res = -5;
-    }
-
-  return gfc_get_int_expr (gfc_default_integer_kind, &expr->where, res);
+  /* Currently, if IEEE is supported and this module is built, it means
+     all our floating-point types conform to IEEE. Hence, we simply handle
+     IEEE_SELECTED_REAL_KIND like SELECTED_REAL_KIND.  */
+  return gfc_simplify_selected_real_kind (p, q, rdx);
 }
 
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ae404d3040936821470a8e9517dd78b0050d4f6d..3a9143d09c13c45e331ccb1fd86ea6872dd94b26 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2015-08-04  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/64022
+       * gfortran.dg/ieee/ieee_7.f90: Adjust test.
+       * gfortran.dg/ieee/large_1.f90: New test.
+
 2015-08-04  Thomas Preud'homme  <thomas.preudhomme@arm.com>
 
        PR tree-optimization/67043

diff --git a/gcc/testsuite/gfortran.dg/ieee/ieee_7.f90 b/gcc/testsuite/gfortran.dg/ieee/ieee_7.f90
index a66e9057bec7635796578351f92ab4a54c95c3d8..227bf544cc12780254564575f9b46f58e8ea8110 100644 (file)
--- a/gcc/testsuite/gfortran.dg/ieee/ieee_7.f90
+++ b/gcc/testsuite/gfortran.dg/ieee/ieee_7.f90
@@ -1,8 +1,14 @@
 ! { dg-do run }
 
   use :: ieee_arithmetic
+  use :: iso_fortran_env, only : real_kinds
   implicit none
 
+  ! This should be 
+  ! integer, parameter :: maxreal = maxval(real_kinds)
+  ! but it works because REAL_KINDS happen to be in increasing order
+  integer, parameter :: maxreal = real_kinds(size(real_kinds))
+
   ! Test IEEE_SELECTED_REAL_KIND in specification expressions
 
   integer(kind=ieee_selected_real_kind()) :: i1
@@ -27,8 +33,8 @@
   end if
 
   if (ieee_selected_real_kind(0,0,3) /= -5) call abort
-  if (ieee_selected_real_kind(precision(0.d0)+1) /= -1) call abort
-  if (ieee_selected_real_kind(0,range(0.d0)+1) /= -2) call abort
-  if (ieee_selected_real_kind(precision(0.d0)+1,range(0.d0)+1) /= -3) call abort
+  if (ieee_selected_real_kind(precision(0._maxreal)+1) /= -1) call abort
+  if (ieee_selected_real_kind(0,range(0._maxreal)+1) /= -2) call abort
+  if (ieee_selected_real_kind(precision(0._maxreal)+1,range(0._maxreal)+1) /= -3) call abort
 
 end

diff --git a/gcc/testsuite/gfortran.dg/ieee/large_1.f90 b/gcc/testsuite/gfortran.dg/ieee/large_1.f90
new file mode 100644 (file)
index 0000000..5ec2dab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ieee/large_1.f90
@@ -0,0 +1,138 @@
+! { dg-do run }
+!
+! Testing IEEE modules on large real kinds
+
+program test
+
+  use ieee_arithmetic
+  implicit none
+
+  ! k1 and k2 will be large real kinds, if supported, and single/double
+  ! otherwise
+  integer, parameter :: k1 = &
+    max(ieee_selected_real_kind(precision(0.d0) + 1), kind(0.))
+  integer, parameter :: k2 = &
+    max(ieee_selected_real_kind(precision(0._k1) + 1), kind(0.d0))
+
+  real(kind=k1) :: x1, y1
+  real(kind=k2) :: x2, y2
+
+  ! Checking ieee_is_finite
+
+  if (.not. ieee_is_finite(huge(0._k1))) call abort
+  if (ieee_is_finite(ieee_value(0._k1, ieee_negative_inf))) call abort
+  x1 = -42
+  if (.not. ieee_is_finite(x1)) call abort
+  if (ieee_is_finite(sqrt(x1))) call abort
+
+  if (.not. ieee_is_finite(huge(0._k2))) call abort
+  if (ieee_is_finite(ieee_value(0._k2, ieee_negative_inf))) call abort
+  x2 = -42
+  if (.not. ieee_is_finite(x2)) call abort
+  if (ieee_is_finite(sqrt(x2))) call abort
+
+  ! Other ieee_is intrinsics
+
+  if (ieee_is_nan(huge(0._k1))) call abort
+  if (.not. ieee_is_negative(-huge(0._k1))) call abort
+  if (.not. ieee_is_normal(-huge(0._k1))) call abort
+
+  if (ieee_is_nan(huge(0._k2))) call abort
+  if (.not. ieee_is_negative(-huge(0._k2))) call abort
+  if (.not. ieee_is_normal(-huge(0._k2))) call abort
+
+  ! ieee_support intrinsics
+
+  if (.not. ieee_support_datatype(x1)) call abort
+  if (.not. ieee_support_denormal(x1)) call abort
+  if (.not. ieee_support_divide(x1)) call abort
+  if (.not. ieee_support_inf(x1)) call abort
+  if (.not. ieee_support_io(x1)) call abort
+  if (.not. ieee_support_nan(x1)) call abort
+  if (.not. ieee_support_rounding(ieee_nearest, x1)) call abort
+  if (.not. ieee_support_sqrt(x1)) call abort
+  if (.not. ieee_support_standard(x1)) call abort
+  if (.not. ieee_support_underflow_control(x1)) call abort
+
+  if (.not. ieee_support_datatype(x2)) call abort
+  if (.not. ieee_support_denormal(x2)) call abort
+  if (.not. ieee_support_divide(x2)) call abort
+  if (.not. ieee_support_inf(x2)) call abort
+  if (.not. ieee_support_io(x2)) call abort
+  if (.not. ieee_support_nan(x2)) call abort
+  if (.not. ieee_support_rounding(ieee_nearest, x2)) call abort
+  if (.not. ieee_support_sqrt(x2)) call abort
+  if (.not. ieee_support_standard(x2)) call abort
+  if (.not. ieee_support_underflow_control(x2)) call abort
+
+  ! ieee_value and ieee_class
+
+  if (.not. ieee_is_nan(ieee_value(x1, ieee_quiet_nan))) call abort
+  if (ieee_class(ieee_value(x1, ieee_positive_denormal)) &
+    /= ieee_positive_denormal) call abort
+
+  if (.not. ieee_is_nan(ieee_value(x2, ieee_quiet_nan))) call abort
+  if (ieee_class(ieee_value(x2, ieee_positive_denormal)) &
+    /= ieee_positive_denormal) call abort
+
+  ! ieee_unordered
+
+  if (.not. ieee_unordered(ieee_value(x1, ieee_quiet_nan), 0._k1)) call abort
+  if (ieee_unordered(ieee_value(x1, ieee_negative_inf), 0._k1)) call abort
+
+  if (.not. ieee_unordered(ieee_value(x2, ieee_quiet_nan), 0._k2)) call abort
+  if (ieee_unordered(ieee_value(x2, ieee_negative_inf), 0._k2)) call abort
+
+  ! ieee_copy_sign
+
+  if (.not. ieee_class(ieee_copy_sign(ieee_value(x1, ieee_positive_inf), -1.)) &
+            == ieee_negative_inf) call abort
+  if (.not. ieee_class(ieee_copy_sign(0._k1, -42._k2)) &
+            == ieee_negative_zero) call abort
+
+  if (.not. ieee_class(ieee_copy_sign(ieee_value(x2, ieee_positive_inf), -1.)) &
+            == ieee_negative_inf) call abort
+  if (.not. ieee_class(ieee_copy_sign(0._k2, -42._k1)) &
+            == ieee_negative_zero) call abort
+
+  ! ieee_logb
+
+  if (ieee_logb (42._k1) /= exponent(42._k1) - 1) call abort
+
+  if (ieee_logb (42._k2) /= exponent(42._k2) - 1) call abort
+
+  ! ieee_next_after
+
+  if (ieee_next_after(42._k1, ieee_value(x1, ieee_positive_inf)) &
+      /= 42._k1 + spacing(42._k1)) call abort
+
+  if (ieee_next_after(42._k2, ieee_value(x2, ieee_positive_inf)) &
+      /= 42._k2 + spacing(42._k2)) call abort
+
+  ! ieee_rem
+
+  if (ieee_class(ieee_rem(-42._k1, 2._k1)) /= ieee_negative_zero) &
+    call abort
+
+  if (ieee_class(ieee_rem(-42._k2, 2._k2)) /= ieee_negative_zero) &
+    call abort
+
+  ! ieee_rint
+
+  if (ieee_rint(-1.1_k1) /= -1._k1) call abort
+  if (ieee_rint(huge(x1)) /= huge(x1)) call abort
+
+  if (ieee_rint(-1.1_k2) /= -1._k2) call abort
+  if (ieee_rint(huge(x2)) /= huge(x2)) call abort
+
+  ! ieee_scalb
+
+  x1 = sqrt(42._k1)
+  if (ieee_scalb(x1, 2) /= 4._k1 * x1) call abort
+  if (ieee_scalb(x1, -2) /= x1 / 4._k1) call abort
+
+  x2 = sqrt(42._k2)
+  if (ieee_scalb(x2, 2) /= 4._k2 * x2) call abort
+  if (ieee_scalb(x2, -2) /= x2 / 4._k2) call abort
+
+end program test

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 29efe0ad486ed010f0babcc5f3daf508203cd6e3..e74bff61dac7b37a41eba47a75900aa9a6017734 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,12 @@
+2015-08-04  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/64022
+       * ieee/ieee_exceptions.F90: Support all real kinds.
+       * ieee/ieee_arithmetic.F90: Likewise.
+       * ieee/ieee_helper.c (ieee_class_helper_10,
+       ieee_class_helper_16): New functions
+       * gfortran.map (GFORTRAN_1.7): Add entries.
+
 2015-07-29  Uros Bizjak  <ubizjak@gmail.com>
 
        PR libgfortran/66650

diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index cfbfb160a52a1b31122f926fc8acad01d1cba6dc..73cdde7857142305e3782d6a13b94cc5bf2e0ad1 100644 (file)
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1276,6 +1276,16 @@ GFORTRAN_1.6 {
     __ieee_exceptions_MOD_ieee_usual;
 } GFORTRAN_1.5; 
 
+GFORTRAN_1.7 {
+  global:
+    __ieee_arithmetic_MOD_ieee_class_10;
+    __ieee_arithmetic_MOD_ieee_class_16;
+    __ieee_arithmetic_MOD_ieee_value_10;
+    __ieee_arithmetic_MOD_ieee_value_16;
+    __ieee_exceptions_MOD_ieee_support_flag_10;
+    __ieee_exceptions_MOD_ieee_support_flag_16;
+} GFORTRAN_1.6; 
+
 F2C_1.0 {
   global:
     _gfortran_f2c_specific__abs_c4;

diff --git a/libgfortran/ieee/ieee_arithmetic.F90 b/libgfortran/ieee/ieee_arithmetic.F90
index f81a4f89e1329c3d7d784caa9bd3c6f9453837f1..89456cf15502bcbc6e00bd6c9fbeb463e1841b46 100644 (file)
--- a/libgfortran/ieee/ieee_arithmetic.F90
+++ b/libgfortran/ieee/ieee_arithmetic.F90
@@ -95,10 +95,27 @@ module IEEE_ARITHMETIC
     elemental logical function _gfortran_ieee_is_finite_8(X)
       real(kind=8), intent(in) :: X
     end function
+#ifdef HAVE_GFC_REAL_10
+    elemental logical function _gfortran_ieee_is_finite_10(X)
+      real(kind=10), intent(in) :: X
+    end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+    elemental logical function _gfortran_ieee_is_finite_16(X)
+      real(kind=16), intent(in) :: X
+    end function
+#endif
   end interface
 
   interface IEEE_IS_FINITE
-    procedure _gfortran_ieee_is_finite_4, _gfortran_ieee_is_finite_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_is_finite_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_is_finite_10, &
+#endif
+      _gfortran_ieee_is_finite_8, _gfortran_ieee_is_finite_4
   end interface
   public :: IEEE_IS_FINITE
 
@@ -111,10 +128,27 @@ module IEEE_ARITHMETIC
     elemental logical function _gfortran_ieee_is_nan_8(X)
       real(kind=8), intent(in) :: X
     end function
+#ifdef HAVE_GFC_REAL_10
+    elemental logical function _gfortran_ieee_is_nan_10(X)
+      real(kind=10), intent(in) :: X
+    end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+    elemental logical function _gfortran_ieee_is_nan_16(X)
+      real(kind=16), intent(in) :: X
+    end function
+#endif
   end interface
 
   interface IEEE_IS_NAN
-    procedure _gfortran_ieee_is_nan_4, _gfortran_ieee_is_nan_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_is_nan_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_is_nan_10, &
+#endif
+      _gfortran_ieee_is_nan_8, _gfortran_ieee_is_nan_4
   end interface
   public :: IEEE_IS_NAN
 
@@ -127,10 +161,27 @@ module IEEE_ARITHMETIC
     elemental logical function _gfortran_ieee_is_negative_8(X)
       real(kind=8), intent(in) :: X
     end function
+#ifdef HAVE_GFC_REAL_10
+    elemental logical function _gfortran_ieee_is_negative_10(X)
+      real(kind=10), intent(in) :: X
+    end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+    elemental logical function _gfortran_ieee_is_negative_16(X)
+      real(kind=16), intent(in) :: X
+    end function
+#endif
   end interface
 
   interface IEEE_IS_NEGATIVE
-    procedure _gfortran_ieee_is_negative_4, _gfortran_ieee_is_negative_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_is_negative_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_is_negative_10, &
+#endif
+      _gfortran_ieee_is_negative_8, _gfortran_ieee_is_negative_4
   end interface
   public :: IEEE_IS_NEGATIVE
 
@@ -143,64 +194,189 @@ module IEEE_ARITHMETIC
     elemental logical function _gfortran_ieee_is_normal_8(X)
       real(kind=8), intent(in) :: X
     end function
+#ifdef HAVE_GFC_REAL_10
+    elemental logical function _gfortran_ieee_is_normal_10(X)
+      real(kind=10), intent(in) :: X
+    end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+    elemental logical function _gfortran_ieee_is_normal_16(X)
+      real(kind=16), intent(in) :: X
+    end function
+#endif
   end interface
 
   interface IEEE_IS_NORMAL
-    procedure _gfortran_ieee_is_normal_4, _gfortran_ieee_is_normal_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_is_normal_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_is_normal_10, &
+#endif
+      _gfortran_ieee_is_normal_8, _gfortran_ieee_is_normal_4
   end interface
   public :: IEEE_IS_NORMAL
 
   ! IEEE_COPY_SIGN
 
+#define COPYSIGN_MACRO(A,B) \
+  elemental real(kind = A) function \
+    _gfortran_ieee_copy_sign_/**/A/**/_/**/B (X,Y) ; \
+      real(kind = A), intent(in) :: X ; \
+      real(kind = B), intent(in) :: Y ; \
+  end function
+
   interface
-    elemental real(kind=4) function _gfortran_ieee_copy_sign_4_4 (X,Y)
-      real(kind=4), intent(in) :: X
-      real(kind=4), intent(in) :: Y
-    end function
-    elemental real(kind=4) function _gfortran_ieee_copy_sign_4_8 (X,Y)
-      real(kind=4), intent(in) :: X
-      real(kind=8), intent(in) :: Y
-    end function
-    elemental real(kind=8) function _gfortran_ieee_copy_sign_8_4 (X,Y)
-      real(kind=8), intent(in) :: X
-      real(kind=4), intent(in) :: Y
-    end function
-    elemental real(kind=8) function _gfortran_ieee_copy_sign_8_8 (X,Y)
-      real(kind=8), intent(in) :: X
-      real(kind=8), intent(in) :: Y
-    end function
+COPYSIGN_MACRO(4,4)
+COPYSIGN_MACRO(4,8)
+#ifdef HAVE_GFC_REAL_10
+COPYSIGN_MACRO(4,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+COPYSIGN_MACRO(4,16)
+#endif
+COPYSIGN_MACRO(8,4)
+COPYSIGN_MACRO(8,8)
+#ifdef HAVE_GFC_REAL_10
+COPYSIGN_MACRO(8,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+COPYSIGN_MACRO(8,16)
+#endif
+#ifdef HAVE_GFC_REAL_10
+COPYSIGN_MACRO(10,4)
+COPYSIGN_MACRO(10,8)
+COPYSIGN_MACRO(10,10)
+#ifdef HAVE_GFC_REAL_16
+COPYSIGN_MACRO(10,16)
+#endif
+#endif
+#ifdef HAVE_GFC_REAL_16
+COPYSIGN_MACRO(16,4)
+COPYSIGN_MACRO(16,8)
+#ifdef HAVE_GFC_REAL_10
+COPYSIGN_MACRO(16,10)
+#endif
+COPYSIGN_MACRO(16,16)
+#endif
   end interface
 
   interface IEEE_COPY_SIGN
-    procedure _gfortran_ieee_copy_sign_4_4, _gfortran_ieee_copy_sign_4_8, &
-              _gfortran_ieee_copy_sign_8_4, _gfortran_ieee_copy_sign_8_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+              _gfortran_ieee_copy_sign_16_16, &
+#ifdef HAVE_GFC_REAL_10
+              _gfortran_ieee_copy_sign_16_10, &
+#endif
+              _gfortran_ieee_copy_sign_16_8, &
+              _gfortran_ieee_copy_sign_16_4, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+#ifdef HAVE_GFC_REAL_16
+              _gfortran_ieee_copy_sign_10_16, &
+#endif
+              _gfortran_ieee_copy_sign_10_10, &
+              _gfortran_ieee_copy_sign_10_8, &
+              _gfortran_ieee_copy_sign_10_4, &
+#endif
+#ifdef HAVE_GFC_REAL_16
+              _gfortran_ieee_copy_sign_8_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+              _gfortran_ieee_copy_sign_8_10, &
+#endif
+              _gfortran_ieee_copy_sign_8_8, &
+              _gfortran_ieee_copy_sign_8_4, &
+#ifdef HAVE_GFC_REAL_16
+              _gfortran_ieee_copy_sign_4_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+              _gfortran_ieee_copy_sign_4_10, &
+#endif
+              _gfortran_ieee_copy_sign_4_8, &
+              _gfortran_ieee_copy_sign_4_4
   end interface
   public :: IEEE_COPY_SIGN
 
   ! IEEE_UNORDERED
 
+#define UNORDERED_MACRO(A,B) \
+  elemental logical function \
+    _gfortran_ieee_unordered_/**/A/**/_/**/B (X,Y) ; \
+      real(kind = A), intent(in) :: X ; \
+      real(kind = B), intent(in) :: Y ; \
+  end function
+
   interface
-    elemental logical function _gfortran_ieee_unordered_4_4 (X,Y)
-      real(kind=4), intent(in) :: X
-      real(kind=4), intent(in) :: Y
-    end function
-    elemental logical function _gfortran_ieee_unordered_4_8 (X,Y)
-      real(kind=4), intent(in) :: X
-      real(kind=8), intent(in) :: Y
-    end function
-    elemental logical function _gfortran_ieee_unordered_8_4 (X,Y)
-      real(kind=8), intent(in) :: X
-      real(kind=4), intent(in) :: Y
-    end function
-    elemental logical function _gfortran_ieee_unordered_8_8 (X,Y)
-      real(kind=8), intent(in) :: X
-      real(kind=8), intent(in) :: Y
-    end function
+UNORDERED_MACRO(4,4)
+UNORDERED_MACRO(4,8)
+#ifdef HAVE_GFC_REAL_10
+UNORDERED_MACRO(4,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+UNORDERED_MACRO(4,16)
+#endif
+UNORDERED_MACRO(8,4)
+UNORDERED_MACRO(8,8)
+#ifdef HAVE_GFC_REAL_10
+UNORDERED_MACRO(8,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+UNORDERED_MACRO(8,16)
+#endif
+#ifdef HAVE_GFC_REAL_10
+UNORDERED_MACRO(10,4)
+UNORDERED_MACRO(10,8)
+UNORDERED_MACRO(10,10)
+#ifdef HAVE_GFC_REAL_16
+UNORDERED_MACRO(10,16)
+#endif
+#endif
+#ifdef HAVE_GFC_REAL_16
+UNORDERED_MACRO(16,4)
+UNORDERED_MACRO(16,8)
+#ifdef HAVE_GFC_REAL_10
+UNORDERED_MACRO(16,10)
+#endif
+UNORDERED_MACRO(16,16)
+#endif
   end interface
 
   interface IEEE_UNORDERED
-    procedure _gfortran_ieee_unordered_4_4, _gfortran_ieee_unordered_4_8, &
-              _gfortran_ieee_unordered_8_4, _gfortran_ieee_unordered_8_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+              _gfortran_ieee_unordered_16_16, &
+#ifdef HAVE_GFC_REAL_10
+              _gfortran_ieee_unordered_16_10, &
+#endif
+              _gfortran_ieee_unordered_16_8, &
+              _gfortran_ieee_unordered_16_4, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+#ifdef HAVE_GFC_REAL_16
+              _gfortran_ieee_unordered_10_16, &
+#endif
+              _gfortran_ieee_unordered_10_10, &
+              _gfortran_ieee_unordered_10_8, &
+              _gfortran_ieee_unordered_10_4, &
+#endif
+#ifdef HAVE_GFC_REAL_16
+              _gfortran_ieee_unordered_8_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+              _gfortran_ieee_unordered_8_10, &
+#endif
+              _gfortran_ieee_unordered_8_8, &
+              _gfortran_ieee_unordered_8_4, &
+#ifdef HAVE_GFC_REAL_16
+              _gfortran_ieee_unordered_4_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+              _gfortran_ieee_unordered_4_10, &
+#endif
+              _gfortran_ieee_unordered_4_8, &
+              _gfortran_ieee_unordered_4_4
   end interface
   public :: IEEE_UNORDERED
 
@@ -213,64 +389,190 @@ module IEEE_ARITHMETIC
     elemental real(kind=8) function _gfortran_ieee_logb_8 (X)
       real(kind=8), intent(in) :: X
     end function
+#ifdef HAVE_GFC_REAL_10
+    elemental real(kind=10) function _gfortran_ieee_logb_10 (X)
+      real(kind=10), intent(in) :: X
+    end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+    elemental real(kind=16) function _gfortran_ieee_logb_16 (X)
+      real(kind=16), intent(in) :: X
+    end function
+#endif
   end interface
 
   interface IEEE_LOGB
-    procedure _gfortran_ieee_logb_4, _gfortran_ieee_logb_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_logb_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_logb_10, &
+#endif
+      _gfortran_ieee_logb_8, &
+      _gfortran_ieee_logb_4
   end interface
   public :: IEEE_LOGB
 
   ! IEEE_NEXT_AFTER
 
+#define NEXT_AFTER_MACRO(A,B) \
+  elemental real(kind = A) function \
+    _gfortran_ieee_next_after_/**/A/**/_/**/B (X,Y) ; \
+      real(kind = A), intent(in) :: X ; \
+      real(kind = B), intent(in) :: Y ; \
+  end function
+
   interface
-    elemental real(kind=4) function _gfortran_ieee_next_after_4_4 (X, Y)
-      real(kind=4), intent(in) :: X
-      real(kind=4), intent(in) :: Y
-    end function
-    elemental real(kind=4) function _gfortran_ieee_next_after_4_8 (X, Y)
-      real(kind=4), intent(in) :: X
-      real(kind=8), intent(in) :: Y
-    end function
-    elemental real(kind=8) function _gfortran_ieee_next_after_8_4 (X, Y)
-      real(kind=8), intent(in) :: X
-      real(kind=4), intent(in) :: Y
-    end function
-    elemental real(kind=8) function _gfortran_ieee_next_after_8_8 (X, Y)
-      real(kind=8), intent(in) :: X
-      real(kind=8), intent(in) :: Y
-    end function
+NEXT_AFTER_MACRO(4,4)
+NEXT_AFTER_MACRO(4,8)
+#ifdef HAVE_GFC_REAL_10
+NEXT_AFTER_MACRO(4,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+NEXT_AFTER_MACRO(4,16)
+#endif
+NEXT_AFTER_MACRO(8,4)
+NEXT_AFTER_MACRO(8,8)
+#ifdef HAVE_GFC_REAL_10
+NEXT_AFTER_MACRO(8,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+NEXT_AFTER_MACRO(8,16)
+#endif
+#ifdef HAVE_GFC_REAL_10
+NEXT_AFTER_MACRO(10,4)
+NEXT_AFTER_MACRO(10,8)
+NEXT_AFTER_MACRO(10,10)
+#ifdef HAVE_GFC_REAL_16
+NEXT_AFTER_MACRO(10,16)
+#endif
+#endif
+#ifdef HAVE_GFC_REAL_16
+NEXT_AFTER_MACRO(16,4)
+NEXT_AFTER_MACRO(16,8)
+#ifdef HAVE_GFC_REAL_10
+NEXT_AFTER_MACRO(16,10)
+#endif
+NEXT_AFTER_MACRO(16,16)
+#endif
   end interface
 
   interface IEEE_NEXT_AFTER
-    procedure _gfortran_ieee_next_after_4_4, _gfortran_ieee_next_after_4_8, &
-              _gfortran_ieee_next_after_8_4, _gfortran_ieee_next_after_8_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_next_after_16_16, &
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_next_after_16_10, &
+#endif
+      _gfortran_ieee_next_after_16_8, &
+      _gfortran_ieee_next_after_16_4, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_next_after_10_16, &
+#endif
+      _gfortran_ieee_next_after_10_10, &
+      _gfortran_ieee_next_after_10_8, &
+      _gfortran_ieee_next_after_10_4, &
+#endif
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_next_after_8_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_next_after_8_10, &
+#endif
+      _gfortran_ieee_next_after_8_8, &
+      _gfortran_ieee_next_after_8_4, &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_next_after_4_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_next_after_4_10, &
+#endif
+      _gfortran_ieee_next_after_4_8, &
+      _gfortran_ieee_next_after_4_4
   end interface
   public :: IEEE_NEXT_AFTER
 
   ! IEEE_REM
 
+#define REM_MACRO(RES,A,B) \
+  elemental real(kind = RES) function \
+    _gfortran_ieee_rem_/**/A/**/_/**/B (X,Y) ; \
+      real(kind = A), intent(in) :: X ; \
+      real(kind = B), intent(in) :: Y ; \
+  end function
+
   interface
-    elemental real(kind=4) function _gfortran_ieee_rem_4_4 (X, Y)
-      real(kind=4), intent(in) :: X
-      real(kind=4), intent(in) :: Y
-    end function
-    elemental real(kind=8) function _gfortran_ieee_rem_4_8 (X, Y)
-      real(kind=4), intent(in) :: X
-      real(kind=8), intent(in) :: Y
-    end function
-    elemental real(kind=8) function _gfortran_ieee_rem_8_4 (X, Y)
-      real(kind=8), intent(in) :: X
-      real(kind=4), intent(in) :: Y
-    end function
-    elemental real(kind=8) function _gfortran_ieee_rem_8_8 (X, Y)
-      real(kind=8), intent(in) :: X
-      real(kind=8), intent(in) :: Y
-    end function
+REM_MACRO(4,4,4)
+REM_MACRO(8,4,8)
+#ifdef HAVE_GFC_REAL_10
+REM_MACRO(10,4,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+REM_MACRO(16,4,16)
+#endif
+REM_MACRO(8,8,4)
+REM_MACRO(8,8,8)
+#ifdef HAVE_GFC_REAL_10
+REM_MACRO(10,8,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+REM_MACRO(16,8,16)
+#endif
+#ifdef HAVE_GFC_REAL_10
+REM_MACRO(10,10,4)
+REM_MACRO(10,10,8)
+REM_MACRO(10,10,10)
+#ifdef HAVE_GFC_REAL_16
+REM_MACRO(16,10,16)
+#endif
+#endif
+#ifdef HAVE_GFC_REAL_16
+REM_MACRO(16,16,4)
+REM_MACRO(16,16,8)
+#ifdef HAVE_GFC_REAL_10
+REM_MACRO(16,16,10)
+#endif
+REM_MACRO(16,16,16)
+#endif
   end interface
 
   interface IEEE_REM
-    procedure _gfortran_ieee_rem_4_4, _gfortran_ieee_rem_4_8, &
-              _gfortran_ieee_rem_8_4, _gfortran_ieee_rem_8_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_rem_16_16, &
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_rem_16_10, &
+#endif
+      _gfortran_ieee_rem_16_8, &
+      _gfortran_ieee_rem_16_4, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_rem_10_16, &
+#endif
+      _gfortran_ieee_rem_10_10, &
+      _gfortran_ieee_rem_10_8, &
+      _gfortran_ieee_rem_10_4, &
+#endif
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_rem_8_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_rem_8_10, &
+#endif
+      _gfortran_ieee_rem_8_8, &
+      _gfortran_ieee_rem_8_4, &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_rem_4_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_rem_4_10, &
+#endif
+      _gfortran_ieee_rem_4_8, &
+      _gfortran_ieee_rem_4_4
   end interface
   public :: IEEE_REM
 
@@ -283,10 +585,27 @@ module IEEE_ARITHMETIC
     elemental real(kind=8) function _gfortran_ieee_rint_8 (X)
       real(kind=8), intent(in) :: X
     end function
+#ifdef HAVE_GFC_REAL_10
+    elemental real(kind=10) function _gfortran_ieee_rint_10 (X)
+      real(kind=10), intent(in) :: X
+    end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+    elemental real(kind=16) function _gfortran_ieee_rint_16 (X)
+      real(kind=16), intent(in) :: X
+    end function
+#endif
   end interface
 
   interface IEEE_RINT
-    procedure _gfortran_ieee_rint_4, _gfortran_ieee_rint_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_rint_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_rint_10, &
+#endif
+      _gfortran_ieee_rint_8, _gfortran_ieee_rint_4
   end interface
   public :: IEEE_RINT
 
@@ -301,24 +620,57 @@ module IEEE_ARITHMETIC
       real(kind=8), intent(in) :: X
       integer, intent(in) :: I
     end function
+#ifdef HAVE_GFC_REAL_10
+    elemental real(kind=10) function _gfortran_ieee_scalb_10 (X, I)
+      real(kind=10), intent(in) :: X
+      integer, intent(in) :: I
+    end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+    elemental real(kind=16) function _gfortran_ieee_scalb_16 (X, I)
+      real(kind=16), intent(in) :: X
+      integer, intent(in) :: I
+    end function
+#endif
   end interface
 
   interface IEEE_SCALB
-    procedure _gfortran_ieee_scalb_4, _gfortran_ieee_scalb_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_scalb_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_scalb_10, &
+#endif
+      _gfortran_ieee_scalb_8, _gfortran_ieee_scalb_4
   end interface
   public :: IEEE_SCALB
 
   ! IEEE_VALUE
 
   interface IEEE_VALUE
-    module procedure IEEE_VALUE_4, IEEE_VALUE_8
+    module procedure &
+#ifdef HAVE_GFC_REAL_16
+      IEEE_VALUE_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      IEEE_VALUE_10, &
+#endif
+      IEEE_VALUE_8, IEEE_VALUE_4
   end interface
   public :: IEEE_VALUE
 
   ! IEEE_CLASS
 
   interface IEEE_CLASS
-    module procedure IEEE_CLASS_4, IEEE_CLASS_8
+    module procedure &
+#ifdef HAVE_GFC_REAL_16
+      IEEE_CLASS_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      IEEE_CLASS_10, &
+#endif
+      IEEE_CLASS_8, IEEE_CLASS_4
   end interface
   public :: IEEE_CLASS
 
@@ -424,47 +776,19 @@ contains
     res = (X%hidden /= Y%hidden)
   end function
 
+
   ! IEEE_SELECTED_REAL_KIND
+
   integer function IEEE_SELECTED_REAL_KIND (P, R, RADIX) result(res)
     implicit none
     integer, intent(in), optional :: P, R, RADIX
-    integer :: p2, r2
-
-    p2 = 0 ; r2 = 0
-    if (present(p)) p2 = p
-    if (present(r)) r2 = r
-
-    ! The only IEEE types we support right now are binary
-    if (present(radix)) then
-      if (radix /= 2) then
-        res = -5
-        return
-      endif
-    endif
-
-    ! Does IEEE float fit?
-    if (precision(0.) >= p2 .and. range(0.) >= r2) then
-      res = kind(0.)
-      return
-    endif
-
-    ! Does IEEE double fit?
-    if (precision(0.d0) >= p2 .and. range(0.d0) >= r2) then
-      res = kind(0.d0)
-      return
-    endif
-
-    if (precision(0.d0) < p2 .and. range(0.d0) < r2) then
-      res = -3
-      return
-    endif
-
-    if (precision(0.d0) < p2) then
-      res = -1
-      return
-    endif
-
-   res = -2
+
+    ! Currently, if IEEE is supported and this module is built, it means
+    ! all our floating-point types conform to IEEE. Hence, we simply call
+    ! SELECTED_REAL_KIND.
+
+    res = SELECTED_REAL_KIND (P, R, RADIX)
+
   end function
 
 
@@ -498,6 +822,39 @@ contains
     res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_8(X))
   end function
 
+#ifdef HAVE_GFC_REAL_10
+  elemental function IEEE_CLASS_10 (X) result(res)
+    implicit none
+    real(kind=10), intent(in) :: X
+    type(IEEE_CLASS_TYPE) :: res
+
+    interface
+      pure integer function _gfortrani_ieee_class_helper_10(val)
+        real(kind=10), intent(in) :: val
+      end function
+    end interface
+
+    res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_10(X))
+  end function
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+  elemental function IEEE_CLASS_16 (X) result(res)
+    implicit none
+    real(kind=16), intent(in) :: X
+    type(IEEE_CLASS_TYPE) :: res
+
+    interface
+      pure integer function _gfortrani_ieee_class_helper_16(val)
+        real(kind=16), intent(in) :: val
+      end function
+    end interface
+
+    res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_16(X))
+  end function
+#endif
+
+
   ! IEEE_VALUE
 
   elemental real(kind=4) function IEEE_VALUE_4(X, C) result(res)
@@ -576,6 +933,86 @@ contains
      end select
   end function
 
+#ifdef HAVE_GFC_REAL_10
+  elemental real(kind=10) function IEEE_VALUE_10(X, C) result(res)
+    implicit none
+    real(kind=10), intent(in) :: X
+    type(IEEE_CLASS_TYPE), intent(in) :: C
+
+    select case (C%hidden)
+      case (1)     ! IEEE_SIGNALING_NAN
+        res = -1
+        res = sqrt(res)
+      case (2)     ! IEEE_QUIET_NAN
+        res = -1
+        res = sqrt(res)
+      case (3)     ! IEEE_NEGATIVE_INF
+        res = huge(res)
+        res = (-res) * res
+      case (4)     ! IEEE_NEGATIVE_NORMAL
+        res = -42
+      case (5)     ! IEEE_NEGATIVE_DENORMAL
+        res = -tiny(res)
+        res = res / 2
+      case (6)     ! IEEE_NEGATIVE_ZERO
+        res = 0
+        res = -res
+      case (7)     ! IEEE_POSITIVE_ZERO
+        res = 0
+      case (8)     ! IEEE_POSITIVE_DENORMAL
+        res = tiny(res)
+        res = res / 2
+      case (9)     ! IEEE_POSITIVE_NORMAL
+        res = 42
+      case (10)    ! IEEE_POSITIVE_INF
+        res = huge(res)
+        res = res * res
+      case default ! IEEE_OTHER_VALUE, should not happen
+        res = 0
+     end select
+  end function
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+  elemental real(kind=16) function IEEE_VALUE_16(X, C) result(res)
+    implicit none
+    real(kind=16), intent(in) :: X
+    type(IEEE_CLASS_TYPE), intent(in) :: C
+
+    select case (C%hidden)
+      case (1)     ! IEEE_SIGNALING_NAN
+        res = -1
+        res = sqrt(res)
+      case (2)     ! IEEE_QUIET_NAN
+        res = -1
+        res = sqrt(res)
+      case (3)     ! IEEE_NEGATIVE_INF
+        res = huge(res)
+        res = (-res) * res
+      case (4)     ! IEEE_NEGATIVE_NORMAL
+        res = -42
+      case (5)     ! IEEE_NEGATIVE_DENORMAL
+        res = -tiny(res)
+        res = res / 2
+      case (6)     ! IEEE_NEGATIVE_ZERO
+        res = 0
+        res = -res
+      case (7)     ! IEEE_POSITIVE_ZERO
+        res = 0
+      case (8)     ! IEEE_POSITIVE_DENORMAL
+        res = tiny(res)
+        res = res / 2
+      case (9)     ! IEEE_POSITIVE_NORMAL
+        res = 42
+      case (10)    ! IEEE_POSITIVE_INF
+        res = huge(res)
+        res = res * res
+      case default ! IEEE_OTHER_VALUE, should not happen
+        res = 0
+     end select
+  end function
+#endif
+
 
   ! IEEE_GET_ROUNDING_MODE
 
@@ -663,7 +1100,7 @@ contains
     implicit none
     real(kind=10), intent(in) :: X
     type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
-    res = .false.
+    res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
   end function
 #endif
 
@@ -672,18 +1109,14 @@ contains
     implicit none
     real(kind=16), intent(in) :: X
     type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
-    res = .false.
+    res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
   end function
 #endif
 
   pure logical function IEEE_SUPPORT_ROUNDING_NOARG (ROUND_VALUE) result(res)
     implicit none
     type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-    res = .false.
-#else
     res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
-#endif
   end function
 
 ! IEEE_SUPPORT_UNDERFLOW_CONTROL
@@ -704,7 +1137,7 @@ contains
   pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_10 (X) result(res)
     implicit none
     real(kind=10), intent(in) :: X
-    res = .false.
+    res = (support_underflow_control_helper(10) /= 0)
   end function
 #endif
 
@@ -712,18 +1145,21 @@ contains
   pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_16 (X) result(res)
     implicit none
     real(kind=16), intent(in) :: X
-    res = .false.
+    res = (support_underflow_control_helper(16) /= 0)
   end function
 #endif
 
   pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_NOARG () result(res)
     implicit none
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-    res = .false.
-#else
     res = (support_underflow_control_helper(4) /= 0 &
-           .and. support_underflow_control_helper(8) /= 0)
+           .and. support_underflow_control_helper(8) /= 0 &
+#ifdef HAVE_GFC_REAL_10
+           .and. support_underflow_control_helper(10) /= 0 &
+#endif
+#ifdef HAVE_GFC_REAL_16
+           .and. support_underflow_control_helper(16) /= 0 &
 #endif
+          )
   end function
 
 ! IEEE_SUPPORT_* functions
@@ -746,127 +1182,95 @@ contains
 SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,4,.true.)
 SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,8,.true.)
 #ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,10,.true.)
 #endif
 #ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,16,.true.)
 #endif
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-SUPPORTMACRO_NOARG(IEEE_SUPPORT_DATATYPE,.false.)
-#else
 SUPPORTMACRO_NOARG(IEEE_SUPPORT_DATATYPE,.true.)
-#endif
 
 ! IEEE_SUPPORT_DENORMAL
 
 SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,4,.true.)
 SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,8,.true.)
 #ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,10,.true.)
 #endif
 #ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,16,.true.)
 #endif
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-SUPPORTMACRO_NOARG(IEEE_SUPPORT_DENORMAL,.false.)
-#else
 SUPPORTMACRO_NOARG(IEEE_SUPPORT_DENORMAL,.true.)
-#endif
 
 ! IEEE_SUPPORT_DIVIDE
 
 SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,4,.true.)
 SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,8,.true.)
 #ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,10,.true.)
 #endif
 #ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,16,.true.)
 #endif
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-SUPPORTMACRO_NOARG(IEEE_SUPPORT_DIVIDE,.false.)
-#else
 SUPPORTMACRO_NOARG(IEEE_SUPPORT_DIVIDE,.true.)
-#endif
 
 ! IEEE_SUPPORT_INF
 
 SUPPORTMACRO(IEEE_SUPPORT_INF,4,.true.)
 SUPPORTMACRO(IEEE_SUPPORT_INF,8,.true.)
 #ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_INF,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_INF,10,.true.)
 #endif
 #ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_INF,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_INF,16,.true.)
 #endif
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-SUPPORTMACRO_NOARG(IEEE_SUPPORT_INF,.false.)
-#else
 SUPPORTMACRO_NOARG(IEEE_SUPPORT_INF,.true.)
-#endif
 
 ! IEEE_SUPPORT_IO
 
 SUPPORTMACRO(IEEE_SUPPORT_IO,4,.true.)
 SUPPORTMACRO(IEEE_SUPPORT_IO,8,.true.)
 #ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_IO,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_IO,10,.true.)
 #endif
 #ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_IO,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_IO,16,.true.)
 #endif
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-SUPPORTMACRO_NOARG(IEEE_SUPPORT_IO,.false.)
-#else
 SUPPORTMACRO_NOARG(IEEE_SUPPORT_IO,.true.)
-#endif
 
 ! IEEE_SUPPORT_NAN
 
 SUPPORTMACRO(IEEE_SUPPORT_NAN,4,.true.)
 SUPPORTMACRO(IEEE_SUPPORT_NAN,8,.true.)
 #ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_NAN,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_NAN,10,.true.)
 #endif
 #ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_NAN,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_NAN,16,.true.)
 #endif
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-SUPPORTMACRO_NOARG(IEEE_SUPPORT_NAN,.false.)
-#else
 SUPPORTMACRO_NOARG(IEEE_SUPPORT_NAN,.true.)
-#endif
 
 ! IEEE_SUPPORT_SQRT
 
 SUPPORTMACRO(IEEE_SUPPORT_SQRT,4,.true.)
 SUPPORTMACRO(IEEE_SUPPORT_SQRT,8,.true.)
 #ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_SQRT,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_SQRT,10,.true.)
 #endif
 #ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_SQRT,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_SQRT,16,.true.)
 #endif
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-SUPPORTMACRO_NOARG(IEEE_SUPPORT_SQRT,.false.)
-#else
 SUPPORTMACRO_NOARG(IEEE_SUPPORT_SQRT,.true.)
-#endif
 
 ! IEEE_SUPPORT_STANDARD
 
 SUPPORTMACRO(IEEE_SUPPORT_STANDARD,4,.true.)
 SUPPORTMACRO(IEEE_SUPPORT_STANDARD,8,.true.)
 #ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_STANDARD,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_STANDARD,10,.true.)
 #endif
 #ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_STANDARD,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_STANDARD,16,.true.)
 #endif
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-SUPPORTMACRO_NOARG(IEEE_SUPPORT_STANDARD,.false.)
-#else
 SUPPORTMACRO_NOARG(IEEE_SUPPORT_STANDARD,.true.)
-#endif
 
 end module IEEE_ARITHMETIC

diff --git a/libgfortran/ieee/ieee_exceptions.F90 b/libgfortran/ieee/ieee_exceptions.F90
index 4283906eb26c7113b74116605164595ccbe765d8..662c42f03e0067449771bdd38faa89c2677c76ed 100644 (file)
--- a/libgfortran/ieee/ieee_exceptions.F90
+++ b/libgfortran/ieee/ieee_exceptions.F90
@@ -57,9 +57,15 @@ module IEEE_EXCEPTIONS
   end type
 
   interface IEEE_SUPPORT_FLAG
-    module procedure IEEE_SUPPORT_FLAG_NOARG, &
-                     IEEE_SUPPORT_FLAG_4, &
-                     IEEE_SUPPORT_FLAG_8
+    module procedure IEEE_SUPPORT_FLAG_4, &
+                     IEEE_SUPPORT_FLAG_8, &
+#ifdef HAVE_GFC_REAL_10
+                     IEEE_SUPPORT_FLAG_10, &
+#endif
+#ifdef HAVE_GFC_REAL_16
+                     IEEE_SUPPORT_FLAG_16, &
+#endif
+                     IEEE_SUPPORT_FLAG_NOARG
   end interface IEEE_SUPPORT_FLAG
 
   public :: IEEE_SUPPORT_FLAG, IEEE_SUPPORT_HALTING
@@ -215,4 +221,22 @@ contains
     res = IEEE_SUPPORT_FLAG_NOARG(FLAG)
   end function
 
+#ifdef HAVE_GFC_REAL_10
+  pure logical function IEEE_SUPPORT_FLAG_10 (FLAG, X) result(res)
+    implicit none
+    type(IEEE_FLAG_TYPE), intent(in) :: FLAG
+    real(kind=10), intent(in) :: X
+    res = IEEE_SUPPORT_FLAG_NOARG(FLAG)
+  end function
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+  pure logical function IEEE_SUPPORT_FLAG_16 (FLAG, X) result(res)
+    implicit none
+    type(IEEE_FLAG_TYPE), intent(in) :: FLAG
+    real(kind=16), intent(in) :: X
+    res = IEEE_SUPPORT_FLAG_NOARG(FLAG)
+  end function
+#endif
+
 end module IEEE_EXCEPTIONS

diff --git a/libgfortran/ieee/ieee_helper.c b/libgfortran/ieee/ieee_helper.c
index c8ed77b15f3f153f1500da7c831b8b7a07a378f3..f3362d42ef35e68923c82da94bb1f19fb8847e6a 100644 (file)
--- a/libgfortran/ieee/ieee_helper.c
+++ b/libgfortran/ieee/ieee_helper.c
@@ -33,6 +33,16 @@ internal_proto(ieee_class_helper_4);
 extern int ieee_class_helper_8 (GFC_REAL_8 *);
 internal_proto(ieee_class_helper_8);
 
+#ifdef HAVE_GFC_REAL_10
+extern int ieee_class_helper_10 (GFC_REAL_10 *);
+internal_proto(ieee_class_helper_10);
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+extern int ieee_class_helper_16 (GFC_REAL_16 *);
+internal_proto(ieee_class_helper_16);
+#endif
+
 /* Enumeration of the possible floating-point types. These values
    correspond to the hidden arguments of the IEEE_CLASS_TYPE
    derived-type of IEEE_ARITHMETIC.  */
@@ -74,6 +84,14 @@ enum { IEEE_OTHER_VALUE = 0, IEEE_SIGNALING_NAN, IEEE_QUIET_NAN,
 CLASSMACRO(4)
 CLASSMACRO(8)
 
+#ifdef HAVE_GFC_REAL_10
+CLASSMACRO(10)
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+CLASSMACRO(16)
+#endif
+
 
 #define GFC_FPE_ALL (GFC_FPE_INVALID | GFC_FPE_DENORMAL | \
                     GFC_FPE_ZERO | GFC_FPE_OVERFLOW | \