public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r11-8469] Fortran: fix passing return value to class(*) dummy argument
@ 2021-05-25 20:13 Harald Anlauf
0 siblings, 0 replies; only message in thread
From: Harald Anlauf @ 2021-05-25 20:13 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:de55a48960d2f08266cba1222e233507015dd620
commit r11-8469-gde55a48960d2f08266cba1222e233507015dd620
Author: Harald Anlauf <anlauf@gmx.de>
Date: Sun May 23 20:51:14 2021 +0200
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.
(cherry picked from commit fe03f4fc9548b3fdbff3c8284a994feaa7d6307d)
Diff:
---
gcc/fortran/trans-expr.c | 4 +++-
gcc/testsuite/gfortran.dg/pr100551.f90 | 30 ++++++++++++++++++++++++++++++
2 files changed, 33 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index a10170c7dff..9a396f539bc 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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-05-25 20:13 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-05-25 20:13 [gcc r11-8469] Fortran: fix passing return value to class(*) dummy argument Harald Anlauf
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).