Dear all,
this patch addresses a long-standing difference between gfortran and
other brands: when an array actual argument was passed to a procedure,
and the dummy argument had no intent specified, we would often create
packing and unpacking code. Only the case of the dummy argument
having intent(in) did avoid the unpacking.
This resulted in the user experience that passing an array having the
PARAMETER attribute, i.e. a named constant that gcc could place in
read-only memory, was generating a segfault at runtime even if the
dummy argument was not modified in the invoked procedure. It therefore
was often not possible passing such an argument to a procedure without
explicitly requiring a temporary that might not be needed. (*)
Other brands tested do not crash:
(1) Intel, Nvidia, AMD flang, g95 seem to not put PARAMETER into read-only
memory. One can write code by lying to the compiler and modify the
array values.
(2) NAG appears to prevent modification of variables with the PARAMETER
attribute. Code that lies to the compiler seems to have no effect,
but that compiler has a checking option that detects an illegal
assignment in the called procedure.
The proposal is to simply not generate the unpacking / copying-back code
if the actual argument has the PARAMETER attribute. Non-conforming code
should rather be either detected at compile-time (which we do to a
reasonable extent), or we might add (in the future) new checking code
that detects modification of the dummy similar to case (2) above.
(We do something like this e.g. for do-loop indices passed as actual
arguments).
How do you think of this approach?
BTW: attached patch regtests fine on x86_64-pc-linux-gnu. ON for mainline?
Thanks,
Harald
(*) There is a missed-optimization in that we do not simply create
suitable array descriptors when passing to assumed-shape dummies,
which may avoid the packing.
From 387177dbeed5a2c6563d3c2275fee8a4d756d7a5 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Sun, 19 Jan 2025 21:06:56 +0100
Subject: [PATCH] Fortran: do not copy back for parameter actual arguments
[PR81978]
When an array is packed for passing as an actual argument, and the array
has the PARAMETER attribute (i.e., it is a named constant that can reside
in read-only memory), do not copy back (unpack) from the temporary.
PR fortran/81978
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_conv_array_parameter): Do not copy back data
if actual array parameter has the PARAMETER attribute.
* trans-expr.cc (gfc_conv_subref_array_arg): Likewise.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr81978.f90: New test.
---
gcc/fortran/trans-array.cc | 10 ++-
gcc/fortran/trans-expr.cc | 11 ++-
gcc/testsuite/gfortran.dg/pr81978.f90 | 107 ++++++++++++++++++++++++++
3 files changed, 124 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr81978.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 44b091af2c6..ec627dddffd 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8925,6 +8925,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77,
bool good_allocatable;
bool ultimate_ptr_comp;
bool ultimate_alloc_comp;
+ bool readonly;
gfc_symbol *sym;
stmtblock_t block;
gfc_ref *ref;
@@ -9381,8 +9382,13 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77,
gfc_start_block (&block);
- /* Copy the data back. */
- if (fsym == NULL || fsym->attr.intent != INTENT_IN)
+ /* Copy the data back. If input expr is read-only, e.g. a PARAMETER
+ array, copying back modified values is undefined behavior. */
+ readonly = (expr->expr_type == EXPR_VARIABLE
+ && expr->symtree
+ && expr->symtree->n.sym->attr.flavor == FL_PARAMETER);
+
+ if ((fsym == NULL || fsym->attr.intent != INTENT_IN) && !readonly)
{
if (ctree)
{
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index bef49d32a58..dcf42d53175 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5200,6 +5200,7 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr, int g77,
gfc_se work_se;
gfc_se *parmse;
bool pass_optional;
+ bool readonly;
pass_optional = fsym && fsym->attr.optional && sym && sym->attr.optional;
@@ -5416,8 +5417,14 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr, int g77,
/* Wrap the whole thing up by adding the second loop to the post-block
and following it by the post-block of the first loop. In this way,
- if the temporary needs freeing, it is done after use! */
- if (intent != INTENT_IN)
+ if the temporary needs freeing, it is done after use!
+ If input expr is read-only, e.g. a PARAMETER array, copying back
+ modified values is undefined behavior. */
+ readonly = (expr->expr_type == EXPR_VARIABLE
+ && expr->symtree
+ && expr->symtree->n.sym->attr.flavor == FL_PARAMETER);
+
+ if ((intent != INTENT_IN) && !readonly)
{
gfc_add_block_to_block (&parmse->post, &loop2.pre);
gfc_add_block_to_block (&parmse->post, &loop2.post);
diff --git a/gcc/testsuite/gfortran.dg/pr81978.f90 b/gcc/testsuite/gfortran.dg/pr81978.f90
new file mode 100644
index 00000000000..b377eef7a16
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr81978.f90
@@ -0,0 +1,107 @@
+! { dg-do run }
+! PR fortran/81978 - do not copy back for parameter actual arguments
+
+module test_mod
+ implicit none
+
+ type pp_struct
+ character(10) :: name
+ real :: value
+ end type pp_struct
+
+ type(pp_struct), parameter :: pp(4) = [ &
+ pp_struct('one', 1.), &
+ pp_struct('two', 2.), &
+ pp_struct('three', 3.), &
+ pp_struct('four', 4.) ]
+
+contains
+
+ subroutine match_word (names)
+ character(*) :: names(:)
+ end subroutine match_word
+
+ subroutine sub0 (a)
+ real :: a(:)
+ end
+
+ subroutine sub1 (a, n)
+ integer, intent(in) :: n
+ real :: a(n)
+ end
+
+ subroutine subx (a)
+ real :: a(..)
+ end
+end module
+
+program test
+ use test_mod
+ implicit none
+ integer :: i, n
+ integer, parameter :: m = 8
+ real, parameter :: x(m) = [(i,i=1,m)]
+
+ n = size (x)
+ call sub0 (x)
+ call sub1 (x, n)
+ call sub2 (x, n)
+ call subx (x)
+
+ i = 1
+ call sub0 (x(1::i))
+ call sub1 (x(1::i), n)
+ call sub2 (x(1::i), n)
+ call subx (x(1::i))
+
+ n = size (x(1::2))
+ call sub0 (x(1::2))
+ call sub1 (x(1::2), n)
+ call sub2 (x(1::2), n)
+ call subx (x(1::2))
+
+ i = 2
+ call sub0 (x(1::i))
+ call sub1 (x(1::i), n)
+ call sub2 (x(1::i), n)
+ call subx (x(1::i))
+
+ call match_word (pp%name)
+ call sub0 (pp%value)
+ call subx (pp%value)
+ call match_word (pp(1::2)%name)
+ call sub0 (pp(1::2)%value)
+ call subx (pp(1::2)%value)
+ i = 1
+ call match_word (pp(1::i)%name)
+ call sub0 (pp(1::i)%value)
+ call subx (pp(1::i)%value)
+ i = 2
+ call match_word (pp(1::i)%name)
+ call sub0 (pp(1::i)%value)
+ call subx (pp(1::i)%value)
+
+ call foo (pp%name, size(pp%name))
+ call foo (pp(1::2)%name, size(pp(1::2)%name))
+ call sub1 (pp(1::2)%value, size(pp(1::2)%value))
+ call sub2 (pp(1::2)%value, size(pp(1::2)%value))
+ i = 1
+ call foo (pp(1::i)%name, size(pp(1::i)%name))
+ call sub1 (pp(1::i)%value, size(pp(1::i)%value))
+ call sub2 (pp(1::i)%value, size(pp(1::i)%value))
+ i = 2
+ call foo (pp(1::i)%name, size(pp(1::i)%name))
+ call sub1 (pp(1::i)%value, size(pp(1::i)%value))
+ call sub2 (pp(1::i)%value, size(pp(1::i)%value))
+end program
+
+subroutine sub2 (a, n)
+ integer, intent(in) :: n
+ real :: a(n)
+end
+
+subroutine foo (s, n)
+ integer, intent(in) :: n
+ character(*) :: s(*)
+! print *, len(s), n, s(n)
+end
--
2.43.0
