c757418869
Calling "ASSOCATED(NULL()) was causing an internal check of the compiler to
fail.
I fixed this by changing the entry for "ASSOCIATED" in the intrinsics table to
accept "AnyPointer" which contains a new "KindCode" of "pointerType". I also
changed the function "FromActual()" to return a typeless intrinsic when called
on a pointer, which duplicates its behavior for BOZ literals. This required
changing the analysis of procedure arguments. While testing processing for
procedure arguments, I found another bad call to `CHECK()` which I fixed.
I made several other changes:
-- I implemented constant folding for ASSOCIATED().
-- I fixed handling of NULL() in relational operations.
-- I implemented semantic analysis for ASSOCIATED().
-- I noticed that the semantics for ASSOCIATED() are similar to those for
pointer assignment. So I extracted the code that pointer assignment uses
for procedure pointer compatibility to a place where it could be used by
the semantic analysis for ASSOCIATED().
-- I couldn't figure out how to make the general semantic analysis for
procedure arguments work with ASSOCIATED()'s second argument, which can
be either a pointer or a target. So I stopped using normal semantic
analysis for arguments for ASSOCIATED().
-- I added tests for all of this.
Differential Revision: https://reviews.llvm.org/D88313
98 lines
2.9 KiB
Fortran
98 lines
2.9 KiB
Fortran
! RUN: %S/test_errors.sh %s %t %f18
|
|
! 15.5.1 procedure reference constraints and restrictions
|
|
|
|
subroutine s01(elem, subr)
|
|
interface
|
|
elemental real function elem(x)
|
|
real, intent(in), value :: x
|
|
end function
|
|
subroutine subr(dummy)
|
|
procedure(sin) :: dummy
|
|
end subroutine
|
|
subroutine badsubr(dummy)
|
|
import :: elem
|
|
!ERROR: A dummy procedure may not be ELEMENTAL
|
|
procedure(elem) :: dummy
|
|
end subroutine
|
|
end interface
|
|
intrinsic :: cos
|
|
call subr(cos) ! not an error
|
|
!ERROR: Non-intrinsic ELEMENTAL procedure 'elem' may not be passed as an actual argument
|
|
call subr(elem) ! C1533
|
|
!ERROR: Actual argument associated with procedure dummy argument 'dummy=' is not a procedure
|
|
!ERROR: Actual argument associated with non-POINTER procedure dummy argument 'dummy=' must be a procedure (and not a procedure pointer)
|
|
call subr(null())
|
|
!ERROR: Actual argument associated with procedure dummy argument 'dummy=' is not a procedure
|
|
!ERROR: Actual argument associated with non-POINTER procedure dummy argument 'dummy=' must be a procedure (and not a procedure pointer)
|
|
call subr(B"1010")
|
|
end subroutine
|
|
|
|
module m01
|
|
procedure(sin) :: elem01
|
|
interface
|
|
elemental real function elem02(x)
|
|
real, value :: x
|
|
end function
|
|
subroutine callme(f)
|
|
external f
|
|
end subroutine
|
|
end interface
|
|
contains
|
|
elemental real function elem03(x)
|
|
real, value :: x
|
|
end function
|
|
subroutine test
|
|
intrinsic :: cos
|
|
call callme(cos) ! not an error
|
|
!ERROR: Non-intrinsic ELEMENTAL procedure 'elem01' may not be passed as an actual argument
|
|
call callme(elem01) ! C1533
|
|
!ERROR: Non-intrinsic ELEMENTAL procedure 'elem02' may not be passed as an actual argument
|
|
call callme(elem02) ! C1533
|
|
!ERROR: Non-intrinsic ELEMENTAL procedure 'elem03' may not be passed as an actual argument
|
|
call callme(elem03) ! C1533
|
|
!ERROR: Non-intrinsic ELEMENTAL procedure 'elem04' may not be passed as an actual argument
|
|
call callme(elem04) ! C1533
|
|
contains
|
|
elemental real function elem04(x)
|
|
real, value :: x
|
|
end function
|
|
end subroutine
|
|
end module
|
|
|
|
module m02
|
|
type :: t
|
|
integer, pointer :: ptr
|
|
end type
|
|
type(t) :: coarray[*]
|
|
contains
|
|
subroutine callee(x)
|
|
type(t), intent(in) :: x
|
|
end subroutine
|
|
subroutine test
|
|
!ERROR: Coindexed object 'coarray' with POINTER ultimate component '%ptr' cannot be associated with dummy argument 'x='
|
|
call callee(coarray[1]) ! C1537
|
|
end subroutine
|
|
end module
|
|
|
|
program p03
|
|
logical :: l
|
|
call s1(index)
|
|
l = index .eq. 0 ! index is an object entity, not an intrinsic
|
|
call s2(sin)
|
|
!ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure
|
|
call s3(cos)
|
|
contains
|
|
subroutine s2(x)
|
|
real :: x
|
|
end
|
|
subroutine s3(p)
|
|
procedure(real) :: p
|
|
end
|
|
end
|
|
|
|
program p04
|
|
implicit none
|
|
!ERROR: No explicit type declared for 'index'
|
|
call s1(index)
|
|
end
|