Fortran - fix handling of optional allocatable DT arguments with INTENT(OUT)

gcc/fortran/ChangeLog:

	PR fortran/102287
	* trans-expr.c (gfc_conv_procedure_call): Wrap deallocation of
	allocatable components of optional allocatable derived type
	procedure arguments with INTENT(OUT) into a presence check.

gcc/testsuite/ChangeLog:

	PR fortran/102287
	* gfortran.dg/intent_out_14.f90: New test.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 18d665192f0d70a38961b4bffcadebdf88c7bdc0..4a81f4695d9a1db236ccd84b329fa8f6b631e943 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6548,6 +6548,17 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
                    // deallocate the components first
                    tmp = gfc_deallocate_alloc_comp (fsym->ts.u.derived,
                                                     parmse.expr, e->rank);
+                   /* But check whether dummy argument is optional.  */
+                   if (tmp != NULL_TREE
+                       && fsym->attr.optional
+                       && e->expr_type == EXPR_VARIABLE
+                       && e->symtree->n.sym->attr.optional)
+                     {
+                       tree present;
+                       present = gfc_conv_expr_present (e->symtree->n.sym);
+                       tmp = build3_v (COND_EXPR, present, tmp,
+                                       build_empty_stmt (input_location));
+                     }
                    if (tmp != NULL_TREE)
                      gfc_add_expr_to_block (&se->pre, tmp);
                  }

diff --git a/gcc/testsuite/gfortran.dg/intent_out_14.f90 b/gcc/testsuite/gfortran.dg/intent_out_14.f90
new file mode 100644 (file)
index 0000000..e599463
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_out_14.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! PR fortran/102287 - optional allocatable DT array arguments (intent out)
+
+module m
+  type t
+     integer, allocatable :: a
+  end type t
+contains
+  subroutine a (x, v)
+    type(t), optional, allocatable, intent(out) :: x(:)
+    type(t), optional,              intent(out) :: v(:)
+    call b (x, v)
+  end subroutine a
+
+  subroutine b (y, w)
+    type(t), optional, allocatable, intent(out) :: y(:)
+    type(t), optional,              intent(out) :: w(:)
+  end subroutine b
+end module m
+
+program p
+  use m
+  call a ()
+end