aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorHarald Anlauf <anlauf@gmx.de>2020-09-07 21:41:45 +0200
committerHarald Anlauf <anlauf@gmx.de>2020-09-07 21:42:30 +0200
commit9164caf25cb210ad0a69357b226e39913aff00d1 (patch)
tree0c4cd26a76ccc318b9cccc08b07be4916cf82cc0 /gcc
parent6001db79c477b03eacc7e7049560921fb54b7845 (diff)
downloadgcc-9164caf25cb210ad0a69357b226e39913aff00d1.zip
gcc-9164caf25cb210ad0a69357b226e39913aff00d1.tar.gz
gcc-9164caf25cb210ad0a69357b226e39913aff00d1.tar.bz2
PR fortran/96711 - ICE with NINT() for integer(16) result
When rounding a real to the nearest integer, temporarily convert the real argument to a longer real kind when the result is of type/kind integer(16). gcc/fortran/ChangeLog: * trans-intrinsic.c (build_round_expr): Use temporary with appropriate kind for conversion before rounding to nearest integer when the result precision is 128 bits. gcc/testsuite/ChangeLog: * gfortran.dg/pr96711.f90: New test.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/trans-intrinsic.c17
-rw-r--r--gcc/testsuite/gfortran.dg/pr96711.f9028
2 files changed, 43 insertions, 2 deletions
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 2483f01..32fe988 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -395,11 +395,24 @@ build_round_expr (tree arg, tree restype)
fn = builtin_decl_for_precision (BUILT_IN_LROUND, argprec);
else if (resprec <= LONG_LONG_TYPE_SIZE)
fn = builtin_decl_for_precision (BUILT_IN_LLROUND, argprec);
+ else if (resprec >= argprec && resprec == 128)
+ {
+ /* Search for a real kind suitable as temporary for conversion. */
+ int kind = -1;
+ for (int i = 0; kind < 0 && gfc_real_kinds[i].kind != 0; i++)
+ if (gfc_real_kinds[i].mode_precision >= resprec)
+ kind = gfc_real_kinds[i].kind;
+ if (kind < 0)
+ gfc_internal_error ("Could not find real kind with at least %d bits",
+ resprec);
+ arg = fold_convert (gfc_float128_type_node, arg);
+ fn = gfc_builtin_decl_for_float_kind (BUILT_IN_ROUND, kind);
+ }
else
gcc_unreachable ();
- return fold_convert (restype, build_call_expr_loc (input_location,
- fn, 1, arg));
+ return convert (restype, build_call_expr_loc (input_location,
+ fn, 1, arg));
}
diff --git a/gcc/testsuite/gfortran.dg/pr96711.f90 b/gcc/testsuite/gfortran.dg/pr96711.f90
new file mode 100644
index 0000000..3761a8e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr96711.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_integer_16 }
+! { dg-require-effective-target fortran_real_16 }
+! { dg-additional-options "-fdump-tree-original" }
+! { dg-final { scan-tree-dump-times "_gfortran_stop_numeric" 2 "original" } }
+!
+! PR fortran/96711 - ICE on NINT() Function
+
+program p
+ implicit none
+ real(8) :: x
+ real(16) :: y
+ integer(16), parameter :: k1 = nint (2 / epsilon (x), kind(k1))
+ integer(16), parameter :: k2 = nint (2 / epsilon (y), kind(k2))
+ integer(16), parameter :: m1 = 9007199254740992_16 !2**53
+ integer(16), parameter :: m2 = 10384593717069655257060992658440192_16 !2**113
+ integer(16), volatile :: m
+ x = 2 / epsilon (x)
+ y = 2 / epsilon (y)
+ m = nint (x, kind(m))
+! print *, m
+ if (k1 /= m1) stop 1
+ if (m /= m1) stop 2
+ m = nint (y, kind(m))
+! print *, m
+ if (k2 /= m2) stop 3
+ if (m /= m2) stop 4
+end program