* trans-expr.c (gfc_conv_missing_dummy): Set the type of the dummy
argument to default integer if flagged to do so. Fix typo in comment.
* resolve.c (gfc_resolve_dim_arg): Whitespace cleanup.
* iresolve.c (gfc_resolve_cshift): Do not convert type, mark attribute
for converting the DIM type appropriately in trans-expr.c.
(gfc_resolve_eoshift): Likewise.
* check.c (dim_check): Remove pre-existing dead code.
(gfc_check_cshift): Enable dim_check to allow DIM as an optional.
(gfc_check_eoshift): Likewise.
* trans_intrinsic.c (gfc_conv_intrinsic_function_args): Fix whitespace.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@130276
138bc75d-0d04-0410-961f-
82ee72b054a4
+2007-11-18 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ * trans-expr.c (gfc_conv_missing_dummy): Set the type of the dummy
+ argument to default integer if flagged to do so. Fix typo in comment.
+ * resolve.c (gfc_resolve_dim_arg): Whitespace cleanup.
+ * iresolve.c (gfc_resolve_cshift): Do not convert type, mark attribute
+ for converting the DIM type appropriately in trans-expr.c.
+ (gfc_resolve_eoshift): Likewise.
+ * check.c (dim_check): Remove pre-existing dead code.
+ (gfc_check_cshift): Enable dim_check to allow DIM as an optional.
+ (gfc_check_eoshift): Likewise.
+ * trans_intrinsic.c (gfc_conv_intrinsic_function_args): Fix whitespace.
+
2007-11-18 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31608
if (dim == NULL)
return SUCCESS;
- if (dim == NULL)
- {
- gfc_error ("Missing DIM parameter in intrinsic '%s' at %L",
- gfc_current_intrinsic, gfc_current_intrinsic_where);
- return FAILURE;
- }
-
if (type_check (dim, n, BT_INTEGER) == FAILURE)
return FAILURE;
/* TODO: more requirements on shift parameter. */
}
- /* FIXME (PR33317): Allow optional DIM=. */
- if (dim_check (dim, 2, false) == FAILURE)
+ if (dim_check (dim, 2, true) == FAILURE)
return FAILURE;
return SUCCESS;
/* TODO: more restrictions on boundary. */
}
- /* FIXME (PR33317): Allow optional DIM=. */
- if (dim_check (dim, 4, false) == FAILURE)
+ if (dim_check (dim, 4, true) == FAILURE)
return FAILURE;
return SUCCESS;
gfc_convert_type_warn (shift, &ts, 2, 0);
}
- if (dim != NULL)
- {
- gfc_resolve_dim_arg (dim);
- /* Convert dim to shift's kind, so we don't need so many variations. */
- if (dim->ts.kind != shift->ts.kind)
- gfc_convert_type_warn (dim, &shift->ts, 2, 0);
- }
+ /* Mark this for later setting the type in gfc_conv_missing_dummy. */
+ if (dim != NULL && dim->symtree != NULL)
+ dim->symtree->n.sym->attr.untyped = 1;
+
f->value.function.name
= gfc_get_string (PREFIX ("cshift%d_%d%s"), n, shift->ts.kind,
array->ts.type == BT_CHARACTER ? "_char" : "");
gfc_convert_type_warn (shift, &ts, 2, 0);
}
- if (dim != NULL)
- {
- gfc_resolve_dim_arg (dim);
- /* Convert dim to shift's kind, so we don't need so many variations. */
- if (dim->ts.kind != shift->ts.kind)
- gfc_convert_type_warn (dim, &shift->ts, 2, 0);
- }
+ /* Mark this for later setting the type in gfc_conv_missing_dummy. */
+ if (dim != NULL && dim->symtree != NULL)
+ dim->symtree->n.sym->attr.untyped = 1;
f->value.function.name
= gfc_get_string (PREFIX ("eoshift%d_%d%s"), n, shift->ts.kind,
return FAILURE;
}
+
if (dim->ts.type != BT_INTEGER)
{
gfc_error ("Argument dim at %L must be of INTEGER type", &dim->where);
return FAILURE;
}
+
if (dim->ts.kind != gfc_index_integer_kind)
{
gfc_typespec ts;
tree tmp;
present = gfc_conv_expr_present (arg->symtree->n.sym);
- tmp = build3 (COND_EXPR, TREE_TYPE (se->expr), present, se->expr,
- fold_convert (TREE_TYPE (se->expr), integer_zero_node));
+
+ /* Make sure the type is at least default integer kind to match certain
+ runtime library functions. (ie cshift and eoshift). */
+ if (ts.type == BT_INTEGER && arg->symtree->n.sym->attr.untyped)
+ {
+ tmp = gfc_get_int_type (gfc_default_integer_kind);
+ tmp = fold_convert (tmp, se->expr);
+ }
+ else
+ tmp = build3 (COND_EXPR, TREE_TYPE (se->expr), present, se->expr,
+ fold_convert (TREE_TYPE (se->expr), integer_zero_node));
tmp = gfc_evaluate_now (tmp, &se->pre);
se->expr = tmp;
+
if (ts.type == BT_CHARACTER)
{
tmp = build_int_cst (gfc_charlen_type_node, 0);
}
}
-/* Helper to translate and expression and convert it to a particular type. */
+/* Helper to translate an expression and convert it to a particular type. */
void
gfc_conv_expr_type (gfc_se * se, gfc_expr * expr, tree type)
{
/* If an optional argument is itself an optional dummy argument,
check its presence and substitute a null if absent. */
- if (e->expr_type ==EXPR_VARIABLE
+ if (e->expr_type == EXPR_VARIABLE
&& e->symtree->n.sym->attr.optional
&& formal
&& formal->optional)