* [PATCH] Fortran: fix IS_CONTIGUOUS for polymorphic dummy arguments [PR114001]
@ 2024-03-12 22:12 Harald Anlauf
2024-03-13 9:10 ` Paul Richard Thomas
0 siblings, 1 reply; 2+ messages in thread
From: Harald Anlauf @ 2024-03-12 22:12 UTC (permalink / raw)
To: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 281 bytes --]
Dear all,
here's another small fix: IS_CONTIGUOUS did erroneously always
return .true. for CLASS dummy arguments. The solution was to
adjust the logic in gfc_is_simply_contiguous to also handle
CLASS symbols.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr114001.diff --]
[-- Type: text/x-patch, Size: 4327 bytes --]
From 8f535b19bd0cb6a7c99ac9ba4c07778f86698a1c Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Tue, 12 Mar 2024 22:58:39 +0100
Subject: [PATCH] Fortran: fix IS_CONTIGUOUS for polymorphic dummy arguments
[PR114001]
gcc/fortran/ChangeLog:
PR fortran/114001
* expr.cc (gfc_is_simply_contiguous): Adjust logic so that CLASS
symbols are also handled.
gcc/testsuite/ChangeLog:
PR fortran/114001
* gfortran.dg/is_contiguous_4.f90: New test.
---
gcc/fortran/expr.cc | 19 ++---
gcc/testsuite/gfortran.dg/is_contiguous_4.f90 | 81 +++++++++++++++++++
2 files changed, 91 insertions(+), 9 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/is_contiguous_4.f90
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 37ea95d0185..82a642b01f7 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -6025,15 +6025,16 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element)
}
sym = expr->symtree->n.sym;
- if (expr->ts.type != BT_CLASS
- && ((part_ref
- && !part_ref->u.c.component->attr.contiguous
- && part_ref->u.c.component->attr.pointer)
- || (!part_ref
- && !sym->attr.contiguous
- && (sym->attr.pointer
- || (sym->as && sym->as->type == AS_ASSUMED_RANK)
- || (sym->as && sym->as->type == AS_ASSUMED_SHAPE)))))
+ if ((part_ref
+ && part_ref->u.c.component
+ && !part_ref->u.c.component->attr.contiguous
+ && IS_POINTER (part_ref->u.c.component))
+ || (!part_ref
+ && expr->ts.type != BT_CLASS
+ && !sym->attr.contiguous
+ && (sym->attr.pointer
+ || (sym->as && sym->as->type == AS_ASSUMED_RANK)
+ || (sym->as && sym->as->type == AS_ASSUMED_SHAPE))))
return false;
if (!ar || ar->type == AR_FULL)
diff --git a/gcc/testsuite/gfortran.dg/is_contiguous_4.f90 b/gcc/testsuite/gfortran.dg/is_contiguous_4.f90
new file mode 100644
index 00000000000..cb066f8836b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/is_contiguous_4.f90
@@ -0,0 +1,81 @@
+! { dg-do run }
+! PR fortran/114001 - IS_CONTIGUOUS and polymorphic dummy
+
+program main
+ implicit none
+ integer :: i, cnt = 0
+ logical :: expect
+ integer, target :: m(10) = [(i,i=1,size(m))]
+ integer, pointer :: p(:)
+ type t
+ integer :: j
+ end type t
+ type(t), pointer :: tt(:), tp(:) ! Type pointer
+ class(t), pointer :: ct(:), cp(:) ! Class pointer
+
+ p => m(1:3)
+ expect = is_contiguous (p)
+ print *, "is_contiguous (p)=", expect
+ if (.not. expect) stop 91
+ call sub_star (p, expect)
+ p => m(1::3)
+ expect = is_contiguous (p)
+ print *, "is_contiguous (p)=", expect
+ if (expect) stop 92
+ call sub_star (p, expect)
+
+ allocate (tt(10))
+ tt(:)% j = m
+ tp => tt(4:6)
+ expect = is_contiguous (tp)
+ if (.not. expect) stop 96
+ print *, "is_contiguous (tp)=", expect
+ call sub_t (tp, expect)
+ tp => tt(4::3)
+ expect = is_contiguous (tp)
+ if (expect) stop 97
+ print *, "is_contiguous (tp)=", expect
+ call sub_t (tp, expect)
+
+ allocate (ct(10))
+ ct(:)% j = m
+ cp => ct(7:9)
+ expect = is_contiguous (cp)
+ print *, "is_contiguous (cp)=", expect
+ if (.not. expect) stop 98
+ call sub_t (cp, expect)
+ cp => ct(4::3)
+ expect = is_contiguous (cp)
+ print *, "is_contiguous (cp)=", expect
+ if (expect) stop 99
+ call sub_t (cp, expect)
+
+contains
+
+ subroutine sub_star (x, expect)
+ class(*), intent(in) :: x(:)
+ logical, intent(in) :: expect
+ cnt = cnt + 10
+ if (is_contiguous (x) .neqv. expect) then
+ print *, "sub_star(1): is_contiguous (x)=", is_contiguous (x), expect
+ stop (cnt + 1)
+ end if
+ select type (x)
+ type is (integer)
+ if (is_contiguous (x) .neqv. expect) then
+ print *, "sub_star(2): is_contiguous (x)=", is_contiguous (x), expect
+ stop (cnt + 2)
+ end if
+ end select
+ end
+
+ subroutine sub_t (x, expect)
+ class(t), intent(in) :: x(:)
+ logical, intent(in) :: expect
+ cnt = cnt + 10
+ if (is_contiguous (x) .neqv. expect) then
+ print *, "sub_t: is_contiguous (x)=", is_contiguous (x), expect
+ stop (cnt + 3)
+ end if
+ end
+end
--
2.35.3
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: [PATCH] Fortran: fix IS_CONTIGUOUS for polymorphic dummy arguments [PR114001]
2024-03-12 22:12 [PATCH] Fortran: fix IS_CONTIGUOUS for polymorphic dummy arguments [PR114001] Harald Anlauf
@ 2024-03-13 9:10 ` Paul Richard Thomas
0 siblings, 0 replies; 2+ messages in thread
From: Paul Richard Thomas @ 2024-03-13 9:10 UTC (permalink / raw)
To: Harald Anlauf; +Cc: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 514 bytes --]
Hi Harald,
This looks good to me. The testcase gives the same result with other brands.
OK for mainline and for backporting.
Thanks
Paul
On Tue, 12 Mar 2024 at 22:12, Harald Anlauf <anlauf@gmx.de> wrote:
> Dear all,
>
> here's another small fix: IS_CONTIGUOUS did erroneously always
> return .true. for CLASS dummy arguments. The solution was to
> adjust the logic in gfc_is_simply_contiguous to also handle
> CLASS symbols.
>
> Regtested on x86_64-pc-linux-gnu. OK for mainline?
>
> Thanks,
> Harald
>
>
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2024-03-13 9:10 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-03-12 22:12 [PATCH] Fortran: fix IS_CONTIGUOUS for polymorphic dummy arguments [PR114001] Harald Anlauf
2024-03-13 9:10 ` 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).