re PR fortran/64022 ([F2003][IEEE] ieee_support_flag does not handle kind=10 and kind=16 REAL variables)

	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

5 files changed, 165 insertions, 76 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 36cd6f3..46f9a92 100644
--- 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 3fb9887..f0fdfbd 100644
--- 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 ae404d3..3a9143d 100644
--- 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 a66e905..227bf54 100644
--- 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
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