Re: [PATCH] Fortran: deferred-length character optional dummy arguments [PR93762,PR100651]
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 63879942b491e23eefc6da4d80c5492434e42ec8 Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Tue, 28 Nov 2023 20:19:14 +0100
Subject: [PATCH] Fortran: deferred-length character optional dummy arguments
[PR93762,PR100651]
gcc/fortran/ChangeLog:
PR fortran/93762
PR fortran/100651
* 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-expr.cc | 22 +++-
.../gfortran.dg/optional_deferred_char_1.f90 | 100 ++
2 files changed, 118 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/optional_deferred_char_1.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index bfe9996ced6..c90c7bbf936 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2116,10 +2116,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, >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, >pre);
+ tmp = build_fold_indirect_ref_loc (input_location, tmp);
+ }
+ else
+ {
+ 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, >pre);
+ }
se->string_length = tmp;
}
return;
diff --git a/gcc/testsuite/gfortran.dg/optional_deferred_char_1.f90 b/gcc/testsuite/gfortran.dg/optional_deferred_char_1.f90
new file mode 100644
index 000..0fb0fb5fea1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_deferred_char_1.f90
@@ -0,0 +1,100 @@
+! { dg-do run }
+! PR fortran/93762
+! PR fortran/100651 - deferred-length character as optional dummy argument
+
+program main
+ implicit none
+ character(:), allocatable :: err_msg, msg3(:)
+ character(:), pointer :: err_msg2 => NULL()
+
+ ! Subroutines with optional arguments
+ call to_int ()
+ call to_int_p ()
+! call test_rank1 ()! this fails with -fsanitize=undefined
+ call assert_code ()
+ call assert_p ()
+ call assert_rank1 ()
+
+ ! Test passing of optional arguments
+ call to_int (err_msg)
+ if (.not. allocated (err_msg)) stop 1
+ if (len (err_msg) /= 7)stop 2
+ if (err_msg(1:7) /= "foo bar") stop 3
+
+ call to_int2 (err_msg)
+ if (.not. allocated (err_msg)) stop 4
+ if (len (err_msg) /= 7)
Re: [PATCH] Fortran: deferred-length character optional dummy arguments [PR93762,PR100651]
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
[PATCH] Fortran: deferred-length character optional dummy arguments [PR93762,PR100651]
Dear all,
the attached patch fixes the passing of deferred-length character
to optional dummy arguments: the character length shall be passed
by reference, not by value.
Original analysis of the issue by Steve in PR93762, independently
done by FX in PR100651. The patch fixes both PRs.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
As the fix is local and affects only deferred-length character,
would it be ok to backport to 13-branch?
Thanks,
Harald
From 8ce1c8e7d0390361a1507000b7abbf6509b2fee9 Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Mon, 27 Nov 2023 20:19:11 +0100
Subject: [PATCH] Fortran: deferred-length character optional dummy arguments
[PR93762,PR100651]
gcc/fortran/ChangeLog:
PR fortran/93762
PR fortran/100651
* 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-expr.cc | 22 +++-
.../gfortran.dg/optional_deferred_char_1.f90 | 100 ++
2 files changed, 118 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/optional_deferred_char_1.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 50c4604a025..e992f60d8bb 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2116,10 +2116,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, >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, >pre);
+ tmp = build_fold_indirect_ref_loc (input_location, tmp);
+ }
+ else
+ {
+ 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, >pre);
+ }
se->string_length = tmp;
}
return;
diff --git a/gcc/testsuite/gfortran.dg/optional_deferred_char_1.f90 b/gcc/testsuite/gfortran.dg/optional_deferred_char_1.f90
new file mode 100644
index 000..d399dd11ca2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_deferred_char_1.f90
@@ -0,0 +1,100 @@
+! { dg-do run }
+! PR fortran/93762
+! PR fortran/100651 - deferred-length character as optional dummy argument
+
+program main
+ implicit none
+ character(:), allocatable :: err_msg, msg3(:)
+ character(:), pointer :: err_msg2 => NULL()
+
+ ! Subroutines with optional arguments
+ call to_int ()
+ call to_int_p ()
+ call test_rank1 ()
+ call assert_code ()
+ call assert_p ()
+ call assert_rank1 ()
+
+ ! Test passing of optional arguments
+ call to_int (err_msg)
+ if (.not. allocated (err_msg)) stop 1
+ if (len (err_msg) /= 7)stop 2
+ if (err_msg(1:7) /= "foo bar") stop 3
+
+ call to_int2 (err_msg)
+ if (.not. allocated (err_msg)) stop 4
+ if (len (err_msg) /= 7)stop 5
+ if (err_msg(1:7) /= "foo bar") stop 6
+ deallocate (err_msg)
+
+ call to_int_p (err_msg2)
+ if (.not. associated (err_msg2)) stop 11
+ if (len (err_msg2) /= 8) stop 12
+ if (err_msg2(1:8) /= "poo bla ") stop 13
+ deallocate (err_msg2)
+
+ call to_int2_p (err_msg2)
+ if (.not. associated (err_msg2)) stop 14
+ if (len (err_msg2) /= 8) stop 15
+ if (err_msg2(1:8) /= "poo bla ") stop 16
+ deallocate (err_msg2)
+
+ call test_rank1 (msg3)
+ if (.not. allocated (msg3)) stop 21
+ if (len (msg3) /= 2)stop 22
+ if (size (msg3) /= 42) stop 23
+ if (any (msg3 /= "ok")) stop 24
+ deallocate (msg3)
+
+contains
+
+ ! Deferred-length character, allocatable:
+ subroutine assert_code (err_msg0)
+character(:), optional, allocatable :: err_msg0
+if (present (err_msg0)) err_msg0 = 'foo bar'
+ end
+ ! Test: optional argument
+ subroutine to_int (err_msg1)
+character(:), optional, allocatable :: err_msg1
+call assert_code (err_msg1)
+ end
+ ! Control: non-optional argument
+ subroutine to_int2 (err_msg2)
+character(:), allocatable :: err_msg2
+call assert_code (err_msg2)
+ end
+
+ ! Rank-1:
+ subroutine assert_rank1 (msg)
+character(:), optional, allocatable, intent(out) :: msg(:)
+if (present (msg)) the
