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>

7 files changed, 74 insertions, 11 deletions

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index aa3f6cb..a77441f 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 084b8c3..5b11ffc 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 53b80e4..344e12b 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 44f98e1..d8d83ae 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 cac305f..abdfc0c 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 c08c97a..c6a7905 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 0000000..b7e1ae4
--- /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" } }