void
gfc_conv_constant (gfc_se * se, gfc_expr * expr)
{
  gcc_assert (expr->expr_type == EXPR_CONSTANT);

  if (se->ss != NULL)
    {
      gcc_assert (se->ss != gfc_ss_terminator);
      gcc_assert (se->ss->type == GFC_SS_SCALAR);
      gcc_assert (se->ss->expr == expr);

      se->expr = se->ss->data.scalar.expr;
      se->string_length = se->ss->string_length;
      gfc_advance_se_ss_chain (se);
      return;
    }

  /* Translate the constant and put it in the simplifier structure.  */
  se->expr = gfc_conv_constant_to_tree (expr);

  /* If this is a CHARACTER string, set its length in the simplifier
     structure, too.  */
  if (expr->ts.type == BT_CHARACTER)
    se->string_length = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (se->expr)));
}
Esempio n. 2
0
void
gfc_conv_constant (gfc_se * se, gfc_expr * expr)
{
  gfc_ss *ss;

  /* We may be receiving an expression for C_NULL_PTR or C_NULL_FUNPTR.  If
     so, the expr_type will not yet be an EXPR_CONSTANT.  We need to make
     it so here.  */
  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived
      && expr->ts.u.derived->attr.is_iso_c)
    {
      if (expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_PTR 
          || expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_FUNPTR)
        {
          /* Create a new EXPR_CONSTANT expression for our local uses.  */
          expr = gfc_get_int_expr (gfc_default_integer_kind, NULL, 0);
        }
    }

  if (expr->expr_type != EXPR_CONSTANT)
    {
      gfc_expr *e = gfc_get_int_expr (gfc_default_integer_kind, NULL, 0);
      gfc_error ("non-constant initialization expression at %L", &expr->where);
      se->expr = gfc_conv_constant_to_tree (e);
      return;
    }

  ss = se->ss;
  if (ss != NULL)
    {
      gfc_ss_info *ss_info;

      ss_info = ss->info;
      gcc_assert (ss != gfc_ss_terminator);
      gcc_assert (ss_info->type == GFC_SS_SCALAR);
      gcc_assert (ss_info->expr == expr);

      se->expr = ss_info->data.scalar.value;
      se->string_length = ss_info->string_length;
      gfc_advance_se_ss_chain (se);
      return;
    }

  /* Translate the constant and put it in the simplifier structure.  */
  se->expr = gfc_conv_constant_to_tree (expr);

  /* If this is a CHARACTER string, set its length in the simplifier
     structure, too.  */
  if (expr->ts.type == BT_CHARACTER)
    se->string_length = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (se->expr)));
}