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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7819bd4001afeb5cce3c26e98a2246f1d6978b64..82164d713aef7cb368e51b42a9b256d8a2b6ec0f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index f66ed93f9f40620d0558db158077fd5047a167e0..d2a4949e12b41e2809e42a34a9cdb27548cb5a8e 100644 (file)
--- 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;
 }
 
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b11a1bf7d7dcda426a13a954ea24c95cdd4b339b..cdc717945be2e114bb5e9ce249f175a0366fa97b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-10-11  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/91649
+       * gfortran.dg/pr91649.f90: New test.
+
 2019-10-11  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/91715

diff --git a/gcc/testsuite/gfortran.dg/pr91649.f90 b/gcc/testsuite/gfortran.dg/pr91649.f90
new file mode 100644 (file)
index 0000000..0e6acb9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr91649.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! PR fortran/91649
+! Code originally contributed by Gerhard Steinmetz
+subroutine p
+   logical :: back = .true.
+   integer :: x(1) = findloc([1, 2, 1], '1', back=back) ! { dg-error "must be in type conformance" }
+   print *, x
+end
+
+subroutine q
+   type t
+   end type
+   logical :: back = .false.
+   integer :: x(1) = findloc([1, 2, 1], t(), back=back) ! { dg-error "must be of intrinsic type" }
+   print *, x
+end
+
+subroutine s
+   character(4) :: c = '1234'
+   integer :: x(1) = findloc([1, 2, 1], c, back=.true.) ! { dg-error "must be in type conformance" }
+   print *, x
+end
+