[Bug fortran/47455] [4.6 Regression][OOP] internal compiler error: in fold_convert_loc, at fold-const.c:2028

["janus at gcc dot gnu.org" <gcc-bugzilla at gcc dot gnu dot org>]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=47455

janus at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|UNCONFIRMED                 |NEW
   Last reconfirmed|                            |2011.01.31 20:28:40
     Ever Confirmed|0                           |1

--- Comment #6 from janus at gcc dot gnu.org 2011-01-31 20:28:40 UTC ---
(In reply to comment #3)
> RFC patch. Janus, what do you think?

I think I'd prefer the following version:

Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c    (revision 169442)
+++ gcc/fortran/trans-expr.c    (working copy)
@@ -3606,10 +3606,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol *
         x = f()
      where f is pointer valued, we have to dereference the result.  */
   if (!se->want_pointer && !byref
-      && (sym->attr.pointer || sym->attr.allocatable)
-      && !gfc_is_proc_ptr_comp (expr, NULL))
-    se->expr = build_fold_indirect_ref_loc (input_location,
-                    se->expr);
+      && ((!comp && (sym->attr.pointer || sym->attr.allocatable))
+      || (comp && (comp->attr.pointer || comp->attr.allocatable))))
+    se->expr = build_fold_indirect_ref_loc (input_location, se->expr);

   /* f2c calling conventions require a scalar default real function to
      return a double precision result.  Convert this back to default



This fixes all of the following variant of the test case, which was (partially)
miscompiled by both previous patches:


module class_t
  type :: tx
    integer :: i
  end type
  type :: t
    type(tx), pointer :: x
    procedure(find_x), pointer :: ppc
  contains
    procedure :: find_x
  end type
contains
  function find_x(this)
    class(t), intent(in) :: this
    type(tx), pointer :: find_x
    find_x => null()
  end function find_x
end module

program test
  use class_t
  class(t),allocatable :: this
  procedure(find_x), pointer :: pp
  allocate(this)
  pp => find_x
  this%ppc => find_x
  this%x = find_x(this)    ! (1) ordinary function
  this%x = pp(this)        ! (2) procedure pointer
  this%x = this%ppc()      ! (3) PPC
  this%x = this%find_x()   ! (4) TBP
end