OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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.
This commit is contained in:
Mark Eggleston 2020-04-02 07:31:12 +01:00
parent bf1f6d8819
commit 2c54eab5a3
5 changed files with 39 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -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

4
gcc/fortran/check.c
View File

@ -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;

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
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>

11
gcc/testsuite/gfortran.dg/pr93498_1.f90 Normal file
View File

@ -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

12
gcc/testsuite/gfortran.dg/pr93498_2.f90 Normal file
View File

@ -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