[flang] More tests

Original-commit: flang-compiler/f18@bd5e95e40c
Reviewed-on: https://github.com/flang-compiler/f18/pull/711
Tree-same-pre-rewrite: false
This commit is contained in:
peter klausler 2019-09-06 14:42:44 -07:00
parent c19c1e5abd
commit 5ea5fe9b1e
3 changed files with 85 additions and 8 deletions

View File

@ -30,7 +30,7 @@ module m
subroutine test
! ERROR: CONTIGUOUS pointer must be an array
real, pointer, contiguous :: a01 ! C830
real, pointer :: a02
real, pointer :: a02(:)
real, target :: a03(10)
real :: a04(10) ! not TARGET
call s01(a03) ! ok

View File

@ -14,7 +14,7 @@
! Test 15.7 (C1583-C1590, C1592-C1599) constraints and restrictions
! for PURE procedures.
! (C1591 is tested in call11.f90.)
! (C1591 is tested in call11.f90; C1594 in call12.f90.)
module m
@ -33,11 +33,17 @@ module m
end subroutine
end interface
real, volatile, target :: volatile
contains
subroutine impure(x)
type(impureFinal) :: x
end subroutine
integer impure function notpure(n)
integer, value :: n
notpure = n
end function
pure real function f01(a)
real, intent(in) :: a ! ok
@ -125,7 +131,78 @@ module m
! ERROR: A dummy procedure of a PURE subprogram must be PURE.
procedure(impure) :: p
end subroutine
! pmk: Continue with C1592 - C1599
! C1591 is tested in call11.f90.
pure subroutine s07 ! C1592
contains
pure subroutine pure ! ok
end subroutine
! ERROR: An internal subprogram of a PURE subprogram must also be PURE.
subroutine impure1
end subroutine
! ERROR: An internal subprogram of a PURE subprogram must also be PURE.
impure subroutine impure2
end subroutine
end subroutine
function volptr
real, pointer, volatile :: volptr
volptr => volatile
end function
pure subroutine s08 ! C1593
real :: x
! ERROR: A VOLATILE variable may not appear in a PURE subprogram.
x = volatile
! ERROR: A VOLATILE variable may not appear in a PURE subprogram.
x = volptr
end subroutine
! C1594 is tested in call12.f90.
pure subroutine s09 ! C1595
integer :: n
! ERROR: Any procedure referenced in a PURE subprogram must also be PURE.
n = notpure(1)
end subroutine
pure subroutine s10(to) ! C1596
type(polyAlloc) :: auto, to
! ERROR: Deallocation of a polymorphic object is not permitted in a PURE subprogram.
to = auto
! Implicit deallocation at the end of the subroutine:
! ERROR: Deallocation of a polymorphic object is not permitted in a PURE subprogram.
end subroutine
pure subroutine s11
character :: buff(20)
real :: x
write(buff, *) 1.0 ! ok
read(buff, *) x ! ok
! ERROR: External I/O is not allowed in a PURE subprogram
print *, 'hi' ! C1597
! ERROR: External I/O is not allowed in a PURE subprogram
open(1, 'launch-codes') ! C1597
! ERROR: External I/O is not allowed in a PURE subprogram
close(1) ! C1597
! ERROR: External I/O is not allowed in a PURE subprogram
backspace(1) ! C1597
! ERROR: External I/O is not allowed in a PURE subprogram
endfile(1) ! C1597
! ERROR: External I/O is not allowed in a PURE subprogram
rewind(1) ! C1597
! ERROR: External I/O is not allowed in a PURE subprogram
flush(1) ! C1597
! ERROR: External I/O is not allowed in a PURE subprogram
wait(1) ! C1597
! ERROR: External I/O is not allowed in a PURE subprogram
inquire(1, name=buff) ! C1597
! ERROR: External I/O is not allowed in a PURE subprogram
read(5, *) x ! C1598
! ERROR: External I/O is not allowed in a PURE subprogram
read(*, *) x ! C1598
! ERROR: External I/O is not allowed in a PURE subprogram
write(6, *) ! C1598
! ERROR: External I/O is not allowed in a PURE subprogram
write(*, *) ! C1598
end subroutine
pure subroutine s12
! ERROR: An image control statement is not allowed in a PURE subprogram.
sync all ! C1599
! TODO others from 11.6.1 (many)
end subroutine
end module

View File

@ -18,12 +18,12 @@ module m
type :: t
contains
procedure :: tbp => pure
procedure, nopass :: tbp => pure
end type
type, extends(t) :: t2
contains
! ERROR: An overridden PURE type-bound procedure binding must also be PURE
procedure :: tbp => impure ! 7.5.7.3
procedure, nopass :: tbp => impure ! 7.5.7.3
end type
contains
@ -45,9 +45,9 @@ module m
! ERROR: A procedure referenced in a FORALL body must be PURE.
a(j) = impure(j) ! C1037
end forall
! ERROR: A procedure referenced in a mask expression must be PURE.
! ERROR: concurrent-header mask expression cannot reference an impure procedure
do concurrent (j=1:1, impure(j) /= 0) ! C1121
! ERROR: A procedure referenced in a DO CONCURRENT body must be PURE.
! ERROR: call to impure subroutine in DO CONCURRENT not allowed
a(j) = impure(j) ! C1139
end do
end subroutine