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

Fortran: fix passing of optional dummy as actual to optional argument [PR55978]

Browse source 
gcc/fortran/ChangeLog:

	PR fortran/55978
	* trans-array.cc (gfc_conv_array_parameter): Do not dereference
	data component of a missing allocatable dummy array argument for
	passing as actual to optional dummy.  Harden logic of presence
	check for optional pointer dummy by using TRUTH_ANDIF_EXPR instead
	of TRUTH_AND_EXPR.

gcc/testsuite/ChangeLog:

	PR fortran/55978
	* gfortran.dg/optional_absent_12.f90: New test.

(cherry picked from commit f02c70dafd384f0c44d7a0920f4a75a30e267045)
This commit is contained in:
Harald Anlauf 2024-06-23 22:36:43 +02:00
parent b31e1900fa
commit 9f147487de
2 changed files with 46 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -8673,6 +8673,10 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
&& (sym->backend_decl != parent))
this_array_result = false;
/* Passing an optional dummy argument as actual to an optional dummy? */
bool pass_optional;
pass_optional = fsym && fsym->attr.optional && sym && sym->attr.optional;
/* Passing address of the array if it is not pointer or assumed-shape. */
if (full_array_var && g77 && !this_array_result
&& sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS)
@ -8710,6 +8714,14 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
if (size)
array_parameter_size (&se->pre, tmp, expr, size);
se->expr = gfc_conv_array_data (tmp);
if (pass_optional)
{
tree cond = gfc_conv_expr_present (sym);
se->expr = build3_loc (input_location, COND_EXPR,
TREE_TYPE (se->expr), cond, se->expr,
fold_convert (TREE_TYPE (se->expr),
null_pointer_node));
}
return;
}
}
@ -8959,8 +8971,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
fold_convert (TREE_TYPE (tmp), ptr), tmp);
if (fsym && fsym->attr.optional && sym && sym->attr.optional)
tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
if (pass_optional)
tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
logical_type_node,
gfc_conv_expr_present (sym), tmp);
@ -8994,8 +9006,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
fold_convert (TREE_TYPE (tmp), ptr), tmp);
if (fsym && fsym->attr.optional && sym && sym->attr.optional)
tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
if (pass_optional)
tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
logical_type_node,
gfc_conv_expr_present (sym), tmp);

30
gcc/testsuite/gfortran.dg/optional_absent_12.f90 Normal file
View file

@ -0,0 +1,30 @@
! { dg-do run }
! { dg-additional-options "-fcheck=array-temps" }
!
! PR fortran/55978 - comment#19
!
! Test passing of (missing) optional dummy to optional array argument
program test
implicit none
integer, pointer :: p(:) => null()
call one (p)
call one (null())
call one ()
call three ()
contains
subroutine one (y)
integer, pointer, optional, intent(in) :: y(:)
call two (y)
end subroutine one
subroutine three (z)
integer, allocatable, optional, intent(in) :: z(:)
call two (z)
end subroutine three
subroutine two (x)
integer, optional, intent(in) :: x(*)
if (present (x)) stop 1
end subroutine two
end