Dear All,
The attached is obvious fix to this regression and I will commit
tomorrow evening if there is no objection.
Cheers
Paul
2012-02-06 Paul Thomas <pa...@gcc.gnu.org>
* resolve.c (resolve_fl_derived0): Typebound functions support
assumed character length results.
2012-02-06 Paul Thomas <pa...@gcc.gnu.org>
* gfortran.dg/assumed_charlen_function_7.f90 : New test.
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 183914)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_fl_derived0 (gfc_symbol *sym)
*** 11601,11607 ****
for ( ; c != NULL; c = c->next)
{
/* See PRs 51550, 47545, 48654, 49050, 51075 - and 45170. */
! if (c->ts.type == BT_CHARACTER && c->ts.deferred)
{
gfc_error ("Deferred-length character component '%s' at %L is not "
"yet supported", c->name, &c->loc);
--- 11601,11607 ----
for ( ; c != NULL; c = c->next)
{
/* See PRs 51550, 47545, 48654, 49050, 51075 - and 45170. */
! if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function)
{
gfc_error ("Deferred-length character component '%s' at %L is not "
"yet supported", c->name, &c->loc);
Index: gcc/testsuite/gfortran.dg/assumed_charlen_function_7.f90
===================================================================
*** gcc/testsuite/gfortran.dg/assumed_charlen_function_7.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/assumed_charlen_function_7.f90 (revision 0)
***************
*** 0 ****
--- 1,27 ----
+ ! { dg-do run }
+ !
+ ! Tests fix of regression reported by Damian Rouson
+ ! http://gcc.gnu.org/ml/fortran/2012-02/msg00030.html
+ !
+ module foo_class
+ implicit none
+ type foo
+ character(16) :: chr
+ contains
+ procedure :: bar
+ end type
+ contains
+ function bar(this)
+ class(foo) :: this
+ character(:), allocatable :: bar
+ bar = trim (this%chr) // trim(this%chr)
+ end function
+ end module
+
+ use foo_class
+ type(foo) :: x
+ x = foo("bar calling")
+ if (len (x%bar()) .ne. 22) call abort
+ if (x%bar() .ne. "bar callingbar calling") call abort
+ end
+ ! { dg-final { cleanup-modules "foo_class" } }
