OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

intrinsic.c (gfc_convert_type_warn): Propagate the input shape to the output expression. 

* intrinsic.c (gfc_convert_type_warn): Propagate the input shape
        to the output expression.
        * iresolve.c (gfc_resolve_cshift, gfc_resolve_eoshift): Suppress
        warning conversion.
        (gfc_resolve_reshape): Force convert SHAPE and ORDER parameters
        to index kind.

From-SVN: r91917
This commit is contained in:
Richard Henderson 2004-12-08 13:17:18 -08:00 committed by Richard Henderson
parent 1b227ee01a
commit 323c74dacc
3 changed files with 26 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View File

@ -1,3 +1,12 @@
2004-12-08 Richard Henderson <rth@redhat.com>
* intrinsic.c (gfc_convert_type_warn): Propagate the input shape
to the output expression.
* iresolve.c (gfc_resolve_cshift, gfc_resolve_eoshift): Suppress
warning conversion.
(gfc_resolve_reshape): Force convert SHAPE and ORDER parameters
to index kind.
2004-12-08 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
PR fortran/18826

4
gcc/fortran/intrinsic.c
View File

@ -3014,6 +3014,7 @@ gfc_convert_type_warn (gfc_expr * expr, gfc_typespec * ts, int eflag,
locus old_where;
gfc_expr *new;
int rank;
mpz_t *shape;
from_ts = expr->ts; /* expr->ts gets clobbered */
@ -3050,6 +3051,8 @@ gfc_convert_type_warn (gfc_expr * expr, gfc_typespec * ts, int eflag,
/* Insert a pre-resolved function call to the right function. */
old_where = expr->where;
rank = expr->rank;
shape = expr->shape;
new = gfc_get_expr ();
*new = *expr;
@ -3058,6 +3061,7 @@ gfc_convert_type_warn (gfc_expr * expr, gfc_typespec * ts, int eflag,
new->value.function.isym = sym;
new->where = old_where;
new->rank = rank;
new->shape = gfc_copy_shape (shape, rank);
*expr = *new;

15
gcc/fortran/iresolve.c
View File

@ -421,7 +421,7 @@ gfc_resolve_cshift (gfc_expr * f, gfc_expr * array,
gfc_resolve_index (dim, 1);
/* Convert dim to shift's kind, so we don't need so many variations. */
if (dim->ts.kind != shift->ts.kind)
gfc_convert_type (dim, &shift->ts, 2);
gfc_convert_type_warn (dim, &shift->ts, 2, 0);
}
f->value.function.name =
gfc_get_string ("__cshift%d_%d", n, shift->ts.kind);
@ -510,7 +510,7 @@ gfc_resolve_eoshift (gfc_expr * f, gfc_expr * array,
/* Convert dim to the same type as shift, so we don't need quite so many
variations. */
if (dim != NULL && dim->ts.kind != shift->ts.kind)
gfc_convert_type (dim, &shift->ts, 2);
gfc_convert_type_warn (dim, &shift->ts, 2, 0);
f->value.function.name =
gfc_get_string ("__eoshift%d_%d", n, shift->ts.kind);
@ -1172,6 +1172,17 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
c = c->next;
}
}
/* Force-convert both SHAPE and ORDER to index_kind so that we don't need
so many runtime variations. */
if (shape->ts.kind != gfc_index_integer_kind)
{
gfc_typespec ts = shape->ts;
ts.kind = gfc_index_integer_kind;
gfc_convert_type_warn (shape, &ts, 2, 0);
}
if (order && order->ts.kind != gfc_index_integer_kind)
gfc_convert_type_warn (order, &shape->ts, 2, 0);
}