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

fortran : ICE in gfc_resolve_findloc PR93498

Browse Source 
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