+2007-11-23 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR fortran/34209
+ * iresolve.c (gfc_resolve_nearest): If sign variable kind does not match
+ kind of input variable, convert it to match.
+
+ PR fortran/33317
+ * trans.h: Modify prototype for gfc_conv_missing_dummy.
+ * trans-expr.c (gfc_conv_missing_dummy): Modify to pass an integer kind
+ parameter in. Set the type of the dummy to the kind given.
+ (gfc_conv_function_call): Pass representation.length to
+ gfc_conv_missing_dummy.
+ * iresolve.c (gfc_resolve_cshift): Determine the correct kind to use and
+ if appropriate set representation.length to this kind value.
+ (gfc_resolve_eoshift): Likewise.
+ * check.c (gfc_check_cshift): Enable dim_check to allow DIM as an
+ optional argument. (gfc_check_eoshift): Likewise.
+ * trans_intrinsic.c (gfc_conv_intrinsic_function_args): Update call to
+ gfc_conv_missing_dummy.
+
2007-11-23 Tobias Burnus <burnus@net-b.de>
PR fortran/34187
gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
gfc_expr *dim)
{
- int n;
+ int n, m;
if (array->ts.type == BT_CHARACTER && array->ref)
gfc_resolve_substring_charlen (array);
else
n = 0;
- /* Convert shift to at least gfc_default_integer_kind, so we don't need
- kind=1 and kind=2 versions of the library functions. */
- if (shift->ts.kind < gfc_default_integer_kind)
+ /* If dim kind is greater than default integer we need to use the larger. */
+ m = gfc_default_integer_kind;
+ if (dim != NULL)
+ m = m < dim->ts.kind ? dim->ts.kind : m;
+
+ /* Convert shift to at least m, so we don't need
+ kind=1 and kind=2 versions of the library functions. */
+ if (shift->ts.kind < m)
{
gfc_typespec ts;
ts.type = BT_INTEGER;
- ts.kind = gfc_default_integer_kind;
+ ts.kind = m;
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);
+ if (dim->expr_type != EXPR_CONSTANT)
+ {
+ /* Mark this for later setting the type in gfc_conv_missing_dummy. */
+ dim->representation.length = shift->ts.kind;
+ }
+ else
+ {
+ gfc_resolve_dim_arg (dim);
+ /* Convert dim to shift's kind to reduce variations. */
+ if (dim->ts.kind != shift->ts.kind)
+ gfc_convert_type_warn (dim, &shift->ts, 2, 0);
+ }
}
f->value.function.name
gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
gfc_expr *boundary, gfc_expr *dim)
{
- int n;
+ int n, m;
if (array->ts.type == BT_CHARACTER && array->ref)
gfc_resolve_substring_charlen (array);
if (boundary && boundary->rank > 0)
n = n | 2;
- /* Convert shift to at least gfc_default_integer_kind, so we don't need
- kind=1 and kind=2 versions of the library functions. */
- if (shift->ts.kind < gfc_default_integer_kind)
+ /* If dim kind is greater than default integer we need to use the larger. */
+ m = gfc_default_integer_kind;
+ if (dim != NULL)
+ m = m < dim->ts.kind ? dim->ts.kind : m;
+
+ /* Convert shift to at least m, so we don't need
+ kind=1 and kind=2 versions of the library functions. */
+ if (shift->ts.kind < m)
{
gfc_typespec ts;
ts.type = BT_INTEGER;
- ts.kind = gfc_default_integer_kind;
+ ts.kind = m;
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);
+ if (dim->expr_type != EXPR_CONSTANT)
+ {
+ /* Mark this for later setting the type in gfc_conv_missing_dummy. */
+ dim->representation.length = shift->ts.kind;
+ }
+ else
+ {
+ gfc_resolve_dim_arg (dim);
+ /* Convert dim to shift's kind to reduce variations. */
+ if (dim->ts.kind != shift->ts.kind)
+ gfc_convert_type_warn (dim, &shift->ts, 2, 0);
+ }
}
f->value.function.name
}
void
-gfc_resolve_nearest (gfc_expr *f, gfc_expr *a, gfc_expr *p ATTRIBUTE_UNUSED)
+gfc_resolve_nearest (gfc_expr *f, gfc_expr *a, gfc_expr *p)
{
+ if (p->ts.kind != a->ts.kind)
+ gfc_convert_type (p, &a->ts, 2);
+
f->ts = a->ts;
f->value.function.name
= gfc_get_string ("__nearest_%c%d", gfc_type_letter (a->ts.type),
/* Converts a missing, dummy argument into a null or zero. */
void
-gfc_conv_missing_dummy (gfc_se * se, gfc_expr * arg, gfc_typespec ts)
+gfc_conv_missing_dummy (gfc_se * se, gfc_expr * arg, gfc_typespec ts, int kind)
{
tree present;
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));
-
+ fold_convert (TREE_TYPE (se->expr), integer_zero_node));
tmp = gfc_evaluate_now (tmp, &se->pre);
+
+ if (kind > 0)
+ {
+ tmp = gfc_get_int_type (kind);
+ tmp = fold_convert (tmp, se->expr);
+ tmp = gfc_evaluate_now (tmp, &se->pre);
+ }
+
se->expr = tmp;
if (ts.type == BT_CHARACTER)
check its presence and substitute a null if absent. */
if (e->expr_type == EXPR_VARIABLE
&& e->symtree->n.sym->attr.optional)
- gfc_conv_missing_dummy (&parmse, e, fsym ? fsym->ts : e->ts);
+ gfc_conv_missing_dummy (&parmse, e, fsym ? fsym->ts : e->ts,
+ e->representation.length);
}
if (fsym && e)
projects / gcc.git / commitdiff