From 9df71b289071ea1b98ea9fe50f0fca5bf9ab764c Mon Sep 17 00:00:00 2001
From: Yuao Ma <c8ef@outlook.com>
Date: Wed, 12 Nov 2025 22:33:51 +0800
Subject: [PATCH] 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.
---
 gcc/fortran/trans-expr.cc                     | 11 +++--
 .../gfortran.dg/value_optional_3.f90          | 44 +++++++++++++++++++
 2 files changed, 51 insertions(+), 4 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/value_optional_3.f90

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d09b68e7521..9bd7122a4fc 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6726,11 +6726,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..70b5fef1284
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_optional_3.f90
@@ -0,0 +1,44 @@
+! { 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)) error stop
+      if (present(x)) then
+         if (x /= has_value) error stop
+      end if
+   end subroutine sub_val
+
+end module m
+
+use m
+implicit none(type, external)
+integer, allocatable :: b
+
+is_allocated = .false.
+is_present = .true.
+call test(b)
+call test2(b)
+
+is_present = .false.
+call test2()
+
+end program
-- 
2.43.0