Dear all,
this is the third patch in a series that addresses dummy arguments
with the VALUE attribute, now handling the passing of NULL actual
arguments. It is based on the refactoring in the previous patch
and reuses the handling of absent arguments.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From a0509b34d52b32a2e3511daefcb7dc308c755931 Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Thu, 25 Jan 2024 22:19:10 +0100
Subject: [PATCH] Fortran: NULL actual to optional dummy with VALUE attribute
[PR113377]
gcc/fortran/ChangeLog:
PR fortran/113377
* trans-expr.cc (conv_dummy_value): Treat NULL actual argument to
optional dummy with the VALUE attribute as not present.
(gfc_conv_procedure_call): Likewise.
gcc/testsuite/ChangeLog:
PR fortran/113377
* gfortran.dg/optional_absent_11.f90: New test.
---
gcc/fortran/trans-expr.cc | 11 ++-
.../gfortran.dg/optional_absent_11.f90| 99 +++
2 files changed, 108 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/optional_absent_11.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 3dc521fab9a..67abca9f6ba 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6086,7 +6086,7 @@ conv_dummy_value (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym,
gcc_assert (fsym && fsym->attr.value && !fsym->attr.dimension);
/* Absent actual argument for optional scalar dummy. */
- if (e == NULL && fsym->attr.optional && !fsym->attr.dimension)
+ if ((e == NULL || e->expr_type == EXPR_NULL) && fsym->attr.optional)
{
/* For scalar arguments with VALUE attribute which are passed by
value, pass "0" and a hidden argument for the optional status. */
@@ -6354,7 +6354,14 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
e->ts = temp_ts;
}
- if (e == NULL)
+ if (e == NULL
+ || (e->expr_type == EXPR_NULL
+ && fsym
+ && fsym->attr.value
+ && fsym->attr.optional
+ && !fsym->attr.dimension
+ && fsym->ts.type != BT_DERIVED
+ && fsym->ts.type != BT_CLASS))
{
if (se->ignore_optional)
{
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_11.f90 b/gcc/testsuite/gfortran.dg/optional_absent_11.f90
new file mode 100644
index 000..1f63def46fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_11.f90
@@ -0,0 +1,99 @@
+! { dg-do run }
+! PR fortran/113377
+!
+! Test that a NULL actual argument to an optional dummy is not present
+! (see also F2018:15.5.2.12 on argument presence)
+
+program test_null_actual_is_absent
+ implicit none
+ integer :: k(4) = 1
+ character :: c(4) = "#"
+ call one (k)
+ call three (c)
+contains
+ subroutine one (i)
+integer, intent(in) :: i(4)
+integer :: kk = 2
+integer, allocatable :: aa
+integer, pointer :: pp => NULL()
+print *, "Scalar integer"
+call two (kk, aa)
+call two (kk, pp)
+call two (kk, NULL())
+call two (kk, NULL(aa))
+call two (kk, NULL(pp))
+print *, "Elemental integer"
+call two (i, aa)
+call two (i, pp)
+call two (i, NULL())
+call two (i, NULL(aa))
+call two (i, NULL(pp))
+print *, "Scalar integer; value"
+call two_val (kk, aa)
+call two_val (kk, pp)
+call two_val (kk, NULL())
+call two_val (kk, NULL(aa))
+call two_val (kk, NULL(pp))
+print *, "Elemental integer; value"
+call two_val (i, aa)
+call two_val (i, pp)
+call two_val (i, NULL())
+call two_val (i, NULL(aa))
+call two_val (i, NULL(pp))
+ end
+
+ elemental subroutine two (i, j)
+integer, intent(in) :: i
+integer, intent(in), optional :: j
+if (present (j)) error stop 11
+ end
+
+ elemental subroutine two_val (i, j)
+integer, intent(in) :: i
+integer, value, optional :: j
+if (present (j)) error stop 12
+ end
+
+ subroutine three (y)
+character, intent(in) :: y(4)
+character :: zz = "*"
+character, allocatable :: aa
+character, pointer :: pp => NULL()
+print *, "Scalar character"
+call four (zz, aa)
+call four (zz, pp)
+call four (zz, NULL())
+call four (zz, NULL(aa))
+call four (zz, NULL(pp))
+print *, "Elemental character"
+call four (y, aa)
+call four (y, pp)
+call four (y, NULL())
+call four (y, NULL(aa))
+call four (y, NULL(pp))
+print *, "Scalar character; value"
+call four_val (zz, aa)
+call four_val (zz, pp)
+call four_val (zz, NULL())
+call four_val (zz, NULL(aa))
+call four_val (zz, NULL(pp))
+p
