aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
authorSteven G. Kargl <kargl@gcc.gnu.org>2019-10-11 18:05:35 +0000
committerSteven G. Kargl <kargl@gcc.gnu.org>2019-10-11 18:05:35 +0000
commite8c78b3a0c7be7020b77f9a8ef04e970b391f1aa (patch)
tree29754a1aaea340bfe3241f73896e31f114684ad2 /gcc/fortran
parent95040e7e207dc0a2024c2ed10b8b15de4b369ece (diff)
downloadgcc-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/ChangeLog5
-rw-r--r--gcc/fortran/check.c31
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;
}