* [PATCH] Fortran: fix argument passing to CONTIGUOUS,TARGET dummy [PR97592]
@ 2023-12-16 18:28 Harald Anlauf
2023-12-17 16:08 ` Paul Richard Thomas
0 siblings, 1 reply; 2+ messages in thread
From: Harald Anlauf @ 2023-12-16 18:28 UTC (permalink / raw)
To: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 828 bytes --]
Dear all,
the attached simple patch fixes a (9+) regression for passing
to a CONTIGUOUS,TARGET dummy an *effective argument* that is
contiguous, although the actual argument is not simply-contiguous
(it is a pointer without the CONTIGOUS attribute in the PR).
Since a previous attempt for a patch lead to regressions in
gfortran.dg/bind-c-contiguous-3.f90, which is rather dense,
I decided to enhance the current testcase with various
combinations of actual and dummy arguments that allow to
study whether a _gfortran_internal_pack is generated in
places where we want to. (_gfortran_internal_pack does not
create a temporary when no packing is needed).
Regtested on x86_64-pc-linux-gnu. OK for mainline?
I would like to backport this - after a grace period - to
at least 13-branch. Any objections here?
Thanks,
Harald
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr97592.diff --]
[-- Type: text/x-patch, Size: 8573 bytes --]
From d8765bd669e501781672c0bec976b2f5fd7acff6 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sat, 16 Dec 2023 19:14:55 +0100
Subject: [PATCH] Fortran: fix argument passing to CONTIGUOUS,TARGET dummy
[PR97592]
gcc/fortran/ChangeLog:
PR fortran/97592
* trans-expr.cc (gfc_conv_procedure_call): For a contiguous dummy
with the TARGET attribute, the effective argument may still be
contiguous even if the actual argument is not simply-contiguous.
Allow packing to be decided at runtime by _gfortran_internal_pack.
gcc/testsuite/ChangeLog:
PR fortran/97592
* gfortran.dg/contiguous_15.f90: New test.
---
gcc/fortran/trans-expr.cc | 4 +-
gcc/testsuite/gfortran.dg/contiguous_15.f90 | 234 ++++++++++++++++++++
2 files changed, 237 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/contiguous_15.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index f4185db5b7f..218fede6a82 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7124,7 +7124,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
INTENT_IN, fsym->attr.pointer);
}
else if (fsym && fsym->attr.contiguous
- && !gfc_is_simply_contiguous (e, false, true)
+ && (fsym->attr.target
+ ? gfc_is_not_contiguous (e)
+ : !gfc_is_simply_contiguous (e, false, true))
&& gfc_expr_is_variable (e))
{
gfc_conv_subref_array_arg (&parmse, e, nodesc_arg,
diff --git a/gcc/testsuite/gfortran.dg/contiguous_15.f90 b/gcc/testsuite/gfortran.dg/contiguous_15.f90
new file mode 100644
index 00000000000..424eb080fd1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contiguous_15.f90
@@ -0,0 +1,234 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/97592 - fix argument passing to CONTIGUOUS,TARGET dummy
+!
+! { dg-final { scan-tree-dump-times "_gfortran_internal_pack \\(&b_2d" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_internal_pack \\(&p1" 3 "original" } }
+!
+! N.B.: there is no reliable count of _gfortran_internal_pack on temporaries parm.*
+
+program pr97592
+ implicit none
+ integer :: i, k
+ integer, target :: a(10)
+ integer, pointer :: p1(:), p2(:), tgt(:), expect(:)
+ integer, pointer, contiguous :: cp(:)
+ integer, allocatable, target :: b(:)
+
+ !----------------------
+ ! Code from original PR
+ !----------------------
+ call RemappingTest ()
+
+ !---------------------
+ ! Additional 1-d tests
+ !---------------------
+ a = [(i, i=1,size(a))]
+ b = a
+
+ ! Set p1 to an actually contiguous pointer
+ p1(13:) => a(3::2)
+ print *, lbound (p1), ubound (p1), is_contiguous (p1)
+
+ ! non-contiguous pointer actual argument
+ expect => p1
+ call chk_cont (p1)
+
+ expect => p1
+ call chk_tgt_cont (p1)
+
+ expect => p1
+ call chk_ptr (p1, p2)
+ if (any (p2 /= p1)) stop 1
+
+ expect => p1
+ call chk_tgt (p1, p2)
+ if (any (p2 /= p1)) stop 2
+
+ ! non-contiguous target actual argument
+ expect => b(3::2)
+ call chk_tgt_cont (b(3::2))
+
+ expect => b(3::2)
+ call chk_tgt (b(3::2), p2)
+ if (any (p2 /= p1)) stop 3
+
+ expect => b(3::2)
+ call chk_ptr (b(3::2), p2)
+ if (any (p2 /= p1)) stop 4
+
+ ! Set p1 to an actually contiguous pointer
+ cp(17:) => a(3:9:1)
+ p1 => cp
+ print *, lbound (cp), ubound (cp), is_contiguous (cp)
+ print *, lbound (p1), ubound (p1), is_contiguous (p1)
+
+ expect => p1
+ call chk_tgt (p1, p2)
+ if (any (p2 /= cp)) stop 31
+
+ expect => cp
+ call chk_tgt (cp, p2)
+ if (any (p2 /= cp)) stop 32
+
+ expect => cp
+ call chk_tgt_cont (cp, p2)
+ if (any (p2 /= cp)) stop 33
+
+ expect => cp
+ call chk_tgt_expl (cp, p2, size (cp))
+ if (any (p2 /= cp)) stop 34
+
+ ! See F2018:15.5.2.4 and F2018:C.10.4
+ expect => p1
+ call chk_tgt_cont (p1, p2)
+! print *, p2
+ if (any (p2 /= cp)) stop 35
+
+ expect => p1
+ call chk_tgt_expl (p1, p2, size (p1))
+ if (any (p2 /= cp)) stop 36
+
+ expect => cp
+ call chk_ptr_cont (cp, p2)
+ if (any (p2 /= cp)) stop 37
+
+ ! Pass array section which is actually contigous
+ k = 1
+ expect => cp(::k)
+ call chk_ptr (cp(::k), p2)
+ if (any (p2 /= cp(::k))) stop 38
+
+ expect => p1(::k)
+ call chk_tgt_cont (p1(::k), p2)
+ if (any (p2 /= p1(::k))) stop 39
+
+ expect => p1(::k)
+ call chk_tgt (p1(::k), p2)
+ if (any (p2 /= p1(::k))) stop 40
+
+ expect => p1(::k)
+ call chk_tgt_expl (p1(::k), p2, size (p1(::k)))
+ if (any (p2 /= p1(::k))) stop 41
+
+ expect => b(3::k)
+ call chk_tgt_cont (b(3::k), p2)
+ if (any (p2 /= b(3::k))) stop 42
+
+ expect => b(3::k)
+ call chk_tgt (b(3::k), p2)
+ if (any (p2 /= b(3::k))) stop 43
+
+ expect => b(3::k)
+ call chk_tgt_expl (b(3::k), p2, size (b(3::k)))
+ if (any (p2 /= b(3::k))) stop 44
+
+ if (any (a /= [(i, i=1,size(a))])) stop 66
+ if (any (a /= b)) stop 77
+ deallocate (b)
+
+contains
+ ! Contiguous pointer dummy
+ subroutine chk_ptr_cont (x, y)
+ integer, contiguous, pointer, intent(in) :: x(:)
+ integer, pointer, optional :: y(:)
+ print *, lbound (x), ubound (x)
+ if (present (y)) y => x(:)
+ if (associated (expect)) then
+ if (size (x) /= size (expect)) stop 10
+ if (any (x /= expect)) stop 11
+ if (lbound(expect,1) /= 1 .and. &
+ lbound(expect,1) /= lbound (x,1)) stop 20
+ end if
+ end
+
+ ! Pointer dummy
+ subroutine chk_ptr (x, y)
+ integer, pointer, intent(in) :: x(:)
+ integer, pointer, optional :: y(:)
+ print *, lbound (x), ubound (x)
+ if (present (y)) y => x(:)
+ if (associated (expect)) then
+ if (size (x) /= size (expect)) stop 12
+ if (any (x /= expect)) stop 13
+ if (lbound(expect,1) /= 1 .and. &
+ lbound(expect,1) /= lbound (x,1)) stop 22
+ end if
+ end
+
+ ! Dummy with target attribute
+ subroutine chk_tgt_cont (x, y)
+ integer, contiguous, target, intent(in) :: x(:)
+ integer, pointer, optional :: y(:)
+ if (present (y)) y => x(:)
+ if (associated (expect)) then
+ if (size (x) /= size (expect)) stop 14
+ if (any (x /= expect)) stop 15
+ end if
+ end
+
+ subroutine chk_tgt (x, y)
+ integer, target, intent(in) :: x(:)
+ integer, pointer, optional :: y(:)
+ if (present (y)) y => x(:)
+ if (associated (expect)) then
+ if (size (x) /= size (expect)) stop 16
+ if (any (x /= expect)) stop 17
+ end if
+ end
+
+ ! Explicit-shape dummy with target attribute
+ subroutine chk_tgt_expl (x, y, n)
+ integer, intent(in) :: n
+ integer, target, intent(in) :: x(n)
+ integer, pointer, optional :: y(:)
+ if (present (y)) y => x(:)
+ if (associated (expect)) then
+ if (size (x) /= size (expect)) stop 18
+ if (any (x /= expect)) stop 19
+ end if
+ end
+
+ ! Dummy without pointer or target attribute
+ subroutine chk_cont (x)
+ integer, contiguous, intent(in) :: x(:)
+ if (associated (expect)) then
+ if (size (x) /= size (expect)) stop 23
+ if (any (x /= expect)) stop 24
+ end if
+ end
+
+ !------------------------------------------------------------------------
+
+ subroutine RemappingTest ()
+ real, pointer :: B_2D(:,:)
+ real, pointer :: B_3D(:,:,:) => NULL()
+ integer, parameter :: n1=4, n2=4, n3=3
+ !-- Prepare B_2D
+ allocate (B_2D(n1*n2, n3))
+ B_2D = - huge (1.0)
+ if (.not. is_contiguous (B_2D)) stop 101
+ !-- Point B_3D to Storage
+ call SetPointer (B_2D, n1, n2, n3, B_3D)
+ !print *,"is_contiguous (B_3D) =", is_contiguous (B_3D)
+ if (.not. is_contiguous (B_3D)) stop 102
+ !-- Set B_3D
+ B_3D = 2.0
+ !-- See if the result is reflected in Storage
+ if (any (B_2D /= 2.0)) then
+ print *, "B_2D = ", B_2D !-- expect 2.0 for all elements
+ stop 103
+ end if
+ print *,"RemappingTest passed"
+ end
+
+ subroutine SetPointer (C_2D, n1, n2, n3, C_3D)
+ integer, intent(in) :: n1, n2, n3
+ real, target, contiguous :: C_2D(:,:)
+ real, pointer :: C_3D(:,:,:)
+ intent(in) :: C_2D
+ C_3D(1:n1,1:n2,1:n3) => C_2D
+ end
+
+end
--
2.35.3
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: [PATCH] Fortran: fix argument passing to CONTIGUOUS,TARGET dummy [PR97592]
2023-12-16 18:28 [PATCH] Fortran: fix argument passing to CONTIGUOUS,TARGET dummy [PR97592] Harald Anlauf
@ 2023-12-17 16:08 ` Paul Richard Thomas
0 siblings, 0 replies; 2+ messages in thread
From: Paul Richard Thomas @ 2023-12-17 16:08 UTC (permalink / raw)
To: Harald Anlauf; +Cc: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 1223 bytes --]
Hi Harald,
It might be a simple patch but I have to confess it took a while for me to
get my head around the difference between gfc_is_not_contiguous and
!gfc_is_simply_contigous :-(
Yes, this is OK for mainline and, after a short delay, for 13-branch.
Thanks for the patch
Paul
On Sat, 16 Dec 2023 at 18:28, Harald Anlauf <anlauf@gmx.de> wrote:
> Dear all,
>
> the attached simple patch fixes a (9+) regression for passing
> to a CONTIGUOUS,TARGET dummy an *effective argument* that is
> contiguous, although the actual argument is not simply-contiguous
> (it is a pointer without the CONTIGOUS attribute in the PR).
>
> Since a previous attempt for a patch lead to regressions in
> gfortran.dg/bind-c-contiguous-3.f90, which is rather dense,
> I decided to enhance the current testcase with various
> combinations of actual and dummy arguments that allow to
> study whether a _gfortran_internal_pack is generated in
> places where we want to. (_gfortran_internal_pack does not
> create a temporary when no packing is needed).
>
> Regtested on x86_64-pc-linux-gnu. OK for mainline?
>
> I would like to backport this - after a grace period - to
> at least 13-branch. Any objections here?
>
> Thanks,
> Harald
>
>
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2023-12-17 16:08 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-12-16 18:28 [PATCH] Fortran: fix argument passing to CONTIGUOUS,TARGET dummy [PR97592] Harald Anlauf
2023-12-17 16:08 ` Paul Richard Thomas
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).