Fortran: fix IS_CONTIGUOUS for polymorphic dummy arguments [PR114001]
Checks
Context |
Check |
Description |
linaro-tcwg-bot/tcwg_gcc_build--master-arm |
success
|
Testing passed
|
linaro-tcwg-bot/tcwg_gcc_check--master-arm |
success
|
Testing passed
|
linaro-tcwg-bot/tcwg_gcc_build--master-aarch64 |
success
|
Testing passed
|
linaro-tcwg-bot/tcwg_gcc_check--master-aarch64 |
success
|
Testing passed
|
Commit Message
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
Comments
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
>
>
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
@@ -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)
new file mode 100644
@@ -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