diff options
| author | Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de> | 2004-05-14 17:32:01 +0200 |
|---|---|---|
| committer | Tobias Schlüter <tobi@gcc.gnu.org> | 2004-05-14 17:32:01 +0200 |
| commit | 4f9c6b6e187417a15ac89f7e76019f27fd637076 (patch) | |
| tree | 0f426de4696a0f958be60cb977b3fd72c51e44be | |
| parent | 571325db5977ad68205f88d6e4d86b1ffaeaaeec (diff) | |
| download | gcc-4f9c6b6e187417a15ac89f7e76019f27fd637076.zip gcc-4f9c6b6e187417a15ac89f7e76019f27fd637076.tar.gz gcc-4f9c6b6e187417a15ac89f7e76019f27fd637076.tar.bz2 | |
re PR fortran/15206 (RRSPACING intrinsics returns wrong result for 0.0)
PR fortran/15206
* trans-intrinsic.c (gfc_conv_intrinsic_rrspacing): Fixed to
handle zero correctly.
From-SVN: r81848
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 31 |
2 files changed, 26 insertions, 11 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index bae4efd..605a572 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2004-05-08 Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de> + + PR fortran/15206 + * trans-intrinsic.c (gfc_conv_intrinsic_rrspacing): Fixed to + handle zero correctly. + 2004-05-14 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de> * match.c (gfc_match): Eliminate dead code. diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index ef7cd84..96eb306 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2398,23 +2398,28 @@ gfc_conv_intrinsic_spacing (gfc_se * se, gfc_expr * expr) se->expr = tmp; } -/* Generate code for RRSPACING (X) intrinsic function. We generate: - sedigits = edigits + 1; - if (expn == 0) - { - t1 = leadzero (frac); - frac = frac << (t1 + sedigits); - frac = frac >> (sedigits); - } - t = bias + BITS_OF_FRACTION_OF; - res = (t << BITS_OF_FRACTION_OF) | frac; +/* Generate code for RRSPACING (X) intrinsic function. We generate: + + if (expn == 0 && frac == 0) + res = 0; + else + { + sedigits = edigits + 1; + if (expn == 0) + { + t1 = leadzero (frac); + frac = frac << (t1 + sedigits); + frac = frac >> (sedigits); + } + t = bias + BITS_OF_FRACTION_OF; + res = (t << BITS_OF_FRACTION_OF) | frac; */ static void gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr) { tree masktype; - tree tmp, t1, t2, cond; + tree tmp, t1, t2, cond, cond2; tree one, zero; tree fdigits, fraction; real_compnt_info rcs; @@ -2438,6 +2443,10 @@ gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr) tmp = build (LSHIFT_EXPR, masktype, tmp, fdigits); tmp = build (BIT_IOR_EXPR, masktype, tmp, fraction); + cond2 = build (EQ_EXPR, boolean_type_node, rcs.frac, zero); + cond = build (TRUTH_ANDIF_EXPR, boolean_type_node, cond, cond2); + tmp = build (COND_EXPR, masktype, cond, integer_zero_node, tmp); + tmp = build1 (VIEW_CONVERT_EXPR, rcs.type, tmp); se->expr = tmp; } |