Author: Peter Steinfeld Date: 2021-01-15T08:53:43-08:00 New Revision: 1e1a011b09d0e6e9ff62b37721906485c386708c
URL: https://github.com/llvm/llvm-project/commit/1e1a011b09d0e6e9ff62b37721906485c386708c DIFF: https://github.com/llvm/llvm-project/commit/1e1a011b09d0e6e9ff62b37721906485c386708c.diff LOG: [flang] Disallow INTENT attribute on procedure dummy arguments C843 states that "An entity with the INTENT attribute shall be a dummy data object or a dummy procedure pointer." This change enforces that and fixes some tests that erroneously violated this rule. Differential Revision: https://reviews.llvm.org/D94781 Added: Modified: flang/lib/Semantics/check-declarations.cpp flang/test/Semantics/assign03.f90 flang/test/Semantics/call09.f90 flang/test/Semantics/separate-mp02.f90 Removed: ################################################################################ diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 9bb82156e955..aca5392e507f 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -632,6 +632,14 @@ void CheckHelper::CheckArraySpec( void CheckHelper::CheckProcEntity( const Symbol &symbol, const ProcEntityDetails &details) { if (details.isDummy()) { + if (!symbol.attrs().test(Attr::POINTER) && // C843 + (symbol.attrs().test(Attr::INTENT_IN) || + symbol.attrs().test(Attr::INTENT_OUT) || + symbol.attrs().test(Attr::INTENT_INOUT))) { + messages_.Say("A dummy procedure without the POINTER attribute" + " may not have an INTENT attribute"_err_en_US); + } + const Symbol *interface{details.interface().symbol()}; if (!symbol.attrs().test(Attr::INTRINSIC) && (symbol.attrs().test(Attr::ELEMENTAL) || diff --git a/flang/test/Semantics/assign03.f90 b/flang/test/Semantics/assign03.f90 index 1435342b1ead..c53bb0ed291a 100644 --- a/flang/test/Semantics/assign03.f90 +++ b/flang/test/Semantics/assign03.f90 @@ -42,7 +42,7 @@ function f() ! C1030 and 10.2.2.4 - procedure names as target of procedure pointer subroutine s4(s_dummy) - procedure(s), intent(in) :: s_dummy + procedure(s) :: s_dummy procedure(s), pointer :: p, q procedure(), pointer :: r integer :: i diff --git a/flang/test/Semantics/call09.f90 b/flang/test/Semantics/call09.f90 index e7f22e32ed44..36aaa8f4ab46 100644 --- a/flang/test/Semantics/call09.f90 +++ b/flang/test/Semantics/call09.f90 @@ -1,5 +1,8 @@ ! RUN: %S/test_errors.sh %s %t %f18 ! Test 15.5.2.9(2,3,5) dummy procedure requirements +! C843 +! An entity with the INTENT attribute shall be a dummy data object or a +! dummy procedure pointer. module m contains @@ -22,6 +25,10 @@ subroutine s02(p) subroutine s03(p) procedure(realfunc) :: p end subroutine + subroutine s04(p) + !ERROR: A dummy procedure without the POINTER attribute may not have an INTENT attribute + procedure(realfunc), intent(in) :: p + end subroutine subroutine selemental1(p) procedure(cos) :: p ! ok diff --git a/flang/test/Semantics/separate-mp02.f90 b/flang/test/Semantics/separate-mp02.f90 index 47abc83bff1e..6d620e71118b 100644 --- a/flang/test/Semantics/separate-mp02.f90 +++ b/flang/test/Semantics/separate-mp02.f90 @@ -157,9 +157,9 @@ module subroutine s3() bind(c, name="s3" // suffix) module m3 interface module subroutine s1(x, y, z) - procedure(real), intent(in) :: x - procedure(real), intent(out) :: y - procedure(real), intent(out) :: z + procedure(real), pointer, intent(in) :: x + procedure(real), pointer, intent(out) :: y + procedure(real), pointer, intent(out) :: z end module subroutine s2(x, y) procedure(real), pointer :: x @@ -171,11 +171,11 @@ module subroutine s2(x, y) submodule(m3) sm3 contains module subroutine s1(x, y, z) - procedure(real), intent(in) :: x + procedure(real), pointer, intent(in) :: x !ERROR: The intent of dummy argument 'y' does not match the intent of the corresponding argument in the interface body - procedure(real), intent(inout) :: y + procedure(real), pointer, intent(inout) :: y !ERROR: The intent of dummy argument 'z' does not match the intent of the corresponding argument in the interface body - procedure(real) :: z + procedure(real), pointer :: z end module subroutine s2(x, y) !ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not _______________________________________________ llvm-branch-commits mailing list llvm-branch-commits@lists.llvm.org https://lists.llvm.org/cgi-bin/mailman/listinfo/llvm-branch-commits