ICE on wrong code [PR94192].

The idea is not have another resolution of a pointer if an error has
occurred previously.

2020-04-13  Linus Koenig <link@sig-st.de>

	PR fortran/94192
	* resolve.c (resolve_fl_var_and_proc): Set flag "error" to 1 if
	pointer is found to not have an assumed rank or a deferred shape.
	* simplify.c (simplify_bound): If an error has been issued for a
	given pointer, one should not attempt to find its bounds.

2020-04-13  Linus Koenig <link@sig-st.de>

	PR fortran/94192
	* gfortran.dg/bound_resolve_after_error_1.f90: New test.
This commit is contained in:
Linus Koenig 2020-04-13 16:30:44 +02:00 committed by Thomas König
parent 8d213cbbe1
commit efbf739207
5 changed files with 31 additions and 0 deletions

View File

@ -1,3 +1,11 @@
2020-04-13 Linus Koenig <link@sig-st.de>
PR fortran/94192
* resolve.c (resolve_fl_var_and_proc): Set flag "error" to 1 if
pointer is found to not have an assumed rank or a deferred shape.
* simplify.c (simplify_bound): If an error has been issued for a
given pointer, one should not attempt to find its bounds.
2020-04-09 Fritz Reese <foreese@gcc.gnu.org>
PR fortran/87923

View File

@ -12622,6 +12622,7 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
{
gfc_error ("Array pointer %qs at %L must have a deferred shape or "
"assumed rank", sym->name, &sym->declared_at);
sym->error = 1;
return false;
}
}

View File

@ -4159,6 +4159,10 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
gfc_array_spec *as;
int d;
/* Do not attempt to resolve if error has already been issued. */
if (array->symtree && array->symtree->n.sym->error)
return NULL;
if (array->ts.type == BT_CLASS)
return NULL;

View File

@ -1,3 +1,8 @@
2020-04-13 Linus Koenig <link@sig-st.de>
PR fortran/94192
* gfortran.dg/bound_resolve_after_error_1.f90: New test.
2020-04-13 Nathan Sidwell <nathan@acm.org>
PR c++/94426

View File

@ -0,0 +1,13 @@
! Testcase for bound check after issued error
! See PR 94192
! { dg-do compile }
program bound_for_illegal
contains
subroutine bnds(a) ! { dg-error "must have a deferred shape or assumed rank" }
integer, pointer, intent(in) :: a(1:2)
print *,lbound(a)
end subroutine bnds
end program bound_for_illegal