public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: Tobias Burnus <burnus@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/omp/gcc-11] Fortran: Fix "str" to scalar descriptor conversion [PR92482] Date: Tue, 19 Oct 2021 13:39:26 +0000 (GMT) [thread overview] Message-ID: <20211019133926.847243858033@sourceware.org> (raw) https://gcc.gnu.org/g:2fe7364a23f359e8671f2513c7f115c56c3f10ec commit 2fe7364a23f359e8671f2513c7f115c56c3f10ec Author: Tobias Burnus <tobias@codesourcery.com> Date: Tue Oct 19 15:16:01 2021 +0200 Fortran: Fix "str" to scalar descriptor conversion [PR92482] PR fortran/92482 gcc/fortran/ChangeLog: * trans-expr.c (gfc_conv_procedure_call): Use TREE_OPERAND not build_fold_indirect_ref_loc to undo an ADDR_EXPR. gcc/testsuite/ChangeLog: * gfortran.dg/bind-c-char-descr.f90: Remove xfail; extend a bit. (cherry picked from commit 6920d5a1a2834e9c62d441b8f4c6186b01107d13) Diff: --- gcc/fortran/ChangeLog.omp | 9 ++++ gcc/fortran/trans-expr.c | 2 +- gcc/testsuite/ChangeLog.omp | 8 ++++ gcc/testsuite/gfortran.dg/bind-c-char-descr.f90 | 57 ++++++++++++++++--------- 4 files changed, 56 insertions(+), 20 deletions(-) diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp index 241d19aaa2c..14b01395814 100644 --- a/gcc/fortran/ChangeLog.omp +++ b/gcc/fortran/ChangeLog.omp @@ -1,3 +1,12 @@ +2021-10-19 Tobias Burnus <tobias@codesourcery.com> + + Backported from master: + 2021-10-19 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/92482 + * trans-expr.c (gfc_conv_procedure_call): Use TREE_OPERAND not + build_fold_indirect_ref_loc to undo an ADDR_EXPR. + 2021-10-15 Tobias Burnus <tobias@codesourcery.com> Backported from master: diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 089fabfc6fb..781ab87ee64 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -6640,7 +6640,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, { tmp = parmse.expr; if (TREE_CODE (tmp) == ADDR_EXPR) - tmp = build_fold_indirect_ref_loc (input_location, tmp); + tmp = TREE_OPERAND (tmp, 0); parmse.expr = gfc_conv_scalar_to_descriptor (&parmse, tmp, fsym->attr); parmse.expr = gfc_build_addr_expr (NULL_TREE, diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp index 90c7d502223..91ad37ac57e 100644 --- a/gcc/testsuite/ChangeLog.omp +++ b/gcc/testsuite/ChangeLog.omp @@ -1,3 +1,11 @@ +2021-10-19 Tobias Burnus <tobias@codesourcery.com> + + Backported from master: + 2021-10-19 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/92482 + * gfortran.dg/bind-c-char-descr.f90: Remove xfail; extend a bit. + 2021-10-18 Tobias Burnus <tobias@codesourcery.com> Backported from master: diff --git a/gcc/testsuite/gfortran.dg/bind-c-char-descr.f90 b/gcc/testsuite/gfortran.dg/bind-c-char-descr.f90 index 3b01ad3b63d..8829fd1f71b 100644 --- a/gcc/testsuite/gfortran.dg/bind-c-char-descr.f90 +++ b/gcc/testsuite/gfortran.dg/bind-c-char-descr.f90 @@ -2,7 +2,6 @@ ! ! Contributed by José Rui Faustino de Sousa ! -! Note the xfail issue below for 'strg_print_2("abc") program strp_p @@ -24,13 +23,18 @@ program strp_p if (len(str) /= 3 .or. str /= "abc") stop 1 if (len(strp_1) /= 3 .or. strp_1 /= "abc") stop 2 if (len(strp_2) /= 3 .or. strp_2 /= "abc") stop 3 - call strg_print_0("abc") ! Error (10.0.0) or segmentation fault (9.1.0) - call strg_print_0(str) ! Error (10.0.0) or segmentation fault (9.1.0) - call strg_print_0(strp_1) ! Error (10.0.0) or segmentation fault (9.1.0) - call strg_print_0(strp_2) ! Error (10.0.0) or segmentation fault (9.1.0) - call strg_print_1(strp_1) ! Not yet supported + call strg_print_0("abc") + call strg_print_0(str) + call strg_print_0(strp_1) + call strg_print_0(strp_2) + call strg_print_0_c("abc") + call strg_print_0_c(str) + call strg_print_0_c(strp_1) + call strg_print_0_c(strp_2) + call strg_print_1(strp_1) + call strg_print_1_c(strp_1) - call strg_print_2("abc", xfail=.true.) + call strg_print_2("abc") call strg_print_2(str) call strg_print_2(strp_1) call strg_print_2(strp_2) @@ -42,14 +46,21 @@ program strp_p contains - subroutine strg_print_0(this) bind(c) ! Error (10.0.0 20191106) or warning (9.1.0) issued with bind(c) + subroutine strg_print_0 (this) character(len=*, kind=c_char), target, intent(in) :: this if (len (this) /= 3) stop 10 if (this /= "abc") stop 11 end subroutine strg_print_0 + + subroutine strg_print_0_c (this) bind(c) + character(len=*, kind=c_char), target, intent(in) :: this + + if (len (this) /= 3) stop 10 + if (this /= "abc") stop 11 + end subroutine strg_print_0_c - subroutine strg_print_1(this) bind(c) ! Not yet supported with bind(c) + subroutine strg_print_1 (this) bind(c) character(len=:, kind=c_char), pointer, intent(in) :: this character(len=:), pointer :: strn @@ -63,26 +74,34 @@ contains if (this /= "abc") stop 25 end if end subroutine strg_print_1 + + subroutine strg_print_1_c (this) bind(c) + character(len=:, kind=c_char), pointer, intent(in) :: this + character(len=:), pointer :: strn + + if (.not. associated (this)) stop 20 + if (len (this) /= 3) stop 21 + if (this /= "abc") stop 22 + strn => this + if (.not. associated (strn)) stop 23 + if(associated(strn))then + if (len (this) /= 3) stop 24 + if (this /= "abc") stop 25 + end if + end subroutine strg_print_1_c - subroutine strg_print_2(this, xfail) + subroutine strg_print_2(this) use, intrinsic :: iso_c_binding, only: & c_loc, c_f_pointer type(*), target, intent(in) :: this(..) - logical, optional, value :: xfail character(len=l), pointer :: strn call c_f_pointer(c_loc(this), strn) if (.not. associated (strn)) stop 30 - if(associated(strn))then + if (associated(strn)) then if (len (strn) /= 3) stop 31 - if (strn /= "abc") then - if (present (xfail)) then - print *, 'INVALID STRING - EXPECTED "abc" / PR47225' - else - stop 32 - end if - end if + if (strn /= "abc") stop 32 end if end subroutine strg_print_2
reply other threads:[~2021-10-19 13:39 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20211019133926.847243858033@sourceware.org \ --to=burnus@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
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).