From b6e546912555c9b9b27bdce516e98546f4cd3d25 Mon Sep 17 00:00:00 2001 From: Mark Eggleston Date: Thu, 2 Apr 2020 08:42:41 +0100 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 . gcc/fortran/ChangeLog: Backport from master Steven G. Kargl 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 PR fortran/93498 * gfortran.dg/pr93498_1.f90: New test. * gfortran.dg/pr93498_2.f90: New test. --- gcc/fortran/ChangeLog | 9 +++++++++ gcc/fortran/check.c | 4 ++++ gcc/testsuite/ChangeLog | 9 +++++++++ gcc/testsuite/gfortran.dg/pr93498_1.f90 | 11 +++++++++++ gcc/testsuite/gfortran.dg/pr93498_2.f90 | 12 ++++++++++++ 5 files changed, 45 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/ChangeLog b/gcc/fortran/ChangeLog index 42b184e8864b..744511a5cb8e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2020-04-02 Mark Eggleston + + Backport from master + Steven G. Kargl + + PR fortran/93498 + * check.c (gfc_check_findloc): If the kinds of the arguments + differ goto label "incompat". + 2020-04-02 Mark Eggleston Backport from master diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 6d37bbb8fd2a..adda284ef719 100644 --- 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 93cb052ca9f5..185750138a19 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2020-04-02 Mark Eggleston + + Backport from master + Mark Eggleston + + PR fortran/93498 + * gfortran.dg/pr93498_1.f90: New test. + * gfortran.dg/pr93498_2.f90: New test. + 2020-04-02 Mark Eggleston 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 index 000000000000..0210cc7951e2 --- /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 000000000000..ee9238ffa241 --- /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.47.2