summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog20
-rw-r--r--gcc/fortran/check.c6
-rw-r--r--gcc/fortran/iresolve.c71
-rw-r--r--gcc/fortran/trans-expr.c16
-rw-r--r--gcc/fortran/trans-intrinsic.c2
-rw-r--r--gcc/fortran/trans.h2
6 files changed, 86 insertions, 31 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b0fa324f984..ce45d6041be 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,23 @@
+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
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 5b12147d6a0..511dce63c12 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -863,8 +863,7 @@ gfc_check_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim)
/* 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;
@@ -1033,8 +1032,7 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
/* 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;
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index e685a0a263d..b8470441885 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -559,7 +559,7 @@ void
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);
@@ -573,22 +573,35 @@ gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
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
@@ -683,7 +696,7 @@ void
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);
@@ -698,22 +711,35 @@ gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
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
@@ -1580,8 +1606,11 @@ gfc_resolve_modulo (gfc_expr *f, gfc_expr *a, gfc_expr *p)
}
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),
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index c47f69b8b38..231fef5bf7b 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -146,7 +146,7 @@ gfc_conv_expr_present (gfc_symbol * sym)
/* 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;
@@ -154,9 +154,16 @@ gfc_conv_missing_dummy (gfc_se * se, gfc_expr * arg, gfc_typespec ts)
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)
@@ -2324,7 +2331,8 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
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)
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 23c94f651da..63c56040eb2 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -214,7 +214,7 @@ gfc_conv_intrinsic_function_args (gfc_se *se, gfc_expr *expr,
&& e->symtree->n.sym->attr.optional
&& formal
&& formal->optional)
- gfc_conv_missing_dummy (&argse, e, formal->ts);
+ gfc_conv_missing_dummy (&argse, e, formal->ts, 0);
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index eafd2802777..658dcd0e87d 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -332,7 +332,7 @@ void gfc_conv_structure (gfc_se *, gfc_expr *, int);
/* Return an expression which determines if a dummy parameter is present. */
tree gfc_conv_expr_present (gfc_symbol *);
/* Convert a missing, dummy argument into a null or zero. */
-void gfc_conv_missing_dummy (gfc_se *, gfc_expr *, gfc_typespec);
+void gfc_conv_missing_dummy (gfc_se *, gfc_expr *, gfc_typespec, int);
/* Generate code to allocate a string temporary. */
tree gfc_conv_string_tmp (gfc_se *, tree, tree);
View Lorry Controller Status