From a0509b34d52b32a2e3511daefcb7dc308c755931 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
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 00000000000..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))
+    print *, "Elemental character; value"
+    call four_val (y,  aa)
+    call four_val (y,  pp)
+    call four_val (y,  NULL())
+    call four_val (y,  NULL(aa))
+    call four_val (y,  NULL(pp))
+  end
+
+  elemental subroutine four (i, j)
+    character, intent(in)           :: i
+    character, intent(in), optional :: j
+    if (present (j)) error stop 21
+  end
+
+  elemental subroutine four_val (i, j)
+    character, intent(in)           :: i
+    character, value,      optional :: j
+    if (present (j)) error stop 22
+  end
+end
--
2.35.3