From: Harald Anlauf <anlauf@gmx.de>
To: fortran <fortran@gcc.gnu.org>, gcc-patches <gcc-patches@gcc.gnu.org>
Subject: [PATCH] Fortran: passing of optional scalar arguments with VALUE attribute [PR113377]
Date: Sat, 20 Jan 2024 22:58:49 +0100 [thread overview]
Message-ID: <trinity-7003a662-7e08-4df2-a685-bb3e793e3167-1705787929716@3c-app-gmx-bs19> (raw)
[-- Attachment #1: Type: text/plain, Size: 717 bytes --]
Dear all,
here's the first part of an attempt to fix issues with optional
dummy arguments as actual arguments to optional dummies. This patch
rectifies the case of scalar dummies with the VALUE attribute,
which in gfortran's argument passing convention are passed on the
stack when they are of intrinsic type, and have a hidden variable
for the presence status.
The testcase tries to cover valid combinations of actual and dummy
argument. A few tests that are not standard-conforming but would
still work with gfortran (due to the argument passing convention)
are left there but commented out with a pointer to the standard
(thanks, Mikael!).
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr113377-part1.diff --]
[-- Type: text/x-patch, Size: 12000 bytes --]
From f6a65138391c902d2782973665059d7d059a50d1 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sat, 20 Jan 2024 22:18:02 +0100
Subject: [PATCH] Fortran: passing of optional scalar arguments with VALUE
attribute [PR113377]
gcc/fortran/ChangeLog:
PR fortran/113377
* trans-expr.cc (gfc_conv_procedure_call): Fix handling of optional
scalar arguments of intrinsic type with the VALUE attribute.
gcc/testsuite/ChangeLog:
PR fortran/113377
* gfortran.dg/optional_absent_9.f90: New test.
---
gcc/fortran/trans-expr.cc | 5 +
.../gfortran.dg/optional_absent_9.f90 | 324 ++++++++++++++++++
2 files changed, 329 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/optional_absent_9.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 9dd1f4086f4..2f47a75955c 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6526,6 +6526,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_init_se (&argse, NULL);
argse.want_pointer = 1;
gfc_conv_expr (&argse, e);
+ if (e->symtree->n.sym->attr.dummy
+ && POINTER_TYPE_P (TREE_TYPE (argse.expr)))
+ argse.expr = gfc_build_addr_expr (NULL_TREE,
+ argse.expr);
cond = fold_convert (TREE_TYPE (argse.expr),
null_pointer_node);
cond = fold_build2_loc (input_location, NE_EXPR,
@@ -7256,6 +7260,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& e->symtree->n.sym->attr.optional
&& (((e->rank != 0 && elemental_proc)
|| e->representation.length || e->ts.type == BT_CHARACTER
+ || (e->rank == 0 && e->symtree->n.sym->attr.value)
|| (e->rank != 0
&& (fsym == NULL
|| (fsym->as
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_9.f90 b/gcc/testsuite/gfortran.dg/optional_absent_9.f90
new file mode 100644
index 00000000000..495a6c00d7f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_9.f90
@@ -0,0 +1,324 @@
+! { dg-do run }
+! PR fortran/113377
+!
+! Test passing of missing optional scalar dummies of intrinsic type
+
+module m_int
+ implicit none
+contains
+ subroutine test_int ()
+ integer :: k = 1
+ call one (k)
+ call one_val (k)
+ call one_all (k)
+ call one_ptr (k)
+ end
+
+ subroutine one (i, j)
+ integer, intent(in) :: i
+ integer ,optional :: j
+ integer, allocatable :: aa
+ integer, pointer :: pp => NULL()
+ if (present (j)) error stop "j is present"
+ call two (i, j)
+ call two_val (i, j)
+ call two (i, aa)
+ call two (i, pp)
+ end
+
+ subroutine one_val (i, j)
+ integer, intent(in) :: i
+ integer, value, optional :: j
+ if (present (j)) error stop "j is present"
+ call two (i, j)
+ call two_val (i, j)
+ end
+
+ subroutine one_all (i, j)
+ integer, intent(in) :: i
+ integer, allocatable,optional :: j
+ if (present (j)) error stop "j is present"
+! call two (i, j) ! invalid per F2018:15.5.2.12, par. 3, clause 8
+! call two_val (i, j) ! invalid (*) F2018:15.5.2.12, par. 3, clause 8
+ call two_all (i, j)
+ end
+! (*) gfortran argument passing conventions ("scalar dummy arguments of type
+! INTEGER, LOGICAL, REAL, COMPLEX, and CHARACTER(len=1) with VALUE attribute
+! pass the presence status separately") may still allow this case pass
+
+ subroutine one_ptr (i, j)
+ integer, intent(in) :: i
+ integer, pointer ,optional :: j
+ if (present (j)) error stop "j is present"
+! call two (i, j) ! invalid per F2018:15.5.2.12, par. 3, clause 7
+! call two_val (i, j) ! invalid (*) F2018:15.5.2.12, par. 3, clause 7
+ call two_ptr (i, j)
+ end
+
+ subroutine two (i, j)
+ integer, intent(in) :: i
+ integer, intent(in), optional :: j
+ if (present (j)) error stop 11
+ end
+
+ subroutine two_val (i, j)
+ integer, intent(in) :: i
+ integer, value, optional :: j
+ if (present (j)) error stop 12
+ end
+
+ subroutine two_all (i, j)
+ integer, intent(in) :: i
+ integer, allocatable,optional :: j
+ if (present (j)) error stop 13
+ end
+
+ subroutine two_ptr (i, j)
+ integer, intent(in) :: i
+ integer, pointer, optional :: j
+ if (present (j)) error stop 14
+ end
+end
+
+module m_char
+ implicit none
+contains
+ subroutine test_char ()
+ character :: k = "#"
+ call one (k)
+ call one_val (k)
+ call one_all (k)
+ call one_ptr (k)
+ end
+
+ subroutine one (i, j)
+ character, intent(in) :: i
+ character ,optional :: j
+ character, allocatable :: aa
+ character, pointer :: pp => NULL()
+ if (present (j)) error stop "j is present"
+ call two (i, j)
+ call two_val (i, j)
+ call two (i, aa)
+ call two (i, pp)
+ end
+
+ subroutine one_val (i, j)
+ character, intent(in) :: i
+ character, value, optional :: j
+ if (present (j)) error stop "j is present"
+ call two (i, j)
+ call two_val (i, j)
+ end
+
+ subroutine one_all (i, j)
+ character, intent(in) :: i
+ character, allocatable,optional :: j
+ if (present (j)) error stop "j is present"
+! call two (i, j) ! invalid per F2018:15.5.2.12, par. 3, clause 8
+! call two_val (i, j) ! invalid (*) F2018:15.5.2.12, par. 3, clause 8
+ call two_all (i, j)
+ end
+! (*) gfortran argument passing conventions ("scalar dummy arguments of type
+! INTEGER, LOGICAL, REAL, COMPLEX, and CHARACTER(len=1) with VALUE attribute
+! pass the presence status separately") may still allow this case pass
+
+ subroutine one_ptr (i, j)
+ character, intent(in) :: i
+ character, pointer ,optional :: j
+ if (present (j)) error stop "j is present"
+! call two (i, j) ! invalid per F2018:15.5.2.12, par. 3, clause 7
+! call two_val (i, j) ! invalid (*) F2018:15.5.2.12, par. 3, clause 7
+ call two_ptr (i, j)
+ end
+
+ subroutine two (i, j)
+ character, intent(in) :: i
+ character, intent(in), optional :: j
+ if (present (j)) error stop 21
+ end
+
+ subroutine two_val (i, j)
+ character, intent(in) :: i
+ character, value, optional :: j
+ if (present (j)) error stop 22
+ end
+
+ subroutine two_all (i, j)
+ character, intent(in) :: i
+ character, allocatable,optional :: j
+ if (present (j)) error stop 23
+ end
+
+ subroutine two_ptr (i, j)
+ character, intent(in) :: i
+ character, pointer, optional :: j
+ if (present (j)) error stop 24
+ end
+end
+
+module m_char4
+ implicit none
+contains
+ subroutine test_char4 ()
+ character(kind=4) :: k = 4_"#"
+ call one (k)
+ call one_val (k)
+ call one_all (k)
+ call one_ptr (k)
+ end
+
+ subroutine one (i, j)
+ character(kind=4), intent(in) :: i
+ character(kind=4) ,optional :: j
+ character(kind=4), allocatable :: aa
+ character(kind=4), pointer :: pp => NULL()
+ if (present (j)) error stop "j is present"
+ call two (i, j)
+ call two_val (i, j)
+ call two (i, aa)
+ call two (i, pp)
+ end
+
+ subroutine one_val (i, j)
+ character(kind=4), intent(in) :: i
+ character(kind=4), value, optional :: j
+ if (present (j)) error stop "j is present"
+ call two (i, j)
+ call two_val (i, j)
+ end
+
+ subroutine one_all (i, j)
+ character(kind=4), intent(in) :: i
+ character(kind=4), allocatable,optional :: j
+ if (present (j)) error stop "j is present"
+! call two (i, j) ! invalid per F2018:15.5.2.12, par. 3, clause 8
+! call two_val (i, j) ! invalid (*) F2018:15.5.2.12, par. 3, clause 8
+ call two_all (i, j)
+ end
+! (*) gfortran argument passing conventions ("scalar dummy arguments of type
+! INTEGER, LOGICAL, REAL, COMPLEX, and CHARACTER(KIND=4)(len=1) with VALUE attribute
+! pass the presence status separately") may still allow this case pass
+
+ subroutine one_ptr (i, j)
+ character(kind=4), intent(in) :: i
+ character(kind=4), pointer ,optional :: j
+ if (present (j)) error stop "j is present"
+! call two (i, j) ! invalid per F2018:15.5.2.12, par. 3, clause 7
+! call two_val (i, j) ! invalid (*) F2018:15.5.2.12, par. 3, clause 7
+ call two_ptr (i, j)
+ end
+
+ subroutine two (i, j)
+ character(kind=4), intent(in) :: i
+ character(kind=4), intent(in), optional :: j
+ if (present (j)) error stop 31
+ end
+
+ subroutine two_val (i, j)
+ character(kind=4), intent(in) :: i
+ character(kind=4), value, optional :: j
+ if (present (j)) error stop 32
+ end
+
+ subroutine two_all (i, j)
+ character(kind=4), intent(in) :: i
+ character(kind=4), allocatable,optional :: j
+ if (present (j)) error stop 33
+ end
+
+ subroutine two_ptr (i, j)
+ character(kind=4), intent(in) :: i
+ character(kind=4), pointer, optional :: j
+ if (present (j)) error stop 34
+ end
+end
+
+module m_complex
+ implicit none
+contains
+ subroutine test_complex ()
+ complex :: k = 3.
+ call one (k)
+ call one_val (k)
+ call one_all (k)
+ call one_ptr (k)
+ end
+
+ subroutine one (i, j)
+ complex, intent(in) :: i
+ complex ,optional :: j
+ complex, allocatable :: aa
+ complex, pointer :: pp => NULL()
+ if (present (j)) error stop "j is present"
+ call two (i, j)
+ call two_val (i, j)
+ call two (i, aa)
+ call two (i, pp)
+ end
+
+ subroutine one_val (i, j)
+ complex, intent(in) :: i
+ complex, value, optional :: j
+ if (present (j)) error stop "j is present"
+ call two (i, j)
+ call two_val (i, j)
+ end
+
+ subroutine one_all (i, j)
+ complex, intent(in) :: i
+ complex, allocatable,optional :: j
+ if (present (j)) error stop "j is present"
+! call two (i, j) ! invalid per F2018:15.5.2.12, par. 3, clause 8
+! call two_val (i, j) ! invalid (*) F2018:15.5.2.12, par. 3, clause 8
+ call two_all (i, j)
+ end
+! (*) gfortran argument passing conventions ("scalar dummy arguments of type
+! COMPLEX, LOGICAL, REAL, COMPLEX, and CHARACTER(len=1) with VALUE attribute
+! pass the presence status separately") may still allow this case pass
+
+ subroutine one_ptr (i, j)
+ complex, intent(in) :: i
+ complex, pointer ,optional :: j
+ if (present (j)) error stop "j is present"
+! call two (i, j) ! invalid per F2018:15.5.2.12, par. 3, clause 7
+! call two_val (i, j) ! invalid (*) F2018:15.5.2.12, par. 3, clause 7
+ call two_ptr (i, j)
+ end
+
+ subroutine two (i, j)
+ complex, intent(in) :: i
+ complex, intent(in), optional :: j
+ if (present (j)) error stop 41
+ end
+
+ subroutine two_val (i, j)
+ complex, intent(in) :: i
+ complex, value, optional :: j
+ if (present (j)) error stop 42
+ end
+
+ subroutine two_all (i, j)
+ complex, intent(in) :: i
+ complex, allocatable,optional :: j
+ if (present (j)) error stop 43
+ end
+
+ subroutine two_ptr (i, j)
+ complex, intent(in) :: i
+ complex, pointer, optional :: j
+ if (present (j)) error stop 44
+ end
+end
+
+program p
+ use m_int
+ use m_char
+ use m_char4
+ use m_complex
+ implicit none
+ call test_int ()
+ call test_char ()
+ call test_char4 ()
+ call test_complex ()
+end
--
2.35.3
next reply other threads:[~2024-01-20 21:58 UTC|newest]
Thread overview: 3+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-01-20 21:58 Harald Anlauf [this message]
2024-01-21 10:50 ` Mikael Morin
2024-01-21 20:41 ` Harald Anlauf
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=trinity-7003a662-7e08-4df2-a685-bb3e793e3167-1705787929716@3c-app-gmx-bs19 \
--to=anlauf@gmx.de \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@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: link
Be 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).