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 --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index aa3f6cb70b401e554f86a7019cda41f0cda1f676..a77441f38e7cf5eb230c615a4263622bbb2c7dfe 100644 (file)
--- 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 084b8c3ae2cdadaf3bdc8ac3d5194c58a9b9f61c..5b11ffc3cc94e28ba3e24efe8fe0a196c07ee188 100644 (file)
--- 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 53b80e442d33c55e360fc69f2f741b7360011e7d..344e12b4eff7c9c155d03354ffdf6f7962559639 100644 (file)
--- 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 44f98e16e09a2246e1e444e8bee3beb0858760ac..d8d83aea39b58c6dec022f36ff5514c2691463e7 100644 (file)
--- 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 cac305f03ec636dab471a5dd983aa5656f91b72a..abdfc0ca5f821d0a9d392296323e88ca8eeeec11 100644 (file)
--- 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 c08c97a2c7ebac58d98fce59bde8aaf7c523daa9..c6a79059a91fb50cd1af9c39dff0fa1615394182 100644 (file)
--- 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 (file)
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" } }