[Patch, fortran] PR49630 - [OOP] ICE on obsolescent deferred-length type bound character function

[Paul Richard Thomas <paul.richard.thomas@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 952 bytes --]

I got caught with a wild goose chase with this one. I tried to get it
to work before seeing the standard reference in trans-expr.c. In fact,
it would be impossible to fix because there is no way to resolve
different instances of the abstract interface with different character
lengths.

Bootstrapped and regtested on FC28/x86_64 - OK for trunk.

I do not intend to backport it unless there is any enthusiasm for me to do so.

Regards

Paul

2018-06-19  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/49630
    * resolve.c (resolve_contained_fntype): Change standard ref.
    from F95 to F2003: C418. Correct a spelling error in a comment.
    It is an error for an abstract interface to have an assumed
    character length result.
    * trans-expr.c (gfc_conv_procedure_call): Likewise change the
    standard reference.

2018-06-19  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/49630
    * gfortran.dg/assumed_charlen_function_7.f90: New test.

[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 4775 bytes --]

Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 261126)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_contained_fntype (gfc_symbol *sy
*** 601,609 ****
  	}
      }
  
!   /* Fortran 95 Draft Standard, page 51, Section 5.1.1.5, on the Character
       type, lists the only ways a character length value of * can be used:
!      dummy arguments of procedures, named constants, and function results
       in external functions.  Internal function results and results of module
       procedures are not on this list, ergo, not permitted.  */
  
--- 601,610 ----
  	}
      }
  
!   /* Fortran 2003 Draft Standard, page 535, C418, on type-param-value
       type, lists the only ways a character length value of * can be used:
!      dummy arguments of procedures, named constants, function results and
!      in allocate statements if the allocate_object is an assumed length dummy
       in external functions.  Internal function results and results of module
       procedures are not on this list, ergo, not permitted.  */
  
*************** resolve_function (gfc_expr *expr)
*** 3103,3109 ****
        return false;
      }
  
!   /* If this ia a deferred TBP with an abstract interface (which may
       of course be referenced), expr->value.function.esym will be set.  */
    if (sym && sym->attr.abstract && !expr->value.function.esym)
      {
--- 3104,3110 ----
        return false;
      }
  
!   /* If this is a deferred TBP with an abstract interface (which may
       of course be referenced), expr->value.function.esym will be set.  */
    if (sym && sym->attr.abstract && !expr->value.function.esym)
      {
*************** resolve_function (gfc_expr *expr)
*** 3112,3117 ****
--- 3113,3129 ----
        return false;
      }
  
+   /* If this is a deferred TBP with an abstract interface, its result
+      cannot be an assumed length character (F2003: C418).  */
+   if (sym && sym->attr.abstract && sym->attr.function
+       && sym->result->ts.u.cl->length == NULL)
+     {
+       gfc_error ("ABSTRACT INTERFACE %qs at %L must not have an assumed "
+ 		 "character length result (F2003: C418)", sym->name,
+ 		 &sym->declared_at);
+       return false;
+     }
+ 
    /* Switch off assumed size checking and do this again for certain kinds
       of procedure, once the procedure itself is resolved.  */
    need_full_assumed_size++;
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 261126)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5941,5947 ****
      {
        if (ts.u.cl->length == NULL)
  	{
! 	  /* Assumed character length results are not allowed by 5.1.1.5 of the
  	     standard and are trapped in resolve.c; except in the case of SPREAD
  	     (and other intrinsics?) and dummy functions.  In the case of SPREAD,
  	     we take the character length of the first argument for the result.
--- 5941,5947 ----
      {
        if (ts.u.cl->length == NULL)
  	{
! 	  /* Assumed character length results are not allowed by C418 of the 2003
  	     standard and are trapped in resolve.c; except in the case of SPREAD
  	     (and other intrinsics?) and dummy functions.  In the case of SPREAD,
  	     we take the character length of the first argument for the result.
Index: gcc/testsuite/gfortran.dg/assumed_charlen_function_7.f90
===================================================================
*** gcc/testsuite/gfortran.dg/assumed_charlen_function_7.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/assumed_charlen_function_7.f90	(working copy)
***************
*** 0 ****
--- 1,34 ----
+ ! { dg-do compile }
+ !
+ ! Test the fix for PR49630, comment #11.
+ !
+ ! Contributed by Vittorio Zecca  <zeccav@gmail.com>
+ !
+ module abc
+   implicit none
+   type,abstract::abc_abstract
+   contains
+     procedure(abc_interface),deferred::abc_function
+   end type abc_abstract
+   type,extends(abc_abstract)::abc_type
+   contains
+     procedure::abc_function
+   end type abc_type
+   abstract interface
+     function abc_interface(this) ! { dg-error "assumed character length result" }
+       import abc_abstract
+       class(abc_abstract),intent(in)::this
+       character(len=*)::abc_interface
+     end function abc_interface
+   end interface
+ contains
+   function abc_function(this)
+     class(abc_type),intent(in)::this
+     character(len=5)::abc_function
+     abc_function="hello"
+   end function abc_function
+   subroutine do_something(this)
+     class(abc_abstract),intent(in)::this
+     print *,this%abc_function()
+   end subroutine do_something
+ end module abc