The follwoing patch has been built and regression
tested on x86_64-*-freebsd. There were no regression.
The patch removes an assert, which allows gfortran
to detect an invalid selector in SELECT TYPE statement.
2015-09-25 Steven G. Kargl <ka...@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 <ka...@gcc.gnu.org>
PR fortran/67525
* gfortran.dg/pr67525.f90: New test.
--
Steve
Index: fortran/parse.c
===================================================================
--- fortran/parse.c (revision 228061)
+++ fortran/parse.c (working copy)
@@ -3113,15 +3113,18 @@ match_deferred_characteristics (gfc_type
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);
}
Index: testsuite/gfortran.dg/pr67525.f90
===================================================================
--- testsuite/gfortran.dg/pr67525.f90 (revision 0)
+++ testsuite/gfortran.dg/pr67525.f90 (working copy)
@@ -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
