public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r14-6191] Fortran: allow RESTRICT qualifier also for optional arguments [PR100988]
@ 2023-12-05 18:16 Harald Anlauf
0 siblings, 0 replies; only message in thread
From: Harald Anlauf @ 2023-12-05 18:16 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:9c3a880feecf81c310b4ade210fbd7004c9aece7
commit r14-6191-g9c3a880feecf81c310b4ade210fbd7004c9aece7
Author: Harald Anlauf <anlauf@gmx.de>
Date: Mon Dec 4 22:44:53 2023 +0100
Fortran: allow RESTRICT qualifier also for optional arguments [PR100988]
gcc/fortran/ChangeLog:
PR fortran/100988
* gfortran.h (IS_PROC_POINTER): New macro.
* trans-types.cc (gfc_sym_type): Use macro in determination if the
restrict qualifier can be used for a dummy variable. Fix logic to
allow the restrict qualifier also for optional arguments, and to
not apply it to pointer or proc_pointer arguments.
gcc/testsuite/ChangeLog:
PR fortran/100988
* gfortran.dg/coarray_poly_6.f90: Adjust pattern.
* gfortran.dg/coarray_poly_7.f90: Likewise.
* gfortran.dg/coarray_poly_8.f90: Likewise.
* gfortran.dg/missing_optional_dummy_6a.f90: Likewise.
* gfortran.dg/pr100988.f90: New test.
Co-authored-by: Tobias Burnus <tobias@codesourcery.com>
Diff:
---
gcc/fortran/gfortran.h | 3 ++
gcc/fortran/trans-types.cc | 13 +++--
gcc/testsuite/gfortran.dg/coarray_poly_6.f90 | 2 +-
gcc/testsuite/gfortran.dg/coarray_poly_7.f90 | 2 +-
gcc/testsuite/gfortran.dg/coarray_poly_8.f90 | 2 +-
.../gfortran.dg/missing_optional_dummy_6a.f90 | 2 +-
gcc/testsuite/gfortran.dg/pr100988.f90 | 61 ++++++++++++++++++++++
7 files changed, 74 insertions(+), 11 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index aa3f6cb70b4..a77441f38e7 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -4008,6 +4008,9 @@ bool gfc_may_be_finalized (gfc_typespec);
#define IS_POINTER(sym) \
(sym->ts.type == BT_CLASS && sym->attr.class_ok && CLASS_DATA (sym) \
? CLASS_DATA (sym)->attr.class_pointer : sym->attr.pointer)
+#define IS_PROC_POINTER(sym) \
+ (sym->ts.type == BT_CLASS && sym->attr.class_ok && CLASS_DATA (sym) \
+ ? CLASS_DATA (sym)->attr.proc_pointer : sym->attr.proc_pointer)
/* frontend-passes.cc */
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 084b8c3ae2c..5b11ffc3cc9 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2327,8 +2327,8 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c)
else
byref = 0;
- restricted = !sym->attr.target && !sym->attr.pointer
- && !sym->attr.proc_pointer && !sym->attr.cray_pointee;
+ restricted = (!sym->attr.target && !IS_POINTER (sym)
+ && !IS_PROC_POINTER (sym) && !sym->attr.cray_pointee);
if (!restricted)
type = gfc_nonrestricted_type (type);
@@ -2384,11 +2384,10 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c)
|| (sym->ns->proc_name && sym->ns->proc_name->attr.entry_master))
type = build_pointer_type (type);
else
- {
- type = build_reference_type (type);
- if (restricted)
- type = build_qualified_type (type, TYPE_QUAL_RESTRICT);
- }
+ type = build_reference_type (type);
+
+ if (restricted)
+ type = build_qualified_type (type, TYPE_QUAL_RESTRICT);
}
return (type);
diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_6.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_6.f90
index 53b80e442d3..344e12b4eff 100644
--- a/gcc/testsuite/gfortran.dg/coarray_poly_6.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_poly_6.f90
@@ -16,6 +16,6 @@ contains
end subroutine foo
end
! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_0_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_0_1t \\* x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_0_1t \\* restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_7.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_7.f90
index 44f98e16e09..d8d83aea39b 100644
--- a/gcc/testsuite/gfortran.dg/coarray_poly_7.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_poly_7.f90
@@ -16,6 +16,6 @@ contains
end subroutine foo
end
! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_1_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_8.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_8.f90
index cac305f03ec..abdfc0ca5f8 100644
--- a/gcc/testsuite/gfortran.dg/coarray_poly_8.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_poly_8.f90
@@ -16,6 +16,6 @@ contains
end subroutine foo
end
! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_1_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/missing_optional_dummy_6a.f90 b/gcc/testsuite/gfortran.dg/missing_optional_dummy_6a.f90
index c08c97a2c7e..c6a79059a91 100644
--- a/gcc/testsuite/gfortran.dg/missing_optional_dummy_6a.f90
+++ b/gcc/testsuite/gfortran.dg/missing_optional_dummy_6a.f90
@@ -47,7 +47,7 @@ contains
end program test
-! { dg-final { scan-tree-dump-times "scalar2 \\(slr1" 1 "original" } }
+! { dg-final { scan-tree-dump-times "scalar2 \\(.* slr1" 1 "original" } }
! { dg-final { scan-tree-dump-times "= es1 != 0B" 1 "original" } }
! { dg-final { scan-tree-dump-times "assumed_shape2 \\(es1" 0 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/pr100988.f90 b/gcc/testsuite/gfortran.dg/pr100988.f90
new file mode 100644
index 00000000000..b7e1ae4a2e4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr100988.f90
@@ -0,0 +1,61 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+! PR fortran/100988 - RESTRICT was missing for optional arguments
+
+ ! There should be restrict qualifiers for a AND b: (4 cases)
+ subroutine plain (a, b)
+ integer :: a, b
+ optional :: b
+ end subroutine
+
+ subroutine alloc (a, b)
+ integer :: a, b
+ allocatable :: a, b
+ optional :: b
+ end subroutine
+
+ subroutine upoly (a, b)
+ class(*) :: a, b
+ optional :: b
+ end subroutine
+
+ subroutine upoly_a (a, b)
+ class(*) :: a, b
+ allocatable :: a, b
+ optional :: b
+ end subroutine
+
+! { dg-final { scan-tree-dump "plain .* restrict a, .* restrict b\\)" "original" } }
+! { dg-final { scan-tree-dump "alloc .* restrict a, .* restrict b\\)" "original" } }
+! { dg-final { scan-tree-dump "upoly .* restrict a, .* restrict b\\)" "original" } }
+! { dg-final { scan-tree-dump "upoly_a .* restrict a, .* restrict b\\)" "original" } }
+
+ ! There should be no restrict qualifiers for the below 4 cases:
+ subroutine ptr (a, b)
+ integer :: a, b
+ pointer :: a, b
+ optional :: b
+ end subroutine
+
+ subroutine tgt (a, b)
+ integer :: a, b
+ target :: a, b
+ optional :: b
+ end subroutine
+
+ subroutine upoly_p (a, b)
+ class(*) :: a, b
+ pointer :: a, b
+ optional :: b
+ end subroutine
+
+ subroutine upoly_t (a, b)
+ class(*) :: a, b
+ target :: a, b
+ optional :: b
+ end subroutine
+
+! { dg-final { scan-tree-dump-not "ptr .* restrict " "original" } }
+! { dg-final { scan-tree-dump-not "tgt .* restrict " "original" } }
+! { dg-final { scan-tree-dump-not "upoly_p .* restrict " "original" } }
+! { dg-final { scan-tree-dump-not "upoly_t .* restrict " "original" } }
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-12-05 18:16 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-12-05 18:16 [gcc r14-6191] Fortran: allow RESTRICT qualifier also for optional arguments [PR100988] Harald Anlauf
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).