diff options
| author | Francois-Xavier Coudert <coudert@clipper.ens.fr> | 2005-11-27 15:01:36 +0100 |
|---|---|---|
| committer | François-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2005-11-27 14:01:36 +0000 |
| commit | 991bb832494d3e422ef703e317cd0dc21ab74ac3 (patch) | |
| tree | c6f3cbda99666c39f12216bd3f642f6df5fcb01c /gcc/fortran/simplify.c | |
| parent | b604fe9b84e41f387222758a300dce02a39a6b1b (diff) | |
| download | gcc-991bb832494d3e422ef703e317cd0dc21ab74ac3.zip gcc-991bb832494d3e422ef703e317cd0dc21ab74ac3.tar.gz gcc-991bb832494d3e422ef703e317cd0dc21ab74ac3.tar.bz2 | |
re PR fortran/23912 (MOD function requires same kind arguments)
PR fortran/23912
* iresolve.c (gfc_resolve_dim, gfc_resolve_mod,
gfc_resolve_modulo): When arguments have different kinds, fold
the lower one to the largest kind.
* check.c (gfc_check_a_p): Arguments of different kinds is not
a hard error, but an extension.
* simplify.c (gfc_simplify_dim, gfc_simplify_mod,
gfc_simplify_modulo): When arguments have different kinds, fold
the lower one to the largest kind.
* gfortran.dg/modulo_1.f90: New test.
From-SVN: r107566
Diffstat (limited to 'gcc/fortran/simplify.c')
| -rw-r--r-- | gcc/fortran/simplify.c | 16 |
1 files changed, 11 insertions, 5 deletions
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index b6931f1..e6fbefc 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -920,11 +920,13 @@ gfc_expr * gfc_simplify_dim (gfc_expr * x, gfc_expr * y) { gfc_expr *result; + int kind; if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) return NULL; - result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind; + result = gfc_constant_result (x->ts.type, kind, &x->where); switch (x->ts.type) { @@ -2250,11 +2252,13 @@ gfc_simplify_mod (gfc_expr * a, gfc_expr * p) { gfc_expr *result; mpfr_t quot, iquot, term; + int kind; if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT) return NULL; - result = gfc_constant_result (a->ts.type, a->ts.kind, &a->where); + kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind; + result = gfc_constant_result (a->ts.type, kind, &a->where); switch (a->ts.type) { @@ -2278,7 +2282,7 @@ gfc_simplify_mod (gfc_expr * a, gfc_expr * p) return &gfc_bad_expr; } - gfc_set_model_kind (a->ts.kind); + gfc_set_model_kind (kind); mpfr_init (quot); mpfr_init (iquot); mpfr_init (term); @@ -2306,11 +2310,13 @@ gfc_simplify_modulo (gfc_expr * a, gfc_expr * p) { gfc_expr *result; mpfr_t quot, iquot, term; + int kind; if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT) return NULL; - result = gfc_constant_result (a->ts.type, a->ts.kind, &a->where); + kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind; + result = gfc_constant_result (a->ts.type, kind, &a->where); switch (a->ts.type) { @@ -2336,7 +2342,7 @@ gfc_simplify_modulo (gfc_expr * a, gfc_expr * p) return &gfc_bad_expr; } - gfc_set_model_kind (a->ts.kind); + gfc_set_model_kind (kind); mpfr_init (quot); mpfr_init (iquot); mpfr_init (term); |