[gcc r10-10141] Fortran - fix handling of optional allocatable DT arguments with INTENT(OUT)

[Harald Anlauf <anlauf@gcc.gnu.org>]

https://gcc.gnu.org/g:216a4be1cc18119a83df562f7abb3dcebd9ce512

commit r10-10141-g216a4be1cc18119a83df562f7abb3dcebd9ce512
Author: Harald Anlauf <anlauf@gmx.de>
Date:   Thu Sep 16 20:12:21 2021 +0200

    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.
    
    (cherry picked from commit cfea7b86f2430b9cb8018379b071f4004233119c)

Diff:
---
 gcc/fortran/trans-expr.c                    | 11 +++++++++++
 gcc/testsuite/gfortran.dg/intent_out_14.f90 | 24 ++++++++++++++++++++++++
 2 files changed, 35 insertions(+)

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index c26fe146dc3..07e046cc2ac 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6446,6 +6446,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
index 00000000000..e5994635008
--- /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