diff options
author | Mark Eggleston <markeggleston@gcc.gnu.org> | 2020-04-02 07:31:12 +0100 |
---|---|---|
committer | Mark Eggleston <markeggleston@gcc.gnu.org> | 2020-04-02 07:31:12 +0100 |
commit | 2c54eab5a302c6da015bb39b1a81f6799e45a650 (patch) | |
tree | 0e65bf74cb366cdcff9a9f5fa4c92194e1a4c1ab | |
parent | bf1f6d8819ade074271df718f01fd3a5a9dc1b82 (diff) | |
download | gcc-2c54eab5a302c6da015bb39b1a81f6799e45a650.zip gcc-2c54eab5a302c6da015bb39b1a81f6799e45a650.tar.gz gcc-2c54eab5a302c6da015bb39b1a81f6799e45a650.tar.bz2 |
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.
-rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/fortran/check.c | 4 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/pr93498_1.f90 | 11 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/pr93498_2.f90 | 12 |
5 files changed, 39 insertions, 0 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1aa71d8..89de9d0 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2020-04-02 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 Steven G. Kargl <kargl@gcc.gnu.org> PR fortran/94030 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 519aa8b..cdabbf5 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/ChangeLog b/gcc/testsuite/ChangeLog index 2a686d2..ac1695f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,4 +1,10 @@ 2020-04-02 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 <mark.eggleston@codethink.com> Steven G. Kargl <kargl@gcc.gnu.org> PR fortran/94030 diff --git a/gcc/testsuite/gfortran.dg/pr93498_1.f90 b/gcc/testsuite/gfortran.dg/pr93498_1.f90 new file mode 100644 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 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 + + |