* Re: [PATCH] Fortran: deferred-length character optional dummy arguments [PR93762,PR100651] @ 2023-11-28 17:07 FX Coudert 2023-11-28 19:56 ` Harald Anlauf 0 siblings, 1 reply; 4+ messages in thread From: FX Coudert @ 2023-11-28 17:07 UTC (permalink / raw) To: GCC Patches; +Cc: fortran, Harald Anlauf 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 ^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [PATCH] Fortran: deferred-length character optional dummy arguments [PR93762,PR100651] 2023-11-28 17:07 [PATCH] Fortran: deferred-length character optional dummy arguments [PR93762,PR100651] FX Coudert @ 2023-11-28 19:56 ` Harald Anlauf 2023-12-01 21:53 ` [PATCH, v3] " Harald Anlauf 0 siblings, 1 reply; 4+ messages in thread From: Harald Anlauf @ 2023-11-28 19:56 UTC (permalink / raw) To: FX Coudert, GCC Patches; +Cc: fortran [-- Attachment #1: Type: text/plain, Size: 1835 bytes --] 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 [-- Attachment #2: pr100651-v2.diff --] [-- Type: text/x-patch, Size: 5295 bytes --] From 63879942b491e23eefc6da4d80c5492434e42ec8 Mon Sep 17 00:00:00 2001 From: Harald Anlauf <anlauf@gmx.de> 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, &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); + } + 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, &se->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 00000000000..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) 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)) then + allocate (character(2) :: msg(42)) + msg(:) = "ok" + end if + end + + subroutine test_rank1 (msg1) + character(:), optional, allocatable, intent(out) :: msg1(:) + call assert_rank1 (msg1) + end + + ! Deferred-length character, pointer: + subroutine assert_p (err_msg0) + character(:), optional, pointer :: err_msg0 + if (present (err_msg0)) then + if (associated (err_msg0)) deallocate (err_msg0) + allocate (character(8) :: err_msg0) + err_msg0 = 'poo bla' + end if + end + + subroutine to_int_p (err_msg1) + character(:), optional, pointer :: err_msg1 + call assert_p (err_msg1) + end + + subroutine to_int2_p (err_msg2) + character(:), pointer :: err_msg2 + call assert_p (err_msg2) + end +end -- 2.35.3 ^ permalink raw reply [flat|nested] 4+ messages in thread
* [PATCH, v3] Fortran: deferred-length character optional dummy arguments [PR93762,PR100651] 2023-11-28 19:56 ` Harald Anlauf @ 2023-12-01 21:53 ` Harald Anlauf 2023-12-02 10:10 ` FX Coudert 0 siblings, 1 reply; 4+ messages in thread From: Harald Anlauf @ 2023-12-01 21:53 UTC (permalink / raw) To: FX Coudert, GCC Patches; +Cc: fortran [-- Attachment #1: Type: text/plain, Size: 2340 bytes --] 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 > [-- Attachment #2: pr100651-v3.diff --] [-- Type: text/x-patch, Size: 6239 bytes --] From b0a169bd70c9cd175c25b4a9543b24058596bf5e Mon Sep 17 00:00:00 2001 From: Harald Anlauf <anlauf@gmx.de> 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); + } + 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, &se->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 00000000000..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)) then + allocate (character(2) :: msg(42)) + msg(:) = "ok" + end if + end + + subroutine test_rank1 (msg1) + character(:), optional, allocatable, intent(out) :: msg1(:) + call assert_rank1 (msg1) + end + + ! Deferred-length character, pointer: + subroutine assert_p (err_msg0) + character(:), optional, pointer :: err_msg0 + if (present (err_msg0)) then + if (associated (err_msg0)) deallocate (err_msg0) + allocate (character(8) :: err_msg0) + err_msg0 = 'poo bla' + end if + end + + subroutine to_int_p (err_msg1) + character(:), optional, pointer :: err_msg1 + call assert_p (err_msg1) + end + + subroutine to_int2_p (err_msg2) + character(:), pointer :: err_msg2 + call assert_p (err_msg2) + end +end -- 2.35.3 ^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [PATCH, v3] Fortran: deferred-length character optional dummy arguments [PR93762,PR100651] 2023-12-01 21:53 ` [PATCH, v3] " Harald Anlauf @ 2023-12-02 10:10 ` FX Coudert 0 siblings, 0 replies; 4+ messages in thread From: FX Coudert @ 2023-12-02 10:10 UTC (permalink / raw) To: Harald Anlauf; +Cc: GCC Patches, fortran Hi, > 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. Nice, that sounds logical. > Regtested on x86_64-pc-linux-gnu. OK for mainline? OK. FX ^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2023-12-02 10:10 UTC | newest] Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2023-11-28 17:07 [PATCH] Fortran: deferred-length character optional dummy arguments [PR93762,PR100651] FX Coudert 2023-11-28 19:56 ` Harald Anlauf 2023-12-01 21:53 ` [PATCH, v3] " Harald Anlauf 2023-12-02 10:10 ` FX Coudert
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).