diff options
| author | Richard Sandiford <richard.sandiford@linaro.org> | 2017-11-20 16:02:55 +0000 |
|---|---|---|
| committer | Richard Sandiford <richard.sandiford@linaro.org> | 2017-11-20 16:02:55 +0000 |
| commit | d58952aefb03632bbb5b441d5c0bd330711f0af1 (patch) | |
| tree | d046e56bfbd6a40106ae6ab96fafc954f1dfc955 /gcc/fortran/check.c | |
| parent | 648f8fc59b2cc39abd24f4c22388b346cdebcc31 (diff) | |
| parent | 50221fae802a10fafe95e61d40504a58da33e98f (diff) | |
| download | gcc-linaro-dev/sve.tar.gz | |
Merge trunk into svelinaro-dev/sve
Diffstat (limited to 'gcc/fortran/check.c')
| -rw-r--r-- | gcc/fortran/check.c | 25 |
1 files changed, 18 insertions, 7 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 759c15adaec..a147449bf70 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -427,15 +427,22 @@ less_than_bitsize2 (const char *arg1, gfc_expr *expr1, const char *arg2, /* Make sure two expressions have the same type. */ static bool -same_type_check (gfc_expr *e, int n, gfc_expr *f, int m) +same_type_check (gfc_expr *e, int n, gfc_expr *f, int m, bool assoc = false) { gfc_typespec *ets = &e->ts; gfc_typespec *fts = &f->ts; - if (e->ts.type == BT_PROCEDURE && e->symtree->n.sym) - ets = &e->symtree->n.sym->ts; - if (f->ts.type == BT_PROCEDURE && f->symtree->n.sym) - fts = &f->symtree->n.sym->ts; + if (assoc) + { + /* Procedure pointer component expressions have the type of the interface + procedure. If they are being tested for association with a procedure + pointer (ie. not a component), the type of the procedure must be + determined. */ + if (e->ts.type == BT_PROCEDURE && e->symtree->n.sym) + ets = &e->symtree->n.sym->ts; + if (f->ts.type == BT_PROCEDURE && f->symtree->n.sym) + fts = &f->symtree->n.sym->ts; + } if (gfc_compare_types (ets, fts)) return true; @@ -1002,7 +1009,7 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target) } t = true; - if (!same_type_check (pointer, 0, target, 1)) + if (!same_type_check (pointer, 0, target, 1, true)) t = false; if (!rank_check (target, 0, pointer->rank)) t = false; @@ -3179,7 +3186,7 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) bool gfc_check_minloc_maxloc (gfc_actual_arglist *ap) { - gfc_expr *a, *m, *d; + gfc_expr *a, *m, *d, *k; a = ap->expr; if (!int_or_real_check (a, 0) || !array_check (a, 0)) @@ -3187,6 +3194,7 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap) d = ap->next->expr; m = ap->next->next->expr; + k = ap->next->next->next->expr; if (m == NULL && d != NULL && d->ts.type == BT_LOGICAL && ap->next->name == NULL) @@ -3214,6 +3222,9 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap) gfc_current_intrinsic)) return false; + if (!kind_check (k, 1, BT_INTEGER)) + return false; + return true; } |