From 323c74dacc07833f98c5f289b4146ecdab63496a Mon Sep 17 00:00:00 2001 From: Richard Henderson Date: Wed, 8 Dec 2004 13:17:18 -0800 Subject: [PATCH] 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 --- gcc/fortran/ChangeLog | 9 +++++++++ gcc/fortran/intrinsic.c | 4 ++++ gcc/fortran/iresolve.c | 15 +++++++++++++-- 3 files changed, 26 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 011854902c8..052e7bfcc90 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2004-12-08 Richard Henderson + + * 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 PR fortran/18826 diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index ebf40cea0c5..a079e86374d 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -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; diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 75168757fb7..687421b0b6c 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -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); }