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

Fortran: Add view convert to pointer assign when only pointer/alloc attr differs [PR104684]

Browse source 
PR fortran/104684

gcc/fortran/ChangeLog:

	* trans-array.cc (gfc_conv_expr_descriptor): Look at the
	lang-specific akind and do a view convert when only the akind
	attribute differs between pointer and allocatable array.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray/ptr_comp_6.f08: New test.
This commit is contained in:
Andre Vehreschild 2025-03-04 17:06:31 +01:00
parent b3d078220d
commit 705ae582d5
2 changed files with 34 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
gcc/fortran/trans-array.cc
View file

@ -8186,8 +8186,16 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
{
if (se->direct_byref && !se->byref_noassign)
{
struct lang_type *lhs_ls
= TYPE_LANG_SPECIFIC (TREE_TYPE (se->expr)),
*rhs_ls = TYPE_LANG_SPECIFIC (TREE_TYPE (desc));
/* When only the array_kind differs, do a view_convert. */
tmp = lhs_ls && rhs_ls && lhs_ls->rank == rhs_ls->rank
&& lhs_ls->akind != rhs_ls->akind
? build1 (VIEW_CONVERT_EXPR, TREE_TYPE (se->expr), desc)
: desc;
/* Copy the descriptor for pointer assignments. */
gfc_add_modify (&se->pre, se->expr, desc);
gfc_add_modify (&se->pre, se->expr, tmp);
/* Add any offsets from subreferences. */
gfc_get_dataptr_offset (&se->pre, se->expr, desc, NULL_TREE,

25
gcc/testsuite/gfortran.dg/coarray/ptr_comp_6.f08 Normal file
View file

@ -0,0 +1,25 @@
!{ dg-do run }
!
! Contributed by Arseny Solokha <asolokha@gmx.com>
program pr104684
type :: index_map
integer, allocatable :: send_index(:)
end type
type(index_map) :: imap
imap%send_index = [5,4,3]
call sub(imap)
contains
subroutine sub(this)
type(index_map), intent(inout), target :: this
type :: box
integer, pointer :: array(:)
end type
type(box), allocatable :: buffer[:]
allocate(buffer[*])
buffer%array => this%send_index
if (any(buffer%array /= [5,4,3])) stop 1
end subroutine
end program