PR fortran/100274 - ICE in gfc_conv_procedure_call, at fortran/trans-expr.c:6131

When the check for the length of formal and actual character arguments
found a mismatch and emitted a warning, it would skip further checks
like that could lead to errors.  Fix that by continuing the checking.
Also catch a NULL pointer dereference.

gcc/fortran/ChangeLog:

	PR fortran/100274
	* interface.c (gfc_compare_actual_formal): Continue checks after
	emitting warning for argument length mismatch.
	* trans-expr.c (gfc_conv_procedure_call): Check for NULL pointer
	dereference.

gcc/testsuite/ChangeLog:

	PR fortran/100274
	* gfortran.dg/argument_checking_25.f90: New test.
This commit is contained in:
Harald Anlauf 2021-05-05 15:25:50 +02:00
parent f3661f2d63
commit a8b79cc939
3 changed files with 20 additions and 4 deletions

View file

@ -3255,10 +3255,13 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
&& f->sym->attr.flavor != FL_PROCEDURE)
{
if (a->expr->ts.type == BT_CHARACTER && !f->sym->as && where)
gfc_warning (0, "Character length of actual argument shorter "
"than of dummy argument %qs (%lu/%lu) at %L",
f->sym->name, actual_size, formal_size,
&a->expr->where);
{
gfc_warning (0, "Character length of actual argument shorter "
"than of dummy argument %qs (%lu/%lu) at %L",
f->sym->name, actual_size, formal_size,
&a->expr->where);
goto skip_size_check;
}
else if (where)
{
/* Emit a warning for -std=legacy and an error otherwise. */

View file

@ -6125,6 +6125,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
bool add_clobber;
add_clobber = fsym && fsym->attr.intent == INTENT_OUT
&& !fsym->attr.allocatable && !fsym->attr.pointer
&& e->symtree && e->symtree->n.sym
&& !e->symtree->n.sym->attr.dimension
&& !e->symtree->n.sym->attr.pointer
&& !e->symtree->n.sym->attr.allocatable

View file

@ -0,0 +1,12 @@
! { dg-do compile }
! PR fortran/100274 - ICE in gfc_conv_procedure_call, at fortran/trans-expr.c:6131
program p
call s('y') ! { dg-warning "Character length of actual argument" }
contains
subroutine s(x)
character(8), intent(out) :: x
end
end
! { dg-error "in variable definition context" " " { target *-*-* } 5 }