[Bug fortran/33568] ICE with ANINT (with KIND and an array)

[pault at gcc dot gnu dot org]

------- Comment #1 from pault at gcc dot gnu dot org  2007-09-27 10:39 -------
Confirmed.  Thanks, Ignacio.

This is the fix (the absence of the KIND working and the regression wrt 4.2
were giveaways):

Index: gcc/fortran/trans-intrinsic.c
===================================================================
*** gcc/fortran/trans-intrinsic.c       (révision 128323)
--- gcc/fortran/trans-intrinsic.c       (copie de travail)
*************** gfc_conv_intrinsic_aint (gfc_se * se, gf
*** 393,399 ****
  {
    tree type;
    tree itype;
!   tree arg;
    tree tmp;
    tree cond;
    mpfr_t huge;
--- 393,399 ----
  {
    tree type;
    tree itype;
!   tree arg[2];
    tree tmp;
    tree cond;
    mpfr_t huge;
*************** gfc_conv_intrinsic_aint (gfc_se * se, gf
*** 448,467 ****

    /* Evaluate the argument.  */
    gcc_assert (expr->value.function.actual->expr);
!   gfc_conv_intrinsic_function_args (se, expr, &arg, 1);

    /* Use a builtin function if one exists.  */
    if (n != END_BUILTINS)
      {
        tmp = built_in_decls[n];
!       se->expr = build_call_expr (tmp, 1, arg);
        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);

    /* Test if the value is too large to handle sensibly.  */
    gfc_set_model_kind (kind);
--- 448,467 ----

    /* Evaluate the argument.  */
    gcc_assert (expr->value.function.actual->expr);
!   gfc_conv_intrinsic_function_args (se, expr, arg, 2);

    /* Use a builtin function if one exists.  */
    if (n != END_BUILTINS)
      {
        tmp = built_in_decls[n];
!       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[0] = gfc_evaluate_now (arg[0], &se->pre);

    /* Test if the value is too large to handle sensibly.  */
    gfc_set_model_kind (kind);
*************** gfc_conv_intrinsic_aint (gfc_se * se, gf
*** 469,485 ****
    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);

    mpfr_neg (huge, huge, GFC_RND_MODE);
    tmp = gfc_conv_mpfr_to_tree (huge, kind);
!   tmp = build2 (GT_EXPR, boolean_type_node, arg, 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 = convert (type, tmp);
!   se->expr = build3 (COND_EXPR, type, cond, tmp, arg);
    mpfr_clear (huge);
  }

--- 469,485 ----
    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[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[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[0], itype, op);
    tmp = convert (type, tmp);
!   se->expr = build3 (COND_EXPR, type, cond, tmp, arg[0]);
    mpfr_clear (huge);
  }

Cheers

Paul


-- 

pault at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|UNCONFIRMED                 |NEW
     Ever Confirmed|0                           |1
   Last reconfirmed|0000-00-00 00:00:00         |2007-09-27 10:39:02
               date|                            |


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=33568