diff options
Diffstat (limited to 'gcc/fortran/check.c')
| -rw-r--r-- | gcc/fortran/check.c | 25 |
1 files changed, 23 insertions, 2 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index fccb927..a2c8b52 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -3265,12 +3265,13 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) DIM MASK I.e. in the case of minloc(array,mask), mask will be in the second - position of the argument list and we'll have to fix that up. */ + position of the argument list and we'll have to fix that up. Also, + add the BACK argument if that isn't present. */ bool gfc_check_minloc_maxloc (gfc_actual_arglist *ap) { - gfc_expr *a, *m, *d, *k; + gfc_expr *a, *m, *d, *k, *b; a = ap->expr; if (!int_or_real_or_char_check_f2003 (a, 0) || !array_check (a, 0)) @@ -3279,6 +3280,26 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap) d = ap->next->expr; m = ap->next->next->expr; k = ap->next->next->next->expr; + b = ap->next->next->next->next->expr; + + if (b) + { + if (!type_check (b, 4, BT_LOGICAL) || !scalar_check (b,4)) + return false; + + /* TODO: Remove this once BACK is actually implemented. */ + if (b->expr_type != EXPR_CONSTANT || b->value.logical != 0) + { + gfc_error ("BACK argument to %qs intrinsic not yet " + "implemented", gfc_current_intrinsic); + return false; + } + } + else + { + b = gfc_get_logical_expr (gfc_default_logical_kind, NULL, 0); + ap->next->next->next->next->expr = b; + } if (m == NULL && d != NULL && d->ts.type == BT_LOGICAL && ap->next->name == NULL) |