diff options
author | Steven G. Kargl <kargl@gcc.gnu.org> | 2019-10-11 18:05:35 +0000 |
---|---|---|
committer | Steven G. Kargl <kargl@gcc.gnu.org> | 2019-10-11 18:05:35 +0000 |
commit | e8c78b3a0c7be7020b77f9a8ef04e970b391f1aa (patch) | |
tree | 29754a1aaea340bfe3241f73896e31f114684ad2 /gcc/fortran | |
parent | 95040e7e207dc0a2024c2ed10b8b15de4b369ece (diff) | |
download | gcc-e8c78b3a0c7be7020b77f9a8ef04e970b391f1aa.zip gcc-e8c78b3a0c7be7020b77f9a8ef04e970b391f1aa.tar.gz gcc-e8c78b3a0c7be7020b77f9a8ef04e970b391f1aa.tar.bz2 |
re PR fortran/91649 (ICE in gfc_resolve_findloc, at fortran/iresolve.c:1827)
2019-10-11 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/91649
check.c (gfc_check_findloc): Additional checking for valid arguments
2019-10-11 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/91649
* gfortran.dg/pr91649.f90: New test.
From-SVN: r276900
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/fortran/check.c | 31 |
2 files changed, 25 insertions, 11 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7819bd4..82164d7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,10 @@ 2019-10-11 Steven G. Kargl <kargl@gcc.gnu.org> + PR fortran/91649 + check.c (gfc_check_findloc): Additional checking for valid arguments + +2019-10-11 Steven G. Kargl <kargl@gcc.gnu.org> + PR fortran/91715 * decl.c (gfc_match_prefix): If matching a type-spec returns an error, it's an error so re-act correctly. diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index f66ed93..d2a4949 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -3921,26 +3921,27 @@ bool gfc_check_findloc (gfc_actual_arglist *ap) { gfc_expr *a, *v, *m, *d, *k, *b; + bool a1, v1; a = ap->expr; if (!intrinsic_type_check (a, 0) || !array_check (a, 0)) return false; v = ap->next->expr; - if (!scalar_check (v,1)) + if (!intrinsic_type_check (v, 1) || !scalar_check (v,1)) return false; - /* Check if the type is compatible. */ + /* Check if the type are both logical. */ + a1 = a->ts.type == BT_LOGICAL; + v1 = v->ts.type == BT_LOGICAL; + if ((a1 && !v1) || (!a1 && v1)) + goto incompat; - if ((a->ts.type == BT_LOGICAL && v->ts.type != BT_LOGICAL) - || (a->ts.type != BT_LOGICAL && v->ts.type == BT_LOGICAL)) - { - gfc_error ("Argument %qs of %qs intrinsic at %L must be in type " - "conformance to argument %qs at %L", - gfc_current_intrinsic_arg[0]->name, - gfc_current_intrinsic, &a->where, - gfc_current_intrinsic_arg[1]->name, &v->where); - } + /* Check if the type are both character. */ + a1 = a->ts.type == BT_CHARACTER; + v1 = v->ts.type == BT_CHARACTER; + if ((a1 && !v1) || (!a1 && v1)) + goto incompat; d = ap->next->next->expr; m = ap->next->next->next->expr; @@ -3988,6 +3989,14 @@ gfc_check_findloc (gfc_actual_arglist *ap) return false; return true; + +incompat: + gfc_error ("Argument %qs of %qs intrinsic at %L must be in type " + "conformance to argument %qs at %L", + gfc_current_intrinsic_arg[0]->name, + gfc_current_intrinsic, &a->where, + gfc_current_intrinsic_arg[1]->name, &v->where); + return false; } |