[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
This commit is contained in:
		
							parent
							
								
									be69e66b1c
								
							
						
					
					
						commit
						1e1a011b09
					
				| 
						 | 
					@ -632,6 +632,14 @@ void CheckHelper::CheckArraySpec(
 | 
				
			||||||
void CheckHelper::CheckProcEntity(
 | 
					void CheckHelper::CheckProcEntity(
 | 
				
			||||||
    const Symbol &symbol, const ProcEntityDetails &details) {
 | 
					    const Symbol &symbol, const ProcEntityDetails &details) {
 | 
				
			||||||
  if (details.isDummy()) {
 | 
					  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()};
 | 
					    const Symbol *interface{details.interface().symbol()};
 | 
				
			||||||
    if (!symbol.attrs().test(Attr::INTRINSIC) &&
 | 
					    if (!symbol.attrs().test(Attr::INTRINSIC) &&
 | 
				
			||||||
        (symbol.attrs().test(Attr::ELEMENTAL) ||
 | 
					        (symbol.attrs().test(Attr::ELEMENTAL) ||
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -42,7 +42,7 @@ contains
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  ! C1030 and 10.2.2.4 - procedure names as target of procedure pointer
 | 
					  ! C1030 and 10.2.2.4 - procedure names as target of procedure pointer
 | 
				
			||||||
  subroutine s4(s_dummy)
 | 
					  subroutine s4(s_dummy)
 | 
				
			||||||
    procedure(s), intent(in) :: s_dummy
 | 
					    procedure(s) :: s_dummy
 | 
				
			||||||
    procedure(s), pointer :: p, q
 | 
					    procedure(s), pointer :: p, q
 | 
				
			||||||
    procedure(), pointer :: r
 | 
					    procedure(), pointer :: r
 | 
				
			||||||
    integer :: i
 | 
					    integer :: i
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,5 +1,8 @@
 | 
				
			||||||
! RUN: %S/test_errors.sh %s %t %f18
 | 
					! RUN: %S/test_errors.sh %s %t %f18
 | 
				
			||||||
! Test 15.5.2.9(2,3,5) dummy procedure requirements
 | 
					! 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
 | 
					module m
 | 
				
			||||||
 contains
 | 
					 contains
 | 
				
			||||||
| 
						 | 
					@ -22,6 +25,10 @@ module m
 | 
				
			||||||
  subroutine s03(p)
 | 
					  subroutine s03(p)
 | 
				
			||||||
    procedure(realfunc) :: p
 | 
					    procedure(realfunc) :: p
 | 
				
			||||||
  end subroutine
 | 
					  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)
 | 
					  subroutine selemental1(p)
 | 
				
			||||||
    procedure(cos) :: p ! ok
 | 
					    procedure(cos) :: p ! ok
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -157,9 +157,9 @@ end
 | 
				
			||||||
module m3
 | 
					module m3
 | 
				
			||||||
  interface
 | 
					  interface
 | 
				
			||||||
    module subroutine s1(x, y, z)
 | 
					    module subroutine s1(x, y, z)
 | 
				
			||||||
      procedure(real), intent(in) :: x
 | 
					      procedure(real), pointer, intent(in) :: x
 | 
				
			||||||
      procedure(real), intent(out) :: y
 | 
					      procedure(real), pointer, intent(out) :: y
 | 
				
			||||||
      procedure(real), intent(out) :: z
 | 
					      procedure(real), pointer, intent(out) :: z
 | 
				
			||||||
    end
 | 
					    end
 | 
				
			||||||
    module subroutine s2(x, y)
 | 
					    module subroutine s2(x, y)
 | 
				
			||||||
      procedure(real), pointer :: x
 | 
					      procedure(real), pointer :: x
 | 
				
			||||||
| 
						 | 
					@ -171,11 +171,11 @@ end
 | 
				
			||||||
submodule(m3) sm3
 | 
					submodule(m3) sm3
 | 
				
			||||||
contains
 | 
					contains
 | 
				
			||||||
  module subroutine s1(x, y, z)
 | 
					  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
 | 
					    !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
 | 
					    !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
 | 
					  end
 | 
				
			||||||
  module subroutine s2(x, y)
 | 
					  module subroutine s2(x, y)
 | 
				
			||||||
    !ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not
 | 
					    !ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue