Emil Kieri 93dca9fbee [flang][test] Fix semantics tests with respect to warnings
Make tests expect the (correctly) emitted warnings using the WARNING
directive. This directive is non-functional now, but will be recognised
by test_errors.py when D125804 is landed. This patch is a preparation
for D125804.

For most tests, we add missing WARNING directives for emitted warnings,
but there are exceptions:

 - for int-literals.f90 and resolve31.f90 we pass -pedantic to the
   frontend driver, so that the expected warnings are actually emitted.

 - for block-data01.f90 and resolve42.f90 we change the tests so that
   warnings, which appear unintentional, are not emitted. While testing
   the warning in question (padding added for alignment in common block)
   would be desired, that is beyond the scope of this patch. This
   warning is target-dependent.

Reviewed By: PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D131987
2022-08-18 19:16:20 +02:00

110 lines
2.8 KiB
Fortran

! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
! C735 If EXTENDS appears, SEQUENCE shall not appear.
! C738 The same private-or-sequence shall not appear more than once in a
! given derived-type-def .
!
! C740 If SEQUENCE appears,
! the type shall have at least one component,
! each data component shall be declared to be of an intrinsic type or of a sequence type,
! the derived type shall not have any type parameter,
! and a type-bound-procedure-part shall not appear.
subroutine s1
integer :: t0
!ERROR: 't0' is not a derived type
type(t0) :: x
type :: t1
end type
type, extends(t1) :: t2
end type
!ERROR: Derived type 't3' not found
type, extends(t3) :: t4
end type
!ERROR: 't0' is not a derived type
type, extends(t0) :: t5
end type
end subroutine
module m1
type t0
end type
end
module m2
type t
end type
end
module m3
type t0
end type
end
subroutine s2
use m1
use m2, t0 => t
use m3
!ERROR: Reference to 't0' is ambiguous
type, extends(t0) :: t1
end type
end subroutine
module m4
type :: t1
private
sequence
!WARNING: PRIVATE may not appear more than once in derived type components
private
!WARNING: SEQUENCE may not appear more than once in derived type components
sequence
real :: t1Field
end type
type :: t1a
end type
!ERROR: A sequence type may not have the EXTENDS attribute
type, extends(t1a) :: t2
sequence
integer i
end type
type :: t3
sequence
integer i
!ERROR: A sequence type may not have a CONTAINS statement
contains
end type
!ERROR: A sequence type must have at least one component
type :: emptyType
sequence
end type emptyType
type :: plainType
real :: plainField
end type plainType
type :: sequenceType
sequence
real :: sequenceField
end type sequenceType
type :: testType
sequence
!ERROR: A sequence type data component must either be of an intrinsic type or a derived sequence type
class(*), allocatable :: typeStarField
!ERROR: A sequence type data component must either be of an intrinsic type or a derived sequence type
type(plainType) :: testField1
!WARNING: A sequence type data component that is a pointer to a non-sequence type is not standard
type(plainType), pointer :: testField1p
type(sequenceType) :: testField2
procedure(real), pointer, nopass :: procField
end type testType
!ERROR: A sequence type may not have type parameters
type :: paramType(param)
integer, kind :: param
sequence
real :: paramField
end type paramType
contains
subroutine s3
type :: t1
!ERROR: PRIVATE is only allowed in a derived type that is in a module
private
contains
!ERROR: PRIVATE is only allowed in a derived type that is in a module
private
end type
end
end