fortran : ICE in gfc_resolve_findloc PR93498

ICE occurs when findloc is used with character arguments of different
kinds.  If the character kinds are different reject the code.

Original patch provided by Steven G. Kargl  <kargl@gcc.gnu.org>.

gcc/fortran/ChangeLog:

	Backport from master
	Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/93498
	* check.c (gfc_check_findloc):  If the kinds of the arguments
	differ goto label "incompat".

gcc/testsuite/ChangeLog:

	Backport from master
	2020-04-02  Mark Eggleston <markeggleston@gcc.gnu.org>

	PR fortran/93498
	* gfortran.dg/pr93498_1.f90:  New test.
	* gfortran.dg/pr93498_2.f90:  New test.

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 42b184e8864b8165f8b7d33b31702b58a31995ae..744511a5cb8ee2e19ac503c130f72069860f0cb9 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2020-04-02  Mark Eggleston <markeggleston@gcc.gnu.org>
+
+       Backport from master
+       Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/93498
+       * check.c (gfc_check_findloc):  If the kinds of the arguments
+       differ goto label "incompat".
+
 2020-04-02  Mark Eggleston <markeggleston@gcc.gnu.org>
 
        Backport from master

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 6d37bbb8fd2a8d2be188f9bdd3aeaa174fb9985d..adda284ef7191bc9fbe528c71758637b928cd400 100644 (file)
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -3384,6 +3384,10 @@ gfc_check_findloc (gfc_actual_arglist *ap)
   v1 = v->ts.type == BT_CHARACTER;
   if ((a1 && !v1) || (!a1 && v1))
     goto incompat;
+
+  /* Check the kind of the characters argument match.  */
+  if (a1 && v1 && a->ts.kind != v->ts.kind)
+    goto incompat;
         
   d = ap->next->next->expr;
   m = ap->next->next->next->expr;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 93cb052ca9f5d0bac5d6508cc28e056d524d8f0f..185750138a196179ee9199b018dc35526edf597a 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,12 @@
+2020-04-02  Mark Eggleston <markeggleston@gcc.gnu.org>
+
+       Backport from master
+       Mark Eggleston  <mark.eggleston@codethink.com>
+
+       PR fortran/93498
+       * gfortran.dg/pr93498_1.f90:  New test.
+       * gfortran.dg/pr93498_2.f90:  New test.
+
 2020-04-02  Mark Eggleston <markeggleston@gcc.gnu.org>
 
        Backport from master

diff --git a/gcc/testsuite/gfortran.dg/pr93498_1.f90 b/gcc/testsuite/gfortran.dg/pr93498_1.f90
new file mode 100644 (file)
index 0000000..0210cc7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr93498_1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! Test case by  G. Steinmetz
+
+program p
+   character(len=1, kind=1) :: x(3) = ['a', 'b', 'c']
+   character(len=1, kind=4) :: y = 4_'b'
+   print *, findloc(x, y)     ! { dg-error " must be in type conformance" }
+   print *, findloc(x, y, 1)  ! { dg-error " must be in type conformance" }
+end
+

diff --git a/gcc/testsuite/gfortran.dg/pr93498_2.f90 b/gcc/testsuite/gfortran.dg/pr93498_2.f90
new file mode 100644 (file)
index 0000000..ee9238f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr93498_2.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+!
+! Test case by  G. Steinmetz
+
+program p
+   character(len=1, kind=4) :: x(3) = [4_'a', 4_'b', 4_'c']
+   character(len=1, kind=1) :: y = 'b'
+   print *, findloc(x, y)     ! { dg-error " must be in type conformance" }
+   print *, findloc(x, y, 1)  ! { dg-error " must be in type conformance" }
+end
+
+