From aa25d35cb866f7f333b656938224866a70b93a69 Mon Sep 17 00:00:00 2001 From: Harald Anlauf 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 --- 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