First, I'd be glad if someone could review my patch at
http://gcc.gnu.org/ml/fortran/2011-04/msg00271.html
* * *
Secondly, the attached patch fixes a segfault after printing an error
about the invalid function-return type. It has been committed as Rev.
173048. As it is a 4.6/4.7 regression, I will backport it to 4.6 in the
next days.
Tobias
Index: gcc/testsuite/gfortran.dg/whole_file_34.f90
===================================================================
--- gcc/testsuite/gfortran.dg/whole_file_34.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/whole_file_34.f90 (Revision 0)
@@ -0,0 +1,12 @@
+! { dg-do compile }
+!
+! PR fortran/48788
+!
+! Contributed by Zdenek Sojka
+!
+function foo ()
+end function foo
+ character(4), external :: foo ! { dg-error "Return type mismatch of function" }
+ character(4) :: x
+ x = foo ()
+END
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 173047)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,8 @@
+2011-04-27 Tobias Burnus <bur...@net-b.de>
+
+ PR fortran/48788
+ * gfortran.dg/whole_file_34.f90: New.
+
2011-04-27 Jan Hubicka <j...@suse.cz>
* gcc.dg/tree-ssa/inline-9.c: New testcase.
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 173047)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,9 @@
+2011-04-27 Tobias Burnus <bur...@net-b.de>
+
+ PR fortran/48788
+ * resolve.c (resolve_global_procedure): Error recovery -
+ avoid segfault for (non)character-returning functions.
+
2011-04-26 Thomas Koenig <tkoe...@gcc.gnu.org>
* decl.c (gfc_match_end): Check that the block name starts
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (Revision 173047)
+++ gcc/fortran/resolve.c (Arbeitskopie)
@@ -2187,7 +2187,7 @@
/* F2003, 12.3.1.1 (3c); F2008, 12.4.2.2 (3c) */
if (sym->ts.type == BT_CHARACTER && sym->attr.if_source != IFSRC_IFBODY
- && def_sym->ts.u.cl->length != NULL)
+ && def_sym->ts.type == BT_CHARACTER && def_sym->ts.u.cl->length != NULL)
{
gfc_charlen *cl = sym->ts.u.cl;
