Patchwork Regression on character function

login
register
mail settings
Submitter Paul Richard Thomas
Date Feb. 6, 2012, 9:06 p.m.
Message ID <CAGkQGiK+5Rk2ay=bqNyByByyh0e1Th-GBwwsvsrqcRxSf8xO5w@mail.gmail.com>
Download mbox | patch
Permalink /patch/139795/
State New
Headers show

Comments

Paul Richard Thomas - Feb. 6, 2012, 9:06 p.m.
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  <pault@gcc.gnu.org>

	* resolve.c (resolve_fl_derived0): Typebound functions support
	assumed character length results.

2012-02-06  Paul Thomas  <pault@gcc.gnu.org>

	* gfortran.dg/assumed_charlen_function_7.f90 : New test.

Patch

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" } }