486be17dda
Rework the code used to check for calls to impure procedures in DO CONCURRENT constructs. The current code wasn't checking the representation of the procedure references in the strongly typed expressions, so it was missing calls to impure subprograms made via generic interfaces. While here, improve error messages, and fix some minor issues exposed by testing the improved checks. Differential Revision: https://reviews.llvm.org/D155489
98 lines
2.8 KiB
Fortran
98 lines
2.8 KiB
Fortran
! RUN: %python %S/test_errors.py %s %flang_fc1
|
|
! Test 15.7 C1591 & others: contexts requiring pure subprograms
|
|
|
|
module m
|
|
|
|
type :: t
|
|
contains
|
|
procedure, nopass :: tbp_pure => pure
|
|
procedure, nopass :: tbp_impure => impure
|
|
end type
|
|
type, extends(t) :: t2
|
|
contains
|
|
!ERROR: An overridden pure type-bound procedure binding must also be pure
|
|
procedure, nopass :: tbp_pure => impure ! 7.5.7.3
|
|
end type
|
|
|
|
contains
|
|
|
|
pure integer function pure(n)
|
|
integer, value :: n
|
|
pure = n
|
|
end function
|
|
impure integer function impure(n)
|
|
integer, value :: n
|
|
impure = n
|
|
end function
|
|
|
|
subroutine test
|
|
real :: a(pure(1)) ! ok
|
|
!ERROR: Invalid specification expression: reference to impure function 'impure'
|
|
real :: b(impure(1)) ! 10.1.11(4)
|
|
forall (j=1:1)
|
|
!ERROR: Impure procedure 'impure' may not be referenced in a FORALL
|
|
a(j) = impure(j) ! C1037
|
|
end forall
|
|
forall (j=1:1)
|
|
!ERROR: Impure procedure 'impure' may not be referenced in a FORALL
|
|
a(j) = pure(impure(j)) ! C1037
|
|
end forall
|
|
!ERROR: DO CONCURRENT mask expression may not reference impure procedure 'impure'
|
|
do concurrent (j=1:1, impure(j) /= 0) ! C1121
|
|
!ERROR: Impure procedure 'impure' may not be referenced in DO CONCURRENT
|
|
a(j) = impure(j) ! C1139
|
|
end do
|
|
end subroutine
|
|
|
|
subroutine test2
|
|
type(t) :: x
|
|
real :: a(x%tbp_pure(1)) ! ok
|
|
!ERROR: Invalid specification expression: reference to impure function 'impure'
|
|
real :: b(x%tbp_impure(1))
|
|
forall (j=1:1)
|
|
a(j) = x%tbp_pure(j) ! ok
|
|
end forall
|
|
forall (j=1:1)
|
|
!ERROR: Impure procedure 'impure' may not be referenced in a FORALL
|
|
a(j) = x%tbp_impure(j) ! C1037
|
|
end forall
|
|
do concurrent (j=1:1, x%tbp_pure(j) /= 0) ! ok
|
|
a(j) = x%tbp_pure(j) ! ok
|
|
end do
|
|
!ERROR: DO CONCURRENT mask expression may not reference impure procedure 'impure'
|
|
do concurrent (j=1:1, x%tbp_impure(j) /= 0) ! C1121
|
|
!ERROR: Impure procedure 'impure' may not be referenced in DO CONCURRENT
|
|
a(j) = x%tbp_impure(j) ! C1139
|
|
end do
|
|
end subroutine
|
|
|
|
subroutine test3
|
|
type :: t
|
|
integer :: i
|
|
end type
|
|
type(t) :: a(10), b
|
|
forall (i=1:10)
|
|
a(i) = t(pure(i)) ! OK
|
|
end forall
|
|
forall (i=1:10)
|
|
!ERROR: Impure procedure 'impure' may not be referenced in a FORALL
|
|
a(i) = t(impure(i)) ! C1037
|
|
end forall
|
|
end subroutine
|
|
|
|
subroutine test4(ch)
|
|
type :: t
|
|
real, allocatable :: x
|
|
end type
|
|
type(t) :: a(1), b(1)
|
|
character(*), intent(in) :: ch
|
|
allocate (b(1)%x)
|
|
! Intrinsic functions and a couple subroutines are pure; do not emit errors
|
|
do concurrent (j=1:1)
|
|
b(j)%x = cos(1.) + len(ch)
|
|
call move_alloc(from=b(j)%x, to=a(j)%x)
|
|
end do
|
|
end subroutine
|
|
|
|
end module
|