public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* [PATCH] Fortran: allow RESTRICT qualifier also for optional arguments [PR100988]
@ 2023-12-04 21:52 Harald Anlauf
  2023-12-05  7:44 ` Paul Richard Thomas
  0 siblings, 1 reply; 2+ messages in thread
From: Harald Anlauf @ 2023-12-04 21:52 UTC (permalink / raw)
  To: fortran, gcc-patches; +Cc: tobias

[-- Attachment #1: Type: text/plain, Size: 481 bytes --]

Dear all,

the attached patch picks up an observation by Tobias that we did
not specify the RESTRICT qualifier for optional arguments even
if that was allowed.  In principle this might have prevented
better optimization.

While looking more closely, I found and fixed an issue with CLASS
dummy arguments that mishandled this.  This revealed a few cases
in the testsuite that were matching the wrong patterns...

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr100988.diff --]
[-- Type: text/x-patch, Size: 9173 bytes --]

From aa25d35cb866f7f333b656938224866a70b93a69 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Mon, 4 Dec 2023 22:44:53 +0100
Subject: [PATCH] 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>
---
 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(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr100988.f90

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" } }
--
2.35.3


^ permalink raw reply	[flat|nested] 2+ messages in thread

* Re: [PATCH] Fortran: allow RESTRICT qualifier also for optional arguments [PR100988]
  2023-12-04 21:52 [PATCH] Fortran: allow RESTRICT qualifier also for optional arguments [PR100988] Harald Anlauf
@ 2023-12-05  7:44 ` Paul Richard Thomas
  0 siblings, 0 replies; 2+ messages in thread
From: Paul Richard Thomas @ 2023-12-05  7:44 UTC (permalink / raw)
  To: Harald Anlauf; +Cc: fortran, gcc-patches, tobias

[-- Attachment #1: Type: text/plain, Size: 635 bytes --]

Hi Harald,

The patch is OK for mainline.

Thanks

Paul


On Mon, 4 Dec 2023 at 22:47, Harald Anlauf <anlauf@gmx.de> wrote:

> Dear all,
>
> the attached patch picks up an observation by Tobias that we did
> not specify the RESTRICT qualifier for optional arguments even
> if that was allowed.  In principle this might have prevented
> better optimization.
>
> While looking more closely, I found and fixed an issue with CLASS
> dummy arguments that mishandled this.  This revealed a few cases
> in the testsuite that were matching the wrong patterns...
>
> 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:[~2023-12-05  7:44 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-12-04 21:52 [PATCH] Fortran: allow RESTRICT qualifier also for optional arguments [PR100988] Harald Anlauf
2023-12-05  7:44 ` 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).