diff mbox series

Fortran: NULL actual to optional dummy with VALUE attribute [PR113377]

Message ID trinity-b5d96f9b-8ab5-4906-b937-f373b372c479-1706218005635@3c-app-gmx-bs25
State Unresolved
Headers
Series Fortran: NULL actual to optional dummy with VALUE attribute [PR113377] |

Checks

Context Check Description
snail/gcc-patch-check warning Git am fail log

Commit Message

Harald Anlauf Jan. 25, 2024, 9:26 p.m. UTC 
  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

Comments

Mikael Morin Jan. 28, 2024, 1:34 p.m. UTC | #1 
Le 25/01/2024 à 22:26, Harald Anlauf a écrit :
> 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
> 
OK, thanks.
diff mbox series

Patch

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