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

Fortran: fix NULL without MOLD argument to scalar DT pointer dummy [PR118179]

Browse source 
Commit r15-6408 overlooked the case of passing NULL without MOLD argument
to a derived type pointer dummy argument without specified intent.  Since
it is prohibited to modify the dummy argument, we treat it as if intent(in)
were specified and suppress copying back of the pointer address.

	PR fortran/118179

gcc/fortran/ChangeLog:

	* trans-expr.cc (conv_null_actual): Suppress copying back of
	pointer address for unspecified intent.

gcc/testsuite/ChangeLog:

	* gfortran.dg/null_actual_7.f90: Extend testcase to also cover
	scalar variants with pointer or allocatable dummy with or without
	specified intent.
This commit is contained in:
Harald Anlauf 2024-12-23 17:56:46 +01:00
parent dae506f73b
commit f25250e0d5
2 changed files with 79 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -6488,7 +6488,8 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym)
int dummy_rank;
tree tmp = parmse->expr;
if (fsym->attr.allocatable && fsym->attr.intent == INTENT_UNKNOWN)
if ((fsym->attr.allocatable || fsym->attr.pointer)
&& fsym->attr.intent == INTENT_UNKNOWN)
fsym->attr.intent = INTENT_IN;
tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, fsym->attr);
dummy_rank = fsym->as ? fsym->as->rank : 0;

77
gcc/testsuite/gfortran.dg/null_actual_7.f90
View file

@ -10,6 +10,8 @@ program null_actual
end type t
type(t), pointer :: p2(:,:) => NULL()
type(t), allocatable :: a2(:,:)
type(t), pointer :: p0 => NULL ()
type(t), allocatable :: a0
! Basic tests passing unallocated allocatable / disassociated pointer
stop_base = 0
@ -27,6 +29,16 @@ program null_actual
call chk2_t_p (p2)
call opt2_t_a (a2)
call opt2_t_p (p2)
! ... to rank-0 dummy:
stop_base = 60
call chk0_t_a (a0)
call chk0_t_p (p0)
call opt0_t_a (a0)
call opt0_t_p (p0)
call chk0_t_a_i (a0)
call chk0_t_p_i (p0)
call opt0_t_a_i (a0)
call opt0_t_p_i (p0)
! Test NULL with MOLD argument
stop_base = 20
@ -43,6 +55,16 @@ program null_actual
call opt2_t_a (null(a2))
call opt2_t_p (null(p2))
stop_base = 80
call chk0_t_a (null(a0))
call chk0_t_p (null(p0))
call opt0_t_a (null(a0))
call opt0_t_p (null(p0))
call chk0_t_a_i (null(a0))
call chk0_t_p_i (null(p0))
call opt0_t_a_i (null(a0))
call opt0_t_p_i (null(p0))
! Test NULL without MOLD argument
stop_base = 40
call chk2_t_a (null())
@ -50,6 +72,16 @@ program null_actual
call opt2_t_a (null())
call opt2_t_p (null())
stop_base = 100
call chk0_t_a (null())
call chk0_t_p (null())
call opt0_t_a (null())
call opt0_t_p (null())
call chk0_t_a_i (null())
call chk0_t_p_i (null())
call opt0_t_a_i (null())
call opt0_t_p_i (null())
contains
! Check assumed-rank dummy:
subroutine chk_t_a (x)
@ -120,4 +152,49 @@ contains
if (.not. present (x)) stop stop_base + 19
if (associated (x)) stop stop_base + 20
end subroutine opt2_t_p
! Checks for rank-0 dummy:
subroutine chk0_t_p (x)
type(t), pointer :: x
if (associated (x)) stop stop_base + 1
end subroutine chk0_t_p
subroutine chk0_t_p_i (x)
type(t), pointer, intent(in) :: x
if (associated (x)) stop stop_base + 2
end subroutine chk0_t_p_i
subroutine opt0_t_p (x)
type(t), pointer, optional :: x
if (.not. present (x)) stop stop_base + 3
if (associated (x)) stop stop_base + 4
end subroutine opt0_t_p
subroutine opt0_t_p_i (x)
type(t), pointer, optional, intent(in) :: x
if (.not. present (x)) stop stop_base + 5
if (associated (x)) stop stop_base + 6
end subroutine opt0_t_p_i
subroutine chk0_t_a (x)
type(t), allocatable :: x
if (allocated (x)) stop stop_base + 7
end subroutine chk0_t_a
subroutine chk0_t_a_i (x)
type(t), allocatable, intent(in) :: x
if (allocated (x)) stop stop_base + 8
end subroutine chk0_t_a_i
subroutine opt0_t_a (x)
type(t), allocatable, optional :: x
if (.not. present (x)) stop stop_base + 9
if (allocated (x)) stop stop_base + 10
end subroutine opt0_t_a
subroutine opt0_t_a_i (x)
type(t), allocatable, optional, intent(in) :: x
if (.not. present (x)) stop stop_base + 11
if (allocated (x)) stop stop_base + 12
end subroutine opt0_t_a_i
end