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 b87c935a7031f71425919cee7cb5561d3c659dc0..ac85b762c7fecc1731c7721007eaf0885ea7e219 100644 (file)
--- 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 (file)
index 0000000..58464f9
--- /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