Dear all,
this patch extends the previous version by adding further code testing
the presence of an optional deferred-length character argument also
in the function initialization code. This allows to re-enable a
commented-out test in v2.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
On 11/28/23 20:56, Harald Anlauf wrote:
Hi FX,
On 11/28/23 18:07, FX Coudert wrote:
Hi Harald,
The patch looks OK to me. Probably wait a bit for another opinion,
since I’m not that active and I may have missed something.
Thanks,
FX
thanks for having a look.
In the meantime I got an automated mail from the Linaro testers.
According to it there is a runtime failure of the testcase on
aarch64. I couldn't see any useful traceback or else.
I tried the testcase on x86 with different options and found
an unexpected result only with -fsanitize=undefined and only
for the case of a rank-1 dummy when there is no actual argument
and the passed to another subroutine. (valgrind is happy.)
Reduced reproducer:
! this fails with -fsanitize=undefined
program main
call test_rank1 ()
contains
subroutine test_rank1 (msg1)
character(:), optional, allocatable :: msg1(:)
if (present (msg1)) stop 77
call assert_rank1 () ! <- no problem here
call assert_rank1 (msg1) ! <- problematic code path
end
subroutine assert_rank1 (msg2)
character(:), optional, allocatable :: msg2(:)
if (present (msg2)) stop 99 ! <- no problem if commented
end
end
As far as I can tell, this could be a pre-existing (latent)
issue. By looking at the tree-dump, the only thing that
appears fishy has been there before. But then I am only
guessing that this is the problem observed on aarch64.
I have disabled the related call in the testcase of the
attached revised version. As I do not see anything else,
I wonder if one could proceed with the current version
but open a PR for the reduced case above, unless someone
can pinpoint the place that is responsible for the above
failure. (Is it the caller, or rather the function entry
code in the callee?)
Cheers,
Harald
From b0a169bd70c9cd175c25b4a9543b24058596bf5e Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Fri, 1 Dec 2023 22:44:30 +0100
Subject: [PATCH] Fortran: deferred-length character optional dummy arguments
[PR93762,PR100651]
gcc/fortran/ChangeLog:
PR fortran/93762
PR fortran/100651
* trans-array.cc (gfc_trans_deferred_array): Add presence check
for optional deferred-length character dummy arguments.
* trans-expr.cc (gfc_conv_missing_dummy): The character length for
deferred-length dummy arguments is passed by reference, so that
its value can be returned. Adjust handling for optional dummies.
gcc/testsuite/ChangeLog:
PR fortran/93762
PR fortran/100651
* gfortran.dg/optional_deferred_char_1.f90: New test.
---
gcc/fortran/trans-array.cc| 9 ++
gcc/fortran/trans-expr.cc | 22 +++-
.../gfortran.dg/optional_deferred_char_1.f90 | 100 ++
3 files changed, 127 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/optional_deferred_char_1.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index bbb81f40aa9..82f60a656f3 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11430,6 +11430,15 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
{
gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
gfc_trans_vla_type_sizes (sym, &init);
+
+ /* Presence check of optional deferred-length character dummy. */
+ if (sym->ts.deferred && sym->attr.dummy && sym->attr.optional)
+ {
+ tmp = gfc_finish_block (&init);
+ tmp = build3_v (COND_EXPR, gfc_conv_expr_present (sym),
+ tmp, build_empty_stmt (input_location));
+ gfc_add_expr_to_block (&init, tmp);
+ }
}
/* Dummy, use associated and result variables don't need anything special. */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6a47af39c57..ea087294249 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2125,10 +2125,24 @@ gfc_conv_missing_dummy (gfc_se * se, gfc_expr * arg, gfc_typespec ts, int kind)
if (ts.type == BT_CHARACTER)
{
- tmp = build_int_cst (gfc_charlen_type_node, 0);
- tmp = fold_build3_loc (input_location, COND_EXPR, gfc_charlen_type_node,
- present, se->string_length, tmp);
- tmp = gfc_evaluate_now (tmp, &se->pre);
+ /* Handle deferred-length dummies that pass the character length by
+ reference so that the value can be returned. */
+ if (ts.deferred && INDIRECT_REF_P (se->string_length))
+ {
+ tmp = gfc_build_addr_expr (NULL_TREE, se->string_length);
+ tmp = fold_build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp),
+ present, tmp, null_pointer_node);
+ tmp = gfc_evaluate_now (tmp, &se->pre);
+ tmp = build_fold_indirect_ref_loc (input_location, tmp);
+ }
+
