public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* [Patch, fortran] PR93924/5 - [OOP] ICE with procedure pointer
@ 2021-01-27 11:52 Paul Richard Thomas
  2021-01-29 11:05 ` Tobias Burnus
  0 siblings, 1 reply; 2+ messages in thread
From: Paul Richard Thomas @ 2021-01-27 11:52 UTC (permalink / raw)
  To: fortran, gcc-patches

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

This patch fixes PRs 93924/5. It is another 'obvious' patch, whose
consequences are very limited.

I am trying to slip in as many small ready-to-go patches as I can before we
go too far into stage 4. It would be nice to have the patch for PR98573
(posted 23rd Jan) OK'd before the end of the week.

Cheers

Paul

Fortran: Fix ICE due to elemental procedure pointers [PR93924/5].

2021-01-27  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
PR fortran/93924
PR fortran/93925
* trans-expr.c (gfc_conv_procedure_call): Suppress the call to
gfc_conv_intrinsic_to_class for unlimited polymorphic procedure
pointers.
(gfc_trans_assignment_1): Similarly suppress class assignment
for class valued procedure pointers.

gcc/testsuite/
PR fortran/93924
PR fortran/93925
* gfortran.dg/proc_ptr_52.f90 : New test.

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

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 7150e48bc93..b0c8d577ca5 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5772,7 +5772,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 				     CLASS_DATA (fsym)->attr.class_pointer
 				     || CLASS_DATA (fsym)->attr.allocatable);
 	}
-      else if (UNLIMITED_POLY (fsym) && e->ts.type != BT_CLASS)
+      else if (UNLIMITED_POLY (fsym) && e->ts.type != BT_CLASS
+	       && gfc_expr_attr (e).flavor != FL_PROCEDURE)
 	{
 	  /* The intrinsic type needs to be converted to a temporary
 	     CLASS object for the unlimited polymorphic formal.  */
@@ -11068,7 +11069,8 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
 		       || gfc_is_class_array_ref (expr1, NULL)
 		       || gfc_is_class_scalar_expr (expr1)
 		       || gfc_is_class_array_ref (expr2, NULL)
-		       || gfc_is_class_scalar_expr (expr2));
+		       || gfc_is_class_scalar_expr (expr2))
+		   && lhs_attr.flavor != FL_PROCEDURE;

   realloc_flag = flag_realloc_lhs
 		 && gfc_is_reallocatable_lhs (expr1)

[-- Attachment #3: proc_ptr_52.f90 --]
[-- Type: text/x-fortran, Size: 1556 bytes --]

! { dg-do run }
!
! Test the fix for PRs93924 & 93925.
!
! Contributed by Martin Stein  <mscfd@gmx.net>
!
module cs

implicit none

integer, target :: integer_target

abstract interface
   function classStar_map_ifc(x) result(y)
      class(*), pointer            :: y
      class(*), target, intent(in) :: x
   end function classStar_map_ifc
end interface

contains

   function fun(x) result(y)
      class(*), pointer            :: y
      class(*), target, intent(in) :: x
      select type (x)
      type is (integer)
         integer_target = x        ! Deals with dangling target.
         y => integer_target
      class default
         y => null()
      end select
   end function fun

   function apply(f, x) result(y)
      procedure(classStar_map_ifc) :: f
      integer, intent(in) :: x
      integer :: y
      class(*), pointer :: p
      y = 0                        ! Get rid of 'y' undefined warning
      p => f (x)
      select type (p)
      type is (integer)
         y = p
      end select
   end function apply

   function selector() result(f)
      procedure(classStar_map_ifc), pointer :: f
      f => fun
   end function selector

end module cs


program classStar_map

use cs
implicit none

integer :: x, y
procedure(classStar_map_ifc), pointer :: f

x = 123654
f => selector ()               ! Fixed by second chunk in patch
y = apply (f, x)               ! Fixed by first chunk in patch
if (x .ne. y) stop 1

x = 2 * x
y = apply (fun, x)             ! PR93925; fixed as above
if (x .ne. y) stop 2

end program classStar_map

^ permalink raw reply	[flat|nested] 2+ messages in thread

* Re: [Patch, fortran] PR93924/5 - [OOP] ICE with procedure pointer
  2021-01-27 11:52 [Patch, fortran] PR93924/5 - [OOP] ICE with procedure pointer Paul Richard Thomas
@ 2021-01-29 11:05 ` Tobias Burnus
  0 siblings, 0 replies; 2+ messages in thread
From: Tobias Burnus @ 2021-01-29 11:05 UTC (permalink / raw)
  To: Paul Richard Thomas, fortran, gcc-patches

On 27.01.21 12:52, Paul Richard Thomas via Fortran wrote:
> It would be nice to have the patch for PR98573 (posted 23rd Jan)
> OK'd before the end of the week.
I've just sent some comments (albeit: Thomas has okayed it).
> This patch fixes PRs 93924/5. It is another 'obvious' patch, whose
> consequences are very limited.

LGTM – thanks for the patch,

Tobias

>
> Fortran: Fix ICE due to elemental procedure pointers [PR93924/5].
>
> 2021-01-27  Paul Thomas  <pault@gcc.gnu.org>
>
> gcc/fortran
> PR fortran/93924
> PR fortran/93925
> * trans-expr.c (gfc_conv_procedure_call): Suppress the call to
> gfc_conv_intrinsic_to_class for unlimited polymorphic procedure
> pointers.
> (gfc_trans_assignment_1): Similarly suppress class assignment
> for class valued procedure pointers.
>
> gcc/testsuite/
> PR fortran/93924
> PR fortran/93925
> * gfortran.dg/proc_ptr_52.f90 : New test.
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter

^ permalink raw reply	[flat|nested] 2+ messages in thread

end of thread, other threads:[~2021-01-29 11:05 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-01-27 11:52 [Patch, fortran] PR93924/5 - [OOP] ICE with procedure pointer Paul Richard Thomas
2021-01-29 11:05 ` Tobias Burnus

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).