diff mbox series

[9/10,Regression] fortran : ICE in gfc_resolve_findloc PR93498

Message ID 27690828-22b9-7711-be64-0d7a05b289e4@codethink.co.uk
State New
Headers show
Series None | expand

Commit Message

Mark Eggleston March 30, 2020, 7 a.m. UTC 
Please find attached patch for PR93498.

OK to commit?

gcc/fortran/ChangeLog:

     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:

     Mark Eggleston  <mark.eggleston@codethink.com>

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

Comments

Tobias Burnus March 30, 2020, 7:53 a.m. UTC | #1 
OK (both GCC 9 + 10). Thanks for the packaging the patch
and to Steven for the patch.

Tobias

On 3/30/20 9:00 AM, Mark Eggleston wrote:

> Please find attached patch for PR93498.
>
> OK to commit?
>
> gcc/fortran/ChangeLog:
>
>     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:
>
>     Mark Eggleston  <mark.eggleston@codethink.com>
>
>     PR fortran/93498
>     * gfortran.dg/pr93498_1.f90:  New test.
>     * gfortran.dg/pr93498_2.f90:  New test.
>
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter
diff mbox series

Patch

From 38865feca36f0837f3fea8b401a2b42fb4f818ca Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Thu, 26 Mar 2020 14:07:09 +0000
Subject: [PATCH] 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:

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

gcc/testsuite/ChangeLog:

	PR fortran/93498
	* gfortran.dg/pr93498_1.f90:  New test.
	* gfortran.dg/pr93498_2.f90:  New test.
---
 gcc/fortran/check.c                     |  4 ++++
 gcc/testsuite/gfortran.dg/pr93498_1.f90 | 11 +++++++++++
 gcc/testsuite/gfortran.dg/pr93498_2.f90 | 12 ++++++++++++
 3 files changed, 27 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pr93498_1.f90
 create mode 100644 gcc/testsuite/gfortran.dg/pr93498_2.f90

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 519aa8b8c2b..cdabbf5e12a 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -3947,6 +3947,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/gfortran.dg/pr93498_1.f90 b/gcc/testsuite/gfortran.dg/pr93498_1.f90
new file mode 100644
index 00000000000..0210cc7951e
--- /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
index 00000000000..ee9238ffa24
--- /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
+
+
-- 
2.11.0