Fortran: fix passing of optional dummy as actual to optional argument [PR55978]

gcc/fortran/ChangeLog:

	PR fortran/55978
	* trans-array.cc (gfc_conv_array_parameter): Do not dereference
	data component of a missing allocatable dummy array argument for
	passing as actual to optional dummy.  Harden logic of presence
	check for optional pointer dummy by using TRUTH_ANDIF_EXPR instead
	of TRUTH_AND_EXPR.

gcc/testsuite/ChangeLog:

	PR fortran/55978
	* gfortran.dg/optional_absent_12.f90: New test.

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 19d69aec9c0dd355e1957ed0143e6b686eb3e2cc..26237f43bec0063810271f3b3ac50606d51fbcae 100644 (file)
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8703,6 +8703,10 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
        && (sym->backend_decl != parent))
     this_array_result = false;
 
+  /* Passing an optional dummy argument as actual to an optional dummy?  */
+  bool pass_optional;
+  pass_optional = fsym && fsym->attr.optional && sym && sym->attr.optional;
+
   /* Passing address of the array if it is not pointer or assumed-shape.  */
   if (full_array_var && g77 && !this_array_result
       && sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS)
@@ -8740,6 +8744,14 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
          if (size)
            array_parameter_size (&se->pre, tmp, expr, size);
          se->expr = gfc_conv_array_data (tmp);
+         if (pass_optional)
+           {
+             tree cond = gfc_conv_expr_present (sym);
+             se->expr = build3_loc (input_location, COND_EXPR,
+                                    TREE_TYPE (se->expr), cond, se->expr,
+                                    fold_convert (TREE_TYPE (se->expr),
+                                                  null_pointer_node));
+           }
           return;
         }
     }
@@ -8989,8 +9001,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
          tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
                                 fold_convert (TREE_TYPE (tmp), ptr), tmp);
 
-         if (fsym && fsym->attr.optional && sym && sym->attr.optional)
-           tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+         if (pass_optional)
+           tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
                                   logical_type_node,
                                   gfc_conv_expr_present (sym), tmp);
 
@@ -9024,8 +9036,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
       tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
                             fold_convert (TREE_TYPE (tmp), ptr), tmp);
 
-      if (fsym && fsym->attr.optional && sym && sym->attr.optional)
-       tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+      if (pass_optional)
+       tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
                               logical_type_node,
                               gfc_conv_expr_present (sym), tmp);
 

diff --git a/gcc/testsuite/gfortran.dg/optional_absent_12.f90 b/gcc/testsuite/gfortran.dg/optional_absent_12.f90
new file mode 100644 (file)
index 0000000..1e61d91
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_12.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! { dg-additional-options "-fcheck=array-temps" }
+!
+! PR fortran/55978 - comment#19
+!
+! Test passing of (missing) optional dummy to optional array argument
+
+program test
+  implicit none
+  integer, pointer :: p(:) => null()
+  call one (p)
+  call one (null())
+  call one ()
+  call three ()
+contains
+  subroutine one (y)
+    integer, pointer, optional, intent(in) :: y(:)
+    call two (y)
+  end subroutine one
+
+  subroutine three (z)
+    integer, allocatable, optional, intent(in) :: z(:)
+    call two (z)
+  end subroutine three
+
+  subroutine two (x)
+    integer, optional, intent(in) :: x(*)
+    if (present (x)) stop 1
+  end subroutine two
+end