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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index db3bc95..1e06226 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/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

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index ebe8555..cf7d1e1 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/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);
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 163f80b..4f608d0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/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

diff --git a/gcc/testsuite/gfortran.dg/anint_1.f90 b/gcc/testsuite/gfortran.dg/anint_1.f90
new file mode 100644 (file)
index 0000000..a6b92cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/anint_1.f90
@@ -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