From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.15.19]) by sourceware.org (Postfix) with ESMTPS id 50E933858D28; Thu, 10 Nov 2022 21:56:50 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 50E933858D28 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1668117408; bh=AsYTvhsS6CxmD4Oa/+pRF30JflU1tA2Ba2/0k2ZhdHM=; h=X-UI-Sender-Class:From:To:Subject:Date; b=RKWSUNcDxA7iWgQb6LzdztgYFNrfX3xlalgTmRdTaeEVrsqgm8t3o1pqOaFpMsUGl 6997B0nzw8yBD9aovg13+JC/iYGlDdEeTheKj5RUmcsGDZ9SD3f0Wi9btoS3BGjk4s 6SFQs4Vqa9jtcyOBYo24exF9/h9v6l4RpTWMOjvvNmCgjOWO/ioUBIdk7Q9pJBcmlR tljjhAaxtnsGv767vJkhn9atIBNPA9H3lkIrvDsI9Z6Z37SO6UkJRqAKbIQtypnRlN Sdaq93QEN0/rzOx+2Ui+WPpLYvmcE83r3ebI+FihpXmHgm5vWtYQeTfvUk2xOnlu7n OQKexwm7hRTxA== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [93.207.83.193] ([93.207.83.193]) by web-mail.gmx.net (3c-app-gmx-bs59.server.lan [172.19.170.143]) (via HTTP); Thu, 10 Nov 2022 22:56:48 +0100 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: fix treatment of character, value, optional dummy arguments [PR107444] Content-Type: multipart/mixed; boundary=abmob-72efb533-892c-4610-8033-a0dc0e4bc49c Date: Thu, 10 Nov 2022 22:56:48 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:vF8RyQqjsL8l0gD8G0Vo5dXXMKMVd1EOiws1ncphEO7Jjjc2BwevMq7t7t3VIBwFOyc/j 88P+qK1lN66rGNubWb4z1rFG/9YVWTwRkU40aE0wJ/6qCy77l4BxpRLdvLIRRwFrgduYe80K5e1y u72bau62b4jRH+LmnFnimmYHBQrrgIb7CnRnRAjUr6bO8lb4cO+u+mz6aVzNTZcNpmxcw6XPTOi+ TApukdrfBD6a6CFj9s5h0sU9YQr/c80KTzyf94rmJVCNZr/ZcOJXJsDl1/kBnzrHSI+T2DNO+kXS 4M= UI-OutboundReport: notjunk:1;M01:P0:MV2DsiiYncA=;RQF/3lr+SKmueqMbA1AM/9pmrfQ sqgKxJwTmPMxEVJ5Icbtva0H63bBB/jSijIwanvOLj6EGVxXlCuHyvroPVQzjNFueRsnN5CeQ Z+hqdjZIRromtFFiUlMd2h/pLfAHDe/4+WcLy7BESzuKoubzdmbN+uJJ92cKhcvK8rfjAQSxn s481xJ4xm5RD8jg0TfJq1CsJpC/LV/AByAWvugyfXfbgQ26VOjXO42iyFQdbLfRcV/Ib4m78J YfWnZwPTYa2fdOR67x4W9sQuiRD74e0ts7X0xGXa/AriHo5UwKo2t1AwCyFyz+9aNbfvOroCc Lqfv+lhDGBn4ovshEh23DUEGdaUJX5BtwT+mfpLDgVu5z8BNw9r0hTzYM7D3blDe0Y8VLT9fQ nz1QwdOBkVmFcM5VC14nh62TJ33tUAY/LaKdRpz+rWLGLtrPxbFZi5wFczBZwsiMiPFkizn7p hSR/w9PBTsjsoDGXj8oI0aHvc4rXYo96nDzrhBc2U9QgIUn7zK/t2YoyDXakNlEYfnpurKu1C 3c6cAxq/Ud7Aa4XEASBMbsWOTMN2doOthdjDZd6YUcNyDaLk9dqtz2CZoGpvDaDivoklYNwnQ YPQljhmxyBKKFRhcQ3ZQEb2S4MrVYMb9GYZF1sFx0nVWOmQ0iHq5r/PPv+tOtyNuckCzShlJ4 guF6FxnvnVwqPjdxJNJBaMrz4KSt74iboWru3NtC51u7IWbpaslt+y+vxLgjc5btEMWn3OM+Q vl3ytTSRJKr2ZrP2IktfUPfMedEa3dDSLfarYJcO8hhAftiBIfCamYNVT43jfcAxFcqZzXz9h MdyDSZsV4Go4WbR+OTjiCy+fr13Ed3nT/ctoOyGyFy7r0= X-Spam-Status: No, score=-13.4 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,FREEMAIL_FROM,GIT_PATCH_0,RCVD_IN_DNSWL_LOW,RCVD_IN_MSPIKE_H2,SPF_HELO_NONE,SPF_PASS,TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: --abmob-72efb533-892c-4610-8033-a0dc0e4bc49c Content-Type: text/plain; charset=UTF-8 Dear Fortranners, the attached patch is a follow-up to the fix for PR107441, as it finally fixes the treatment of character dummy arguments that have the value,optional attribute, and allows for checking of the presence of such arguments. This entails a small ABI clarification, as the previous text was not really clear on the argument passing conventions, and the previously generated code was inconsistent at best, or rather wrong, for this kind of procedure arguments. (E.g. the number of passed arguments was varying...) Testcase cross-checked with NAG 7.1. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald --abmob-72efb533-892c-4610-8033-a0dc0e4bc49c Content-Type: text/x-patch Content-Disposition: attachment; filename=pr107444.diff Content-Transfer-Encoding: quoted-printable =46rom d87e299dd2b7f4be6ca829e80cd94babc53fa12f Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Thu, 10 Nov 2022 22:30:27 +0100 Subject: [PATCH] Fortran: fix treatment of character, value, optional dumm= y 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. =2D-- ...aming-and-argument-passing-conventions.rst | 3 +- gcc/fortran/trans-decl.cc | 10 ++-- gcc/fortran/trans-expr.cc | 25 ++++++--- gcc/fortran/trans-types.cc | 14 ++--- .../gfortran.dg/optional_absent_7.f90 | 2 +- .../gfortran.dg/optional_absent_8.f90 | 53 +++++++++++++++++++ 6 files changed, 84 insertions(+), 23 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/optional_absent_8.f90 diff --git a/gcc/fortran/doc/gfortran/naming-and-argument-passing-conventi= ons.rst b/gcc/fortran/doc/gfortran/naming-and-argument-passing-conventions= .rst index 4baaee9bfec..fa999fac355 100644 =2D-- a/gcc/fortran/doc/gfortran/naming-and-argument-passing-conventions.r= st +++ b/gcc/fortran/doc/gfortran/naming-and-argument-passing-conventions.rst @@ -142,8 +142,7 @@ is used for dummy arguments; with ``VALUE``, those var= iables 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=3DC_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 =2D-- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -2708,16 +2708,16 @@ create_function_arglist (gfc_symbol * sym) type =3D 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 !=3D 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 !=3D BT_CLASS + && !gfc_bt_struct (f->sym->ts.type)) { tree tmp; strcpy (&name[1], f->sym->name); - name[0] =3D '_'; + name[0] =3D '.'; tmp =3D 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 =2D-- 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 !=3D BT_CHARACTER - && sym->ts.type !=3D BT_CLASS && sym->ts.type !=3D BT_DERIVED - && !sym->attr.dimension) + if (sym->attr.value && !sym->attr.dimension + && sym->ts.type !=3D BT_CLASS && !gfc_bt_struct (sym->ts.type)) { char name[GFC_MAX_SYMBOL_LEN + 2]; tree tree_name; gcc_assert (TREE_CODE (decl) =3D=3D PARM_DECL); - name[0] =3D '_'; + name[0] =3D '.'; strcpy (&name[1], sym->name); tree_name =3D 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 !=3D BT_CHARACTER - && fsym->ts.type !=3D BT_CLASS && fsym->ts.type !=3D BT_DERIVED) + && !fsym->attr.dimension && fsym->ts.type !=3D BT_CLASS + && !gfc_bt_struct (sym->ts.type)) { - parmse.expr =3D fold_convert (gfc_sym_type (fsym), - integer_zero_node); + if (fsym->ts.type =3D=3D BT_CHARACTER) + { + /* Pass a NULL pointer for an absent CHARACTER arg + and a length of zero. */ + parmse.expr =3D null_pointer_node; + parmse.string_length + =3D build_int_cst (gfc_charlen_type_node, + 0); + } + else + parmse.expr =3D 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 =2D-- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -3225,15 +3225,15 @@ gfc_get_function_type (gfc_symbol * sym, gfc_actua= l_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 !=3D BT_CLASS - && !gfc_bt_struct (arg->ts.type)) + if (arg + && arg->attr.optional + && arg->attr.value + && !arg->attr.dimension + && arg->ts.type !=3D 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=3Dlib the token and the offset as hidden arguments. */ diff --git a/gcc/testsuite/gfortran.dg/optional_absent_7.f90 b/gcc/testsui= te/gfortran.dg/optional_absent_7.f90 index 1be981c88f6..163d0b67cb6 100644 =2D-- 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" "ori= ginal" } } diff --git a/gcc/testsuite/gfortran.dg/optional_absent_8.f90 b/gcc/testsui= te/gfortran.dg/optional_absent_8.f90 new file mode 100644 index 00000000000..e3c04451f3b =2D-- /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 attri= bute +! work for intrinsic types including character, and that the presence che= ck +! 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=3D7) + call s([.false.,.true. ,.false.], 20, c=3D'abc') + call s([.false.,.false.,.true. ], 30, r=3D3.0) + pp =3D> 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 /=3D 7) stop 4+code + end if + if (present (c)) then + if (c /=3D "abc") stop 5+code + end if + if (present (r)) then + if (r /=3D 3.0) stop 6+code + end if + end subroutine s + subroutine f (c, o) + character(*) :: c + character(3), optional, value :: o + if (c /=3D "abcd") stop 41 + if (len (c) /=3D 4) stop 42 + if (.not. present (o)) stop 43 + if (o /=3D "xyz") stop 44 + end subroutine f +end =2D- 2.35.3 --abmob-72efb533-892c-4610-8033-a0dc0e4bc49c--