https://gcc.gnu.org/g:f02c70dafd384f0c44d7a0920f4a75a30e267045
commit r15-1585-gf02c70dafd384f0c44d7a0920f4a75a30e267045
Author: Harald Anlauf <anl...@gmx.de>
Date: Sun Jun 23 22:36:43 2024 +0200
Fortran: fix passing of optional dummy as actual to optional argument
[PR55978]
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.
Diff:
---
gcc/fortran/trans-array.cc | 20 ++++++++++++----
gcc/testsuite/gfortran.dg/optional_absent_12.f90 | 30 ++++++++++++++++++++++++
2 files changed, 46 insertions(+), 4 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 19d69aec9c0..26237f43bec 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8703,6 +8703,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)
@@ -8740,6 +8744,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;
}
}
@@ -8989,8 +9001,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);
@@ -9024,8 +9036,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);
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_12.f90
b/gcc/testsuite/gfortran.dg/optional_absent_12.f90
new file mode 100644
index 00000000000..1e61d91fb6d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_12.f90
@@ -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
