[PATCH] PR fortran/100551 - [11/12 Regression] Passing return value to class(*) dummy argument

[PATCH] PR fortran/100551 - [11/12 Regression] Passing return value to class(*) dummy argument

[Harald Anlauf]

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

The fix for PR93924/5 has caused a regression for code such as given
in the present PR.  This can be remedied by adjusting the check when
to invoke the implicit conversion of actual argument to an unlimited
polymorphic procedure argument.

Regtested on x86_64-pc-linux-gnu.

OK for mainline and backport to 11-branch?

Thanks,
Harald


Fortran: fix passing return value to class(*) dummy argument

gcc/fortran/ChangeLog:

	PR fortran/100551
	* trans-expr.c (gfc_conv_procedure_call): Adjust check for
	implicit conversion of actual argument to an unlimited polymorphic
	procedure argument.

gcc/testsuite/ChangeLog:

	PR fortran/100551
	* gfortran.dg/pr100551.f90: New test.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr100551.patch --]
[-- Type: text/x-patch, Size: 1588 bytes --]

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index cce18d094a6..3432cd4fdfd 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5826,7 +5826,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 				     &derived_array);
 	}
       else if (UNLIMITED_POLY (fsym) && e->ts.type != BT_CLASS
-	       && gfc_expr_attr (e).flavor != FL_PROCEDURE)
+	       && e->ts.type != BT_PROCEDURE
+	       && (gfc_expr_attr (e).flavor != FL_PROCEDURE
+		   || gfc_expr_attr (e).proc != PROC_UNKNOWN))
 	{
 	  /* The intrinsic type needs to be converted to a temporary
 	     CLASS object for the unlimited polymorphic formal.  */
diff --git a/gcc/testsuite/gfortran.dg/pr100551.f90 b/gcc/testsuite/gfortran.dg/pr100551.f90
new file mode 100644
index 00000000000..f82f505e734
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr100551.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! PR fortran/100551 - Passing return value to class(*) dummy argument
+
+program p
+  implicit none
+  integer :: result
+  result = 1
+  result = test (    (result)) ! works
+  if (result /= 1) stop 1
+  result = test (int (result)) ! issue 1
+! write(*,*) result
+  if (result /= 1) stop 2
+  result = test (f   (result)) ! issue 2
+! write(*,*) result
+  if (result /= 2) stop 3
+contains
+  integer function test(x)
+    class(*), intent(in) :: x
+    select type (x)
+    type is (integer)
+       test = x
+    class default
+       test = -1
+    end select
+  end function test
+  integer function f(x)
+    integer, intent(in) :: x
+    f = 2*x
+  end function f
+end program

Re: [PATCH] PR fortran/100551 - [11/12 Regression] Passing return value to class(*) dummy argument

[Paul Richard Thomas]

Hi Harald,

I meant to deal with this myself since I am the guilty party. However, the
last two weeks have been taken up by a house move and so gfortran has been
on the backburner.

The patch looks good and seems to do the job - OK for master and 11-branch.

Thanks a million for dealing with it!

Paul

PS If I walk 200m I can now see the "dreaming spires" of Oxford! Better
still, there are no fewer than three very good pub/restaurants within
walking distance :-)


On Thu, 20 May 2021 at 23:22, Harald Anlauf via Fortran <fortran@gcc.gnu.org>
wrote:

> The fix for PR93924/5 has caused a regression for code such as given
> in the present PR.  This can be remedied by adjusting the check when
> to invoke the implicit conversion of actual argument to an unlimited
> polymorphic procedure argument.
>
> Regtested on x86_64-pc-linux-gnu.
>
> OK for mainline and backport to 11-branch?
>
> Thanks,
> Harald
>
>
> Fortran: fix passing return value to class(*) dummy argument
>
> gcc/fortran/ChangeLog:
>
>         PR fortran/100551
>         * trans-expr.c (gfc_conv_procedure_call): Adjust check for
>         implicit conversion of actual argument to an unlimited polymorphic
>         procedure argument.
>
> gcc/testsuite/ChangeLog:
>
>         PR fortran/100551
>         * gfortran.dg/pr100551.f90: New test.
>
>

-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein