mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-25 08:50:35 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/33568 (ICE with ANINT (with KIND and an array))

Browse Source 
2007-09-27  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33568
	* trans-intrinsic.c (gfc_conv_intrinsic_aint): Allow for the 
	possibility of the optional KIND argument by making arg
	an array, counting the number of arguments and using arg[0].

2007-09-27  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33568
	* gfortran.dg/anint_1.f90: New test.

From-SVN: r128843
This commit is contained in:
Paul Thomas 2007-09-27 18:39:55 +00:00
parent 5c13b77cb0
commit 74687efe94
4 changed files with 38 additions and 9 deletions

7
gcc/fortran/ChangeLog

@ -1,3 +1,10 @@
2007-09-27 Paul Thomas <pault@gcc.gnu.org>
PR fortran/33568
* trans-intrinsic.c (gfc_conv_intrinsic_aint): Allow for the
possibility of the optional KIND argument by making arg
an array, counting the number of arguments and using arg[0].
2007-09-26 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/30780

19
gcc/fortran/trans-intrinsic.c

@ -393,14 +393,15 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, enum rounding_mode op)
{
tree type;
tree itype;
tree arg;
tree arg[2];
tree tmp;
tree cond;
mpfr_t huge;
int n;
int n, nargs;
int kind;
kind = expr->ts.kind;
nargs = gfc_intrinsic_argument_list_length (expr);
n = END_BUILTINS;
/* We have builtin functions for some cases. */
@ -448,20 +449,20 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, enum rounding_mode op)
/* Evaluate the argument. */
gcc_assert (expr->value.function.actual->expr);
gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
gfc_conv_intrinsic_function_args (se, expr, arg, nargs);
/* Use a builtin function if one exists. */
if (n != END_BUILTINS)
{
tmp = built_in_decls[n];
se->expr = build_call_expr (tmp, 1, arg);
se->expr = build_call_expr (tmp, 1, arg[0]);
return;
}
/* This code is probably redundant, but we'll keep it lying around just
in case. */
type = gfc_typenode_for_spec (&expr->ts);
arg = gfc_evaluate_now (arg, &se->pre);
arg[0] = gfc_evaluate_now (arg[0], &se->pre);
/* Test if the value is too large to handle sensibly. */
gfc_set_model_kind (kind);
@ -469,17 +470,17 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, enum rounding_mode op)
n = gfc_validate_kind (BT_INTEGER, kind, false);
mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE);
tmp = gfc_conv_mpfr_to_tree (huge, kind);
cond = build2 (LT_EXPR, boolean_type_node, arg, tmp);
cond = build2 (LT_EXPR, boolean_type_node, arg[0], tmp);
mpfr_neg (huge, huge, GFC_RND_MODE);
tmp = gfc_conv_mpfr_to_tree (huge, kind);
tmp = build2 (GT_EXPR, boolean_type_node, arg, tmp);
tmp = build2 (GT_EXPR, boolean_type_node, arg[0], tmp);
cond = build2 (TRUTH_AND_EXPR, boolean_type_node, cond, tmp);
itype = gfc_get_int_type (kind);
tmp = build_fix_expr (&se->pre, arg, itype, op);
tmp = build_fix_expr (&se->pre, arg[0], itype, op);
tmp = convert (type, tmp);
se->expr = build3 (COND_EXPR, type, cond, tmp, arg);
se->expr = build3 (COND_EXPR, type, cond, tmp, arg[0]);
mpfr_clear (huge);
}

5
gcc/testsuite/ChangeLog

@ -1,3 +1,8 @@
2007-09-27 Paul Thomas <pault@gcc.gnu.org>
PR fortran/33568
* gfortran.dg/anint_1.f90: New test.
2007-09-27 Ian Lance Taylor <iant@google.com>
PR tree-optimization/33565

16
gcc/testsuite/gfortran.dg/anint_1.f90 Normal file

@ -0,0 +1,16 @@
! { dg-do run }
! Check the fix for PR33568 in which the optional KIND
! argument for ANINT, with an array for the first argument
! would cause an ICE.
!
! Contributed by Ignacio Fernández Galván <jellby@yahoo.com>
!
PROGRAM Test
IMPLICIT NONE
INTEGER, PARAMETER :: DP=8
REAL(DP), DIMENSION(1:3) :: A = (/1.76,2.32,7.66/), B
A = ANINT ( A , DP)
B = A
A = ANINT ( A)
if (any (A .ne. B)) call abort ()
END PROGRAM Test