public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: Harald Anlauf <anlauf@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-3931] Fortran: fix treatment of character, value, optional dummy arguments [PR107444] Date: Sat, 12 Nov 2022 20:18:03 +0000 (GMT) [thread overview] Message-ID: <20221112201803.683473858407@sourceware.org> (raw) https://gcc.gnu.org/g:59a63247992eb13153b82c4902aadf111460eac2 commit r13-3931-g59a63247992eb13153b82c4902aadf111460eac2 Author: Harald Anlauf <anlauf@gmx.de> Date: Thu Nov 10 22:30:27 2022 +0100 Fortran: fix treatment of character, value, optional dummy arguments [PR107444] Fix handling of character dummy arguments that have the optional+value attribute. Change name of internal symbols that carry the hidden presence status of optional arguments to distinguish them from the internal hidden character length. Update documentation to clarify the gfortran ABI. gcc/fortran/ChangeLog: PR fortran/107444 * trans-decl.cc (create_function_arglist): Extend presence status to all intrinsic types, and change prefix of internal symbol to '.'. * trans-expr.cc (gfc_conv_expr_present): Align to changes in create_function_arglist. (gfc_conv_procedure_call): Fix generation of procedure arguments for the case of character dummy arguments with optional+value attribute. * trans-types.cc (gfc_get_function_type): Synchronize with changes to create_function_arglist. * doc/gfortran/naming-and-argument-passing-conventions.rst: Clarify the gfortran argument passing conventions with regard to OPTIONAL dummy arguments of intrinsic type. gcc/testsuite/ChangeLog: PR fortran/107444 * gfortran.dg/optional_absent_7.f90: Adjust regex. * gfortran.dg/optional_absent_8.f90: New test. Diff: --- .../naming-and-argument-passing-conventions.rst | 3 +- gcc/fortran/trans-decl.cc | 10 ++-- gcc/fortran/trans-expr.cc | 25 ++++++---- gcc/fortran/trans-types.cc | 14 +++--- gcc/testsuite/gfortran.dg/optional_absent_7.f90 | 2 +- gcc/testsuite/gfortran.dg/optional_absent_8.f90 | 53 ++++++++++++++++++++++ 6 files changed, 84 insertions(+), 23 deletions(-) diff --git a/gcc/fortran/doc/gfortran/naming-and-argument-passing-conventions.rst b/gcc/fortran/doc/gfortran/naming-and-argument-passing-conventions.rst index 4baaee9bfec..fa999fac355 100644 --- a/gcc/fortran/doc/gfortran/naming-and-argument-passing-conventions.rst +++ b/gcc/fortran/doc/gfortran/naming-and-argument-passing-conventions.rst @@ -142,8 +142,7 @@ is used for dummy arguments; with ``VALUE``, those variables are passed by value. For ``OPTIONAL`` dummy arguments, an absent argument is denoted -by a NULL pointer, except for scalar dummy arguments of type -``INTEGER``, ``LOGICAL``, ``REAL`` and ``COMPLEX`` +by a NULL pointer, except for scalar dummy arguments of intrinsic type which have the ``VALUE`` attribute. For those, a hidden Boolean argument (``logical(kind=C_bool),value``) is used to indicate whether the argument is present. diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 94988b8690e..217de6b8da0 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -2708,16 +2708,16 @@ create_function_arglist (gfc_symbol * sym) type = gfc_sym_type (f->sym); } } - /* For noncharacter scalar intrinsic types, VALUE passes the value, + /* For scalar intrinsic types, VALUE passes the value, hence, the optional status cannot be transferred via a NULL pointer. Thus, we will use a hidden argument in that case. */ - else if (f->sym->attr.optional && f->sym->attr.value - && !f->sym->attr.dimension && f->sym->ts.type != BT_CLASS - && !gfc_bt_struct (f->sym->ts.type)) + if (f->sym->attr.optional && f->sym->attr.value + && !f->sym->attr.dimension && f->sym->ts.type != BT_CLASS + && !gfc_bt_struct (f->sym->ts.type)) { tree tmp; strcpy (&name[1], f->sym->name); - name[0] = '_'; + name[0] = '.'; tmp = build_decl (input_location, PARM_DECL, get_identifier (name), boolean_type_node); diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index f3fbb527157..b95c5cf2f96 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -1985,15 +1985,14 @@ gfc_conv_expr_present (gfc_symbol * sym, bool use_saved_desc) /* Intrinsic scalars with VALUE attribute which are passed by value use a hidden argument to denote the present status. */ - if (sym->attr.value && sym->ts.type != BT_CHARACTER - && sym->ts.type != BT_CLASS && sym->ts.type != BT_DERIVED - && !sym->attr.dimension) + if (sym->attr.value && !sym->attr.dimension + && sym->ts.type != BT_CLASS && !gfc_bt_struct (sym->ts.type)) { char name[GFC_MAX_SYMBOL_LEN + 2]; tree tree_name; gcc_assert (TREE_CODE (decl) == PARM_DECL); - name[0] = '_'; + name[0] = '.'; strcpy (&name[1], sym->name); tree_name = get_identifier (name); @@ -6162,11 +6161,21 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, value, pass "0" and a hidden argument gives the optional status. */ if (fsym && fsym->attr.optional && fsym->attr.value - && !fsym->attr.dimension && fsym->ts.type != BT_CHARACTER - && fsym->ts.type != BT_CLASS && fsym->ts.type != BT_DERIVED) + && !fsym->attr.dimension && fsym->ts.type != BT_CLASS + && !gfc_bt_struct (sym->ts.type)) { - parmse.expr = fold_convert (gfc_sym_type (fsym), - integer_zero_node); + if (fsym->ts.type == BT_CHARACTER) + { + /* Pass a NULL pointer for an absent CHARACTER arg + and a length of zero. */ + parmse.expr = null_pointer_node; + parmse.string_length + = build_int_cst (gfc_charlen_type_node, + 0); + } + else + parmse.expr = fold_convert (gfc_sym_type (fsym), + integer_zero_node); vec_safe_push (optionalargs, boolean_false_node); } else diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index 42907becd27..196f2cecbfc 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -3225,15 +3225,15 @@ gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args, vec_safe_push (hidden_typelist, type); } - /* For noncharacter scalar intrinsic types, VALUE passes the value, + /* For scalar intrinsic types, VALUE passes the value, hence, the optional status cannot be transferred via a NULL pointer. Thus, we will use a hidden argument in that case. */ - else if (arg - && arg->attr.optional - && arg->attr.value - && !arg->attr.dimension - && arg->ts.type != BT_CLASS - && !gfc_bt_struct (arg->ts.type)) + if (arg + && arg->attr.optional + && arg->attr.value + && !arg->attr.dimension + && arg->ts.type != BT_CLASS + && !gfc_bt_struct (arg->ts.type)) vec_safe_push (typelist, boolean_type_node); /* Coarrays which are descriptorless or assumed-shape pass with -fcoarray=lib the token and the offset as hidden arguments. */ diff --git a/gcc/testsuite/gfortran.dg/optional_absent_7.f90 b/gcc/testsuite/gfortran.dg/optional_absent_7.f90 index 1be981c88f6..163d0b67cb6 100644 --- a/gcc/testsuite/gfortran.dg/optional_absent_7.f90 +++ b/gcc/testsuite/gfortran.dg/optional_absent_7.f90 @@ -27,5 +27,5 @@ contains end subroutine s end program p -! { dg-final { scan-tree-dump "void s .* c, .* o, logical.* _o, integer.* _c" "original" } } +! { dg-final { scan-tree-dump "void s .* c, .* o, logical.* \.o, integer.* _c" "original" } } ! { dg-final { scan-tree-dump ", integer.*, logical.*, integer.* pp" "original" } } diff --git a/gcc/testsuite/gfortran.dg/optional_absent_8.f90 b/gcc/testsuite/gfortran.dg/optional_absent_8.f90 new file mode 100644 index 00000000000..e3c04451f3b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/optional_absent_8.f90 @@ -0,0 +1,53 @@ +! { dg-do run } +! PR fortran/107444 +! +! Check that procedures with optional arguments that have the value attribute +! work for intrinsic types including character, and that the presence check +! works. +! +! Co-contributed by M.Morin + +program p + implicit none + interface + subroutine i(c, o) + character(*) :: c + character(3), optional, value :: o + end subroutine i + end interface + procedure(i), pointer :: pp + call s([.false.,.false.,.false.], 0) + call s([.true., .false.,.false.], 10, i=7) + call s([.false.,.true. ,.false.], 20, c='abc') + call s([.false.,.false.,.true. ], 30, r=3.0) + pp => f + call pp ("abcd", "xyz") +contains + subroutine s (expect,code,i,c,r) + logical, intent(in) :: expect(:) + integer, intent(in) :: code + integer , value, optional :: i + character(3), value, optional :: c + real , value, optional :: r + if (expect(1) .neqv. present (i)) stop 1+code + if (expect(2) .neqv. present (c)) stop 2+code + if (expect(3) .neqv. present (r)) stop 3+code + if (present (i)) then + if (i /= 7) stop 4+code + end if + if (present (c)) then + if (c /= "abc") stop 5+code + end if + if (present (r)) then + if (r /= 3.0) stop 6+code + end if + end subroutine s + subroutine f (c, o) + character(*) :: c + character(3), optional, value :: o + if (c /= "abcd") stop 41 + if (len (c) /= 4) stop 42 + if (.not. present (o)) stop 43 + if (o /= "xyz") stop 44 + end subroutine f +end
reply other threads:[~2022-11-12 20:18 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=20221112201803.683473858407@sourceware.org \ --to=anlauf@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).