38095549c6
Summary: Many of these were already implemented, and I just annotated the tests and/or the code. C752 was a simple check to verify that CONTIGUOUS components are arrays with C754 proved to be virtually identical to C750 that I implemented previously. This caused me to remove the distinction between specification expressions for type parameters and bounds expressions that I'd previously created. the POINTER attribute. I also changed the error messages to specify that errors in specification expressions could arise from either bad derived type components or type parameters. In cases where we detect a type param that was not declared, I created a symbol marked as erroneous. That avoids subsequent semantic process for expressions containing the symbol. This change caused me to adjust tests resolve33.f90 and resolve34.f90. Also, I avoided putting out error messages for erroneous type param symbols in `OkToAddComponent()` in resolve-names.cpp and in `EvaluateParameters()`, type.cpp. C756 checks that procedure components have the POINTER attribute. Reviewers: tskeith, klausler, DavidTruby Subscribers: llvm-commits Tags: #llvm, #flang Differential Revision: https://reviews.llvm.org/D79798
141 lines
3.8 KiB
Fortran
141 lines
3.8 KiB
Fortran
! RUN: %S/test_errors.sh %s %t %f18
|
|
! Tests for C760:
|
|
! The passed-object dummy argument shall be a scalar, nonpointer, nonallocatable
|
|
! dummy data object with the same declared type as the type being defined;
|
|
! all of its length type parameters shall be assumed; it shall be polymorphic
|
|
! (7.3.2.3) if and only if the type being defined is extensible (7.5.7).
|
|
! It shall not have the VALUE attribute.
|
|
!
|
|
! C757 If the procedure pointer component has an implicit interface or has no
|
|
! arguments, NOPASS shall be specified.
|
|
!
|
|
! C758 If PASS (arg-name) appears, the interface of the procedure pointer
|
|
! component shall have a dummy argument named arg-name.
|
|
|
|
|
|
module m1
|
|
type :: t
|
|
procedure(real), pointer, nopass :: a
|
|
!ERROR: Procedure component 'b' must have NOPASS attribute or explicit interface
|
|
procedure(real), pointer :: b
|
|
end type
|
|
end
|
|
|
|
module m2
|
|
type :: t
|
|
!ERROR: Procedure component 'a' with no dummy arguments must have NOPASS attribute
|
|
procedure(s1), pointer :: a
|
|
!ERROR: Procedure component 'b' with no dummy arguments must have NOPASS attribute
|
|
procedure(s1), pointer, pass :: b
|
|
contains
|
|
!ERROR: Procedure binding 'p1' with no dummy arguments must have NOPASS attribute
|
|
procedure :: p1 => s1
|
|
!ERROR: Procedure binding 'p2' with no dummy arguments must have NOPASS attribute
|
|
procedure, pass :: p2 => s1
|
|
end type
|
|
contains
|
|
subroutine s1()
|
|
end
|
|
end
|
|
|
|
module m3
|
|
type :: t
|
|
!ERROR: 'y' is not a dummy argument of procedure interface 's'
|
|
procedure(s), pointer, pass(y) :: a
|
|
contains
|
|
!ERROR: 'z' is not a dummy argument of procedure interface 's'
|
|
procedure, pass(z) :: p => s
|
|
end type
|
|
contains
|
|
subroutine s(x)
|
|
class(t) :: x
|
|
end
|
|
end
|
|
|
|
module m4
|
|
type :: t
|
|
!ERROR: Passed-object dummy argument 'x' of procedure 'a' may not have the POINTER attribute
|
|
procedure(s1), pointer :: a
|
|
!ERROR: Passed-object dummy argument 'x' of procedure 'b' may not have the ALLOCATABLE attribute
|
|
procedure(s2), pointer, pass(x) :: b
|
|
!ERROR: Passed-object dummy argument 'f' of procedure 'c' must be a data object
|
|
procedure(s3), pointer, pass :: c
|
|
!ERROR: Passed-object dummy argument 'x' of procedure 'd' must be scalar
|
|
procedure(s4), pointer, pass :: d
|
|
end type
|
|
contains
|
|
subroutine s1(x)
|
|
class(t), pointer :: x
|
|
end
|
|
subroutine s2(w, x)
|
|
real :: x
|
|
!ERROR: The type of 'x' has already been declared
|
|
class(t), allocatable :: x
|
|
end
|
|
subroutine s3(f)
|
|
interface
|
|
real function f()
|
|
end function
|
|
end interface
|
|
end
|
|
subroutine s4(x)
|
|
class(t) :: x(10)
|
|
end
|
|
end
|
|
|
|
module m5
|
|
type :: t1
|
|
sequence
|
|
!ERROR: Passed-object dummy argument 'x' of procedure 'a' must be of type 't1' but is 'REAL(4)'
|
|
procedure(s), pointer :: a
|
|
end type
|
|
type :: t2
|
|
contains
|
|
!ERROR: Passed-object dummy argument 'y' of procedure 's' must be of type 't2' but is 'TYPE(t1)'
|
|
procedure, pass(y) :: s
|
|
end type
|
|
contains
|
|
subroutine s(x, y)
|
|
real :: x
|
|
type(t1) :: y
|
|
end
|
|
end
|
|
|
|
module m6
|
|
type :: t(k, l)
|
|
integer, kind :: k
|
|
integer, len :: l
|
|
!ERROR: Passed-object dummy argument 'x' of procedure 'a' has non-assumed length parameter 'l'
|
|
procedure(s1), pointer :: a
|
|
end type
|
|
contains
|
|
subroutine s1(x)
|
|
class(t(1, 2)) :: x
|
|
end
|
|
end
|
|
|
|
module m7
|
|
type :: t
|
|
sequence ! t is not extensible
|
|
!ERROR: Passed-object dummy argument 'x' of procedure 'a' may not be polymorphic because 't' is not extensible
|
|
procedure(s), pointer :: a
|
|
end type
|
|
contains
|
|
subroutine s(x)
|
|
!ERROR: Non-extensible derived type 't' may not be used with CLASS keyword
|
|
class(t) :: x
|
|
end
|
|
end
|
|
|
|
module m8
|
|
type :: t
|
|
contains
|
|
!ERROR: Passed-object dummy argument 'x' of procedure 's' must be polymorphic because 't' is extensible
|
|
procedure :: s
|
|
end type
|
|
contains
|
|
subroutine s(x)
|
|
type(t) :: x ! x is not polymorphic
|
|
end
|
|
end
|