From: Tobias Burnus <tobias@codesourcery.com>
Date: Fri, 28 Aug 2020 11:54:10 +0000 (+0200)
Subject: Fortran: Fix absent-optional handling for nondescriptor arrays (PR94672)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=cb3c3d63315ceb4dc262e5efb83b42c73c43387d;p=gcc.git

Fortran: Fix absent-optional handling for nondescriptor arrays (PR94672)

gcc/fortran/ChangeLog:

	PR fortran/94672
	* trans-array.c (gfc_trans_g77_array): Check against the parm decl and
	set the nonparm decl used for the is-present check to NULL if absent.

gcc/testsuite/ChangeLog:

	PR fortran/94672
	* gfortran.dg/optional_assumed_charlen_2.f90: New test.
---

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 0e3495d59cc..6566c47d4ae 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6472,8 +6472,14 @@ gfc_trans_g77_array (gfc_symbol * sym, gfc_wrapped_block * block)
 
   if (sym->attr.optional || sym->attr.not_always_present)
     {
-      tmp = gfc_conv_expr_present (sym);
-      stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt (input_location));
+      tree nullify;
+      if (TREE_CODE (parm) != PARM_DECL)
+	nullify = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+				   parm, null_pointer_node);
+      else
+	nullify = build_empty_stmt (input_location);
+      tmp = gfc_conv_expr_present (sym, true);
+      stmt = build3_v (COND_EXPR, tmp, stmt, nullify);
     }
 
   gfc_add_init_cleanup (block, stmt, NULL_TREE);
diff --git a/gcc/testsuite/gfortran.dg/optional_assumed_charlen_2.f90 b/gcc/testsuite/gfortran.dg/optional_assumed_charlen_2.f90
new file mode 100644
index 00000000000..fa8cfd79038
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_assumed_charlen_2.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+! PR fortran/94672
+!
+! Contributed by Tomáš Trnka
+!
+module m
+  implicit none (type,external)
+  type t
+    integer :: i = 5
+  end type t
+contains
+subroutine bar(x, y, z, n)
+  integer, value :: n
+  type(t), intent(out), optional :: x(:), y(n), z(:)
+  allocatable :: z
+end subroutine bar
+
+subroutine foo (n, nFound, sVal)
+   integer,                   value  :: n
+   integer,                   intent(out)  :: nFound
+   character(*),    optional, intent(out) :: sVal(n)
+
+   nFound = 0
+
+   if (present(sVal)) then
+      nFound = nFound + 1
+   end if
+end subroutine
+end
+
+use m
+implicit none (type,external)
+type(t) :: a(7), b(7), c(:)
+allocatable :: c
+integer :: nn, nf
+character(len=4) :: str
+
+allocate(c(7))
+call bar(a,b,c,7)
+if (any(a(:)%i /= 5)) stop 1
+if (any(b(:)%i /= 5)) stop 2
+if (allocated(c)) stop 3
+
+call foo(7, nf, str)
+if (nf /= 1) stop 4
+call foo(7, nf)
+if (nf /= 0) stop 5
+end