re PR fortran/67525 (ICE on select type with improper selector)

2015-09-25  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/67525
	* parse.c (match_deferred_characteristics): Remove an assert, which
	allows an invalid SELECT TYPE selector to be detected.

 
2015-09-25  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/67525
	* gfortran.dg/pr67525.f90: New test.

From-SVN: r228155
This commit is contained in:
Steven G. Kargl 2015-09-25 22:28:04 +00:00
parent f7697f9cd2
commit b15e7bddd6
4 changed files with 36 additions and 4 deletions

View File

@ -1,3 +1,9 @@
2015-09-25 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/67525
* parse.c (match_deferred_characteristics): Remove an assert, which
allows an invalid SELECT TYPE selector to be detected.
2015-09-25 Manuel López-Ibáñez <manu@gcc.gnu.org>
PR pretty-print/67567

View File

@ -3113,15 +3113,18 @@ match_deferred_characteristics (gfc_typespec * ts)
static void
check_function_result_typed (void)
{
gfc_typespec* ts = &gfc_current_ns->proc_name->result->ts;
gfc_typespec ts;
gcc_assert (gfc_current_state () == COMP_FUNCTION);
gcc_assert (ts->type != BT_UNKNOWN);
if (!gfc_current_ns->proc_name->result) return;
ts = gfc_current_ns->proc_name->result->ts;
/* Check type-parameters, at the moment only CHARACTER lengths possible. */
/* TODO: Extend when KIND type parameters are implemented. */
if (ts->type == BT_CHARACTER && ts->u.cl && ts->u.cl->length)
gfc_expr_check_typed (ts->u.cl->length, gfc_current_ns, true);
if (ts.type == BT_CHARACTER && ts.u.cl && ts.u.cl->length)
gfc_expr_check_typed (ts.u.cl->length, gfc_current_ns, true);
}

View File

@ -1,3 +1,8 @@
2015-09-25 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/67525
* gfortran.dg/pr67525.f90: New test.
2015-09-25 Mikael Morin <mikael@gcc.gnu.org>
PR fortran/55603

View File

@ -0,0 +1,18 @@
! { dg-do compile }
! PR fortran/67525
! Code contributed by Gerhard Steinmetz
!
real function f(x)
select type (x) ! { dg-error "shall be polymorphic" }
end select
end function f
real function g(x)
select type (x=>null()) ! { dg-error "shall be polymorphic" }
end select
end function g
subroutine a(x)
select type (x) ! { dg-error "shall be polymorphic" }
end select
end subroutine a