diff mbox series

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

Message ID 5080fb8d-4f12-73ec-0aa7-c01ebf25b60b@codesourcery.com
State New
Headers show
Series Fortran: Fix absent-optional handling for nondescriptor arrays (PR94672) | expand

Commit Message

Tobias Burnus Aug. 26, 2020, 4:29 p.m. UTC 
This fixes an issue caused by the patch for PR 94672, which
affects both GCC 10 and GCC 11.

Only 'sVal' of 'subroutine foo' was affected, the rest is
only a crosscheck that it worked for those code paths.

(I did check against the dump – which looks fine. I could
add dump tests as well. The 'foo' test was failing with
'stop 5' (absent argument) at runtime before the patch;
the report was for the 'stop 4' case, which is probably
harder to trigger as run-time fail as the stack memory
is likely zero-initialized. → -fdump-tree-original scan
test useful?)

OK for mainline and GCC 10?

Tobias

-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter

Comments

Andre Vehreschild Aug. 28, 2020, 11:36 a.m. UTC | #1 
Hi Tobias,

the patch looks ok to me.

Thanks for the patch.

Regards,
	Andre

On Wed, 26 Aug 2020 18:29:40 +0200
Tobias Burnus <tobias@codesourcery.com> wrote:

> This fixes an issue caused by the patch for PR 94672, which
> affects both GCC 10 and GCC 11.
> 
> Only 'sVal' of 'subroutine foo' was affected, the rest is
> only a crosscheck that it worked for those code paths.
> 
> (I did check against the dump – which looks fine. I could
> add dump tests as well. The 'foo' test was failing with
> 'stop 5' (absent argument) at runtime before the patch;
> the report was for the 'stop 4' case, which is probably
> harder to trigger as run-time fail as the stack memory
> is likely zero-initialized. → -fdump-tree-original scan
> test useful?)
> 
> OK for mainline and GCC 10?
> 
> Tobias
> 
> -----------------
> Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
> Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung,
> Alexander Walter
diff mbox series

Patch

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.

 gcc/fortran/trans-array.c                          | 10 ++++-
 .../gfortran.dg/optional_assumed_charlen_2.f90     | 48 ++++++++++++++++++++++
 2 files changed, 56 insertions(+), 2 deletions(-)

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