From: Yuao Ma <c8ef@outlook.com>
Date: Thu, 13 Nov 2025 14:50:28 +0000 (+0800)
Subject: fortran: correctly handle optional allocatable dummy arguments
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=14e5e4ee1ff4aa499eb036a950e1695351bc0e2e;p=thirdparty%2Fgcc.git

fortran: correctly handle optional allocatable dummy arguments

This patch fixes a regression introduced in r14-8400-g186ae6d2cb93ad.

gcc/fortran/ChangeLog:

	* trans-expr.cc (conv_dummy_value): Add check for NULL allocatable.

gcc/testsuite/ChangeLog:

	* gfortran.dg/value_optional_3.f90: New test.
---

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index b87c935a703..ac85b762c7f 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6696,11 +6696,14 @@ conv_dummy_value (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym,
 	  argse.want_pointer = 1;
 	  gfc_conv_expr (&argse, e);
 	  cond = fold_convert (TREE_TYPE (argse.expr), null_pointer_node);
-	  cond = fold_build2_loc (input_location, NE_EXPR,
-				  logical_type_node,
+	  cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
 				  argse.expr, cond);
-	  vec_safe_push (optionalargs,
-			 fold_convert (boolean_type_node, cond));
+	  if (e->symtree->n.sym->attr.dummy)
+	    cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+				    logical_type_node,
+				    gfc_conv_expr_present (e->symtree->n.sym),
+				    cond);
+	  vec_safe_push (optionalargs, fold_convert (boolean_type_node, cond));
 	  /* Create "conditional temporary".  */
 	  conv_cond_temp (parmse, e, cond);
 	}
diff --git a/gcc/testsuite/gfortran.dg/value_optional_3.f90 b/gcc/testsuite/gfortran.dg/value_optional_3.f90
new file mode 100644
index 00000000000..58464f9ed2e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_optional_3.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+
+module m
+  implicit none(type, external)
+
+  logical :: is_present
+  logical :: is_allocated
+  integer :: has_value
+
+contains
+
+  subroutine test(a)
+    integer, allocatable :: a
+    call sub_val(a)
+  end subroutine test
+
+  subroutine test2(a)
+    integer, allocatable, optional :: a
+    call sub_val(a)
+  end subroutine test2
+
+  subroutine sub_val(x)
+    integer, optional, value :: x
+    if (present(x) .neqv. (is_present .and. is_allocated)) stop 1
+    if (present(x)) then
+      if (x /= has_value) stop 2
+    end if
+  end subroutine sub_val
+
+end module m
+
+use m
+implicit none(type, external)
+integer, allocatable :: b
+
+is_allocated = .false.
+is_present = .false.
+call test2()
+
+is_present = .true.
+call test(b)
+call test2(b)
+
+b = 4
+is_allocated = .true.
+has_value = b
+call test(b)
+call test2(b)
+deallocate(b)
+
+end program