Hello world,
the attached patch fixes an ICE which could occur for empty
substrings (see test case).
In the spirit of "A patch that works beats an elegant idea every
time" I simply set a substring known to be empty to (1:0) so
that problems further down the road could be avoided.
Regression-tested. OK for trunk?
Regards
Thomas
2020-01-19 Thomas König <[email protected]>
PR fortran/85781
* resolve.c (resolve_substring): If the substring is empty, set it
to (1:0) explicitly.
2020-01-19 Thomas König <[email protected]>
PR fortran/85781
* gfortran.dg/substr_9.f90: New test.
commit 476a7e195399d2dc76b22947dcbde59f36fe5748
Author: Thomas König <[email protected]>
Date: Sun Jan 19 19:14:41 2020 +0100
2020-01-19 Thomas König <[email protected]>
PR fortran/85781
* resolve.c (resolve_substring): If the substring is empty, set it
to (1:0) explicitly.
2020-01-19 Thomas König <[email protected]>
PR fortran/85781
* gfortran.dg/substr_9.f90: New test.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e840aec62f2..5f644da9bf2 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5092,6 +5092,19 @@ resolve_substring (gfc_ref *ref, bool *equal_length)
&& compare_bound (ref->u.ss.end, ref->u.ss.length->length) == CMP_EQ
&& compare_bound_int (ref->u.ss.start, 1) == CMP_EQ)
*equal_length = true;
+
+ }
+
+ /* Set empty substrings to (1:0) to avoid subsequent ICEs. */
+ if (gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end) == 1)
+ {
+ locus loc;
+ loc = ref->u.ss.start->where;
+ gfc_free_expr (ref->u.ss.start);
+ ref->u.ss.start = gfc_get_int_expr (gfc_index_integer_kind, &loc, 1);
+ loc = ref->u.ss.end->where;
+ gfc_free_expr (ref->u.ss.end);
+ ref->u.ss.end = gfc_get_int_expr (gfc_index_integer_kind, &loc, 0);
}
return true;
diff --git a/gcc/testsuite/gfortran.dg/substr_9.f90 b/gcc/testsuite/gfortran.dg/substr_9.f90
new file mode 100644
index 00000000000..60557d0cc53
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/substr_9.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! PR 85781 - this used to cause an ICE.
+subroutine s(x) bind(c)
+ use iso_c_binding, only: c_char
+ character(kind=c_char), value :: x
+ print *, x(2:1)
+end
! { dg-do compile }
! PR 85781 - this used to cause an ICE.
subroutine s(x) bind(c)
use iso_c_binding, only: c_char
character(kind=c_char), value :: x
print *, x(2:1)
end
