OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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.
This commit is contained in:
Harald Anlauf 2021-05-23 20:51:14 +02:00
parent a4dbd5cffa
commit fe03f4fc95
2 changed files with 33 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
gcc/fortran/trans-expr.c
View File

@ -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. */

30
gcc/testsuite/gfortran.dg/pr100551.f90 Normal file
View File

@ -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