procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fortran: fix passing array component ref to polymorphic procedures

Browse source 
PR fortran/105658

gcc/fortran/ChangeLog:

	* trans-expr.cc (gfc_conv_intrinsic_to_class): When passing an
	array component reference of intrinsic type to a procedure
	with an unlimited polymorphic dummy argument, a temporary
	should be created.

gcc/testsuite/ChangeLog:

	* gfortran.dg/PR105658.f90: New test.

Signed-off-by: Peter Hill <peter.hill@york.ac.uk>
This commit is contained in:
Peter Hill 2024-02-20 20:42:53 +01:00 • committed by Harald Anlauf
parent 81e5f276c5
commit 14ba8d5b87
2 changed files with 58 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gcc/fortran/trans-expr.cc
View file

@ -1019,6 +1019,14 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e,
tmp = gfc_typenode_for_spec (&class_ts);
var = gfc_create_var (tmp, "class");
/* Force a temporary for component or substring references. */
if (unlimited_poly
&& class_ts.u.derived->components->attr.dimension
&& !class_ts.u.derived->components->attr.allocatable
&& !class_ts.u.derived->components->attr.class_pointer
&& is_subref_array (e))
parmse->force_tmp = 1;
/* Set the vptr. */
ctree = gfc_class_vptr_get (var);

50
gcc/testsuite/gfortran.dg/PR105658.f90 Normal file
View file

@ -0,0 +1,50 @@
! { dg-do compile }
! { dg-options "-Warray-temporaries" }
! Test fix for incorrectly passing array component to unlimited polymorphic procedure
module test_PR105658_mod
implicit none
type :: foo
integer :: member1
integer :: member2
end type foo
contains
subroutine print_poly(array)
class(*), dimension(:), intent(in) :: array
select type(array)
type is (integer)
print*, array
type is (character(*))
print *, array
end select
end subroutine print_poly
subroutine do_print(thing)
type(foo), dimension(3), intent(in) :: thing
type(foo), parameter :: y(3) = [foo(1,2),foo(3,4),foo(5,6)]
integer :: i, j, uu(5,6)
call print_poly(thing%member1) ! { dg-warning "array temporary" }
call print_poly(y%member2) ! { dg-warning "array temporary" }
call print_poly(y(1::2)%member2) ! { dg-warning "array temporary" }
! The following array sections work without temporaries
uu = reshape([(((10*i+j),i=1,5),j=1,6)],[5,6])
print *, uu(2,2::2)
call print_poly (uu(2,2::2)) ! no temp needed!
print *, uu(1::2,6)
call print_poly (uu(1::2,6)) ! no temp needed!
end subroutine do_print
subroutine do_print2(thing2)
class(foo), dimension(:), intent(in) :: thing2
call print_poly (thing2% member2) ! { dg-warning "array temporary" }
end subroutine do_print2
subroutine do_print3 ()
character(3) :: c(3) = ["abc","def","ghi"]
call print_poly (c(1::2)) ! no temp needed!
call print_poly (c(1::2)(2:3)) ! { dg-warning "array temporary" }
end subroutine do_print3
end module test_PR105658_mod