[Patch, fortran] PR68196 [4.9/5/6 Regression] ICE on function result with procedure pointer component

[Patch, fortran] PR68196 [4.9/5/6 Regression] ICE on function result with procedure pointer component

[Paul Richard Thomas]

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

Dear All,

The patch for these PRs is fully explained by the the comments and/or
changelogs. PR66465 has no connection with PR68196, other than Damian
asking if it is connected!

Bootstrapped and regtested on x86_64/FC21 - OK for trunk and a few
weeks later 4.9 and 5 branches?

Cheers

Paul

2015-11-04  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/68196
    * class.c (has_finalizer_component): Prevent infinite recursion
    through this function if the derived type and that of its
    component are the same.
    * trans-types.c (gfc_get_derived_type): Do the same for proc
    pointers by ignoring the explicit interface for the component.

    PR fortran/66465
    * check.c (same_type_check): If either of the expressions is
    BT_PROCEDURE, use the typespec from the symbol, rather than the
    expression.

2015-11-04  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/68196
    * gfortran.dg/proc_ptr_47.f90: New test.

    PR fortran/66465
    * gfortran.dg/pr66465.f90: New test.

[-- Attachment #2: commit.diff --]
[-- Type: text/plain, Size: 5391 bytes --]

Index: gcc/fortran/check.c
===================================================================
*** gcc/fortran/check.c	(revision 229571)
--- gcc/fortran/check.c	(working copy)
*************** less_than_bitsize2 (const char *arg1, gf
*** 399,405 ****
  static bool
  same_type_check (gfc_expr *e, int n, gfc_expr *f, int m)
  {
!   if (gfc_compare_types (&e->ts, &f->ts))
      return true;
  
    gfc_error ("%qs argument of %qs intrinsic at %L must be the same type "
--- 399,413 ----
  static bool
  same_type_check (gfc_expr *e, int n, gfc_expr *f, int m)
  {
!   gfc_typespec *ets = &e->ts;
!   gfc_typespec *fts = &f->ts;
! 
!   if (e->ts.type == BT_PROCEDURE && e->symtree->n.sym)
!     ets = &e->symtree->n.sym->ts;
!   if (f->ts.type == BT_PROCEDURE && f->symtree->n.sym)
!     fts = &f->symtree->n.sym->ts;
! 
!   if (gfc_compare_types (ets, fts))
      return true;
  
    gfc_error ("%qs argument of %qs intrinsic at %L must be the same type "
Index: gcc/fortran/class.c
===================================================================
*** gcc/fortran/class.c	(revision 229571)
--- gcc/fortran/class.c	(working copy)
*************** has_finalizer_component (gfc_symbol *der
*** 843,849 ****
--- 843,853 ----
  	  && c->ts.u.derived->f2k_derived->finalizers)
  	return true;
  
+       /* Stop infinite recursion through this function by inhibiting
+ 	 calls when the derived type and that of the component are
+ 	 the same.  */
        if (c->ts.type == BT_DERIVED
+ 	  && !gfc_compare_derived_types (derived, c->ts.u.derived)
  	  && !c->attr.pointer && !c->attr.allocatable
  	  && has_finalizer_component (c->ts.u.derived))
  	return true;
Index: gcc/fortran/trans-types.c
===================================================================
*** gcc/fortran/trans-types.c	(revision 229571)
--- gcc/fortran/trans-types.c	(working copy)
*************** gfc_get_derived_type (gfc_symbol * deriv
*** 2366,2371 ****
--- 2366,2372 ----
    gfc_component *c;
    gfc_dt_list *dt;
    gfc_namespace *ns;
+   tree tmp;
  
    if (derived->attr.unlimited_polymorphic
        || (flag_coarray == GFC_FCOARRAY_LIB
*************** gfc_get_derived_type (gfc_symbol * deriv
*** 2517,2524 ****
       node as DECL_CONTEXT of each FIELD_DECL.  */
    for (c = derived->components; c; c = c->next)
      {
!       if (c->attr.proc_pointer)
  	field_type = gfc_get_ppc_type (c);
        else if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
          field_type = c->ts.u.derived->backend_decl;
        else
--- 2518,2536 ----
       node as DECL_CONTEXT of each FIELD_DECL.  */
    for (c = derived->components; c; c = c->next)
      {
!       /* Prevent infinite recursion, when the procedure pointer type is
! 	 the same as derived, by forcing the procedure pointer component to
! 	 be built as if the explicit interface does not exist.  */
!       if (c->attr.proc_pointer
! 	  && ((c->ts.type != BT_DERIVED && c->ts.type != BT_CLASS)
! 	       || (c->ts.u.derived
! 		   && !gfc_compare_derived_types (derived, c->ts.u.derived))))
  	field_type = gfc_get_ppc_type (c);
+       else if (c->attr.proc_pointer && derived->backend_decl)
+ 	{
+ 	  tmp = build_function_type_list (derived->backend_decl, NULL_TREE);
+ 	  field_type = build_pointer_type (tmp);
+ 	}
        else if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
          field_type = c->ts.u.derived->backend_decl;
        else
Index: gcc/testsuite/gfortran.dg/pr66465.f90
===================================================================
*** gcc/testsuite/gfortran.dg/pr66465.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/pr66465.f90	(working copy)
***************
*** 0 ****
--- 1,23 ----
+ ! { dg-do compile }
+ !
+ ! Tests the fix for PR66465, in which the arguments of the call to
+ ! ASSOCIATED were falsly detected to have different type/kind.
+ !
+ ! Contributed by Damian Rouson  <damian@sourceryinstitute.org>
+ !
+   interface
+      real function HandlerInterface (arg)
+        real :: arg
+      end
+   end interface
+ 
+   type TextHandlerTestCase
+      procedure (HandlerInterface), nopass, pointer :: handlerOut=>null()
+   end type
+ 
+   type(TextHandlerTestCase) this
+ 
+   procedure (HandlerInterface), pointer :: procPtr=>null()
+ 
+   print*, associated(procPtr, this%handlerOut)
+ end
Index: gcc/testsuite/gfortran.dg/proc_ptr_47.f90
===================================================================
*** gcc/testsuite/gfortran.dg/proc_ptr_47.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/proc_ptr_47.f90	(working copy)
***************
*** 0 ****
--- 1,37 ----
+ ! { dg-do run }
+ ! Tests the fix for PR68196
+ !
+ ! Contributed by Damian Rouson  <damian@sourceryinstitute.org>
+ !
+   type AA
+     integer :: i
+     procedure(foo), pointer :: funct
+   end type
+   class(AA), allocatable :: my_AA
+   type(AA) :: res
+ 
+   allocate (my_AA, source = AA (1, foo))
+ 
+   res = my_AA%funct ()
+ 
+   if (res%i .ne. 3) call abort
+   if (.not.associated (res%funct)) call abort
+   if (my_AA%i .ne. 4) call abort
+   if (associated (my_AA%funct)) call abort
+ 
+ contains
+   function foo(A)
+     class(AA), allocatable :: A
+     type(AA) foo
+ 
+     if (.not.allocated (A)) then
+       allocate (A, source = AA (2, foo))
+     endif
+ 
+     select type (A)
+       type is (AA)
+         foo = AA (3, foo)
+         A = AA (4, NULL ())
+     end select
+   end function
+ end

Re: [Patch, fortran] PR68196 [4.9/5/6 Regression] ICE on function result with procedure pointer component

[Steve Kargl]

On Wed, Nov 04, 2015 at 04:03:10PM +0100, Paul Richard Thomas wrote:
> 
> 2015-11-04  Paul Thomas  <pault@gcc.gnu.org>
> 
>     PR fortran/68196
>     * class.c (has_finalizer_component): Prevent infinite recursion
>     through this function if the derived type and that of its
>     component are the same.
>     * trans-types.c (gfc_get_derived_type): Do the same for proc
>     pointers by ignoring the explicit interface for the component.
> 
>     PR fortran/66465
>     * check.c (same_type_check): If either of the expressions is
>     BT_PROCEDURE, use the typespec from the symbol, rather than the
>     expression.
> 
> 2015-11-04  Paul Thomas  <pault@gcc.gnu.org>
> 
>     PR fortran/68196
>     * gfortran.dg/proc_ptr_47.f90: New test.
> 
>     PR fortran/66465
>     * gfortran.dg/pr66465.f90: New test.

OK.  Thanks for the patch.

-- 
steve

Re: [Patch, fortran] PR68196 [4.9/5/6 Regression] ICE on function result with procedure pointer component

[Paul Richard Thomas]

Committed as revision 229954.

Thanks for checking it out.

Paul

On 7 November 2015 at 16:57, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
> On Wed, Nov 04, 2015 at 04:03:10PM +0100, Paul Richard Thomas wrote:
>>
>> 2015-11-04  Paul Thomas  <pault@gcc.gnu.org>
>>
>>     PR fortran/68196
>>     * class.c (has_finalizer_component): Prevent infinite recursion
>>     through this function if the derived type and that of its
>>     component are the same.
>>     * trans-types.c (gfc_get_derived_type): Do the same for proc
>>     pointers by ignoring the explicit interface for the component.
>>
>>     PR fortran/66465
>>     * check.c (same_type_check): If either of the expressions is
>>     BT_PROCEDURE, use the typespec from the symbol, rather than the
>>     expression.
>>
>> 2015-11-04  Paul Thomas  <pault@gcc.gnu.org>
>>
>>     PR fortran/68196
>>     * gfortran.dg/proc_ptr_47.f90: New test.
>>
>>     PR fortran/66465
>>     * gfortran.dg/pr66465.f90: New test.
>
> OK.  Thanks for the patch.
>
> --
> steve



-- 
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.

Groucho Marx

Re: [Patch, fortran] PR68196 [4.9/5/6 Regression] ICE on function result with procedure pointer component

[Paul Richard Thomas]

Committed to 5 branch as R230839.

Will deal with 4.9 branch next.

Paul

On 7 November 2015 at 16:57, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
> On Wed, Nov 04, 2015 at 04:03:10PM +0100, Paul Richard Thomas wrote:
>>
>> 2015-11-04  Paul Thomas  <pault@gcc.gnu.org>
>>
>>     PR fortran/68196
>>     * class.c (has_finalizer_component): Prevent infinite recursion
>>     through this function if the derived type and that of its
>>     component are the same.
>>     * trans-types.c (gfc_get_derived_type): Do the same for proc
>>     pointers by ignoring the explicit interface for the component.
>>
>>     PR fortran/66465
>>     * check.c (same_type_check): If either of the expressions is
>>     BT_PROCEDURE, use the typespec from the symbol, rather than the
>>     expression.
>>
>> 2015-11-04  Paul Thomas  <pault@gcc.gnu.org>
>>
>>     PR fortran/68196
>>     * gfortran.dg/proc_ptr_47.f90: New test.
>>
>>     PR fortran/66465
>>     * gfortran.dg/pr66465.f90: New test.
>
> OK.  Thanks for the patch.
>
> --
> steve



-- 
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.

Groucho Marx