mirror of
https://github.com/llvm/llvm-project.git
synced 2025-04-16 21:56:34 +00:00

12.6.3p5 requires an I/O data list item to have a defined I/O procedure if it is polymorphic. (We could defer this checking to the runtime, but no other Fortran compiler does so, and we would also have to be able to catch the case of an allocatable or pointer direct component in the absence of a defined I/O subroutine.) Also includes a patch to name resolution that ensures that a SELECT TYPE construct entity is polymorphic in the domain of a CLASS IS guard. Also ensures that non-defined I/O of types with PRIVATE components is caught. Differential Revision: https://reviews.llvm.org/D139050
138 lines
3.0 KiB
Fortran
138 lines
3.0 KiB
Fortran
! RUN: %python %S/test_symbols.py %s %flang_fc1
|
|
!DEF: /s1 (Subroutine) Subprogram
|
|
subroutine s1
|
|
implicit none
|
|
!DEF: /s1/x ObjectEntity REAL(8)
|
|
real(kind=8) :: x = 2.0
|
|
!DEF: /s1/a ObjectEntity INTEGER(4)
|
|
integer a
|
|
!DEF: /s1/t DerivedType
|
|
type :: t
|
|
end type
|
|
!REF: /s1/t
|
|
!DEF: /s1/z ALLOCATABLE ObjectEntity CLASS(t)
|
|
class(t), allocatable :: z
|
|
!DEF: /s1/OtherConstruct1/a AssocEntity REAL(8)
|
|
!REF: /s1/x
|
|
!DEF: /s1/OtherConstruct1/b AssocEntity REAL(8)
|
|
!DEF: /s1/OtherConstruct1/c AssocEntity CLASS(t)
|
|
!REF: /s1/z
|
|
associate (a => x, b => x+1, c => z)
|
|
!REF: /s1/x
|
|
!REF: /s1/OtherConstruct1/a
|
|
x = a
|
|
end associate
|
|
end subroutine
|
|
|
|
!DEF: /s2 (Subroutine) Subprogram
|
|
subroutine s2
|
|
!DEF: /s2/x ObjectEntity CHARACTER(4_4,1)
|
|
!DEF: /s2/y ObjectEntity CHARACTER(4_4,1)
|
|
character(len=4) x, y
|
|
!DEF: /s2/OtherConstruct1/z AssocEntity CHARACTER(4_8,1)
|
|
!REF: /s2/x
|
|
associate (z => x)
|
|
!REF: /s2/OtherConstruct1/z
|
|
print *, "z:", z
|
|
end associate
|
|
!TODO: need correct length for z
|
|
!DEF: /s2/OtherConstruct2/z AssocEntity CHARACTER(8_8,1)
|
|
!REF: /s2/x
|
|
!REF: /s2/y
|
|
associate (z => x//y)
|
|
!REF: /s2/OtherConstruct2/z
|
|
print *, "z:", z
|
|
end associate
|
|
end subroutine
|
|
|
|
!DEF: /s3 (Subroutine) Subprogram
|
|
subroutine s3
|
|
!DEF: /s3/t1 DerivedType
|
|
type :: t1
|
|
!DEF: /s3/t1/a1 ObjectEntity INTEGER(4)
|
|
integer :: a1
|
|
end type
|
|
!REF: /s3/t1
|
|
!DEF: /s3/t2 DerivedType
|
|
type, extends(t1) :: t2
|
|
!DEF: /s3/t2/a2 ObjectEntity INTEGER(4)
|
|
integer :: a2
|
|
end type
|
|
!DEF: /s3/i ObjectEntity INTEGER(4)
|
|
integer i
|
|
!REF: /s3/t1
|
|
!DEF: /s3/x POINTER ObjectEntity CLASS(t1)
|
|
class(t1), pointer :: x
|
|
!REF: /s3/x
|
|
select type (y => x)
|
|
!REF: /s3/t2
|
|
class is (t2)
|
|
!REF: /s3/i
|
|
!DEF: /s3/OtherConstruct1/y TARGET AssocEntity CLASS(t2)
|
|
!REF: /s3/t2/a2
|
|
i = y%a2
|
|
!REF: /s3/t1
|
|
type is (t1)
|
|
!REF: /s3/i
|
|
!DEF: /s3/OtherConstruct2/y TARGET AssocEntity TYPE(t1)
|
|
!REF: /s3/t1/a1
|
|
i = y%a1
|
|
class default
|
|
!DEF: /s3/OtherConstruct3/y TARGET AssocEntity CLASS(t1)
|
|
!REF:/s3/t1/a1
|
|
print *, y%a1
|
|
end select
|
|
end subroutine
|
|
|
|
!DEF: /s4 (Subroutine) Subprogram
|
|
subroutine s4
|
|
!DEF: /s4/t1 DerivedType
|
|
type :: t1
|
|
!DEF: /s4/t1/a ObjectEntity REAL(4)
|
|
real :: a
|
|
end type
|
|
!DEF: /s4/t2 DerivedType
|
|
type :: t2
|
|
!REF: /s4/t1
|
|
!DEF: /s4/t2/b ObjectEntity TYPE(t1)
|
|
type(t1) :: b
|
|
end type
|
|
!REF: /s4/t2
|
|
!DEF: /s4/x ObjectEntity TYPE(t2)
|
|
type(t2) :: x
|
|
!DEF: /s4/OtherConstruct1/y AssocEntity TYPE(t1)
|
|
!REF: /s4/x
|
|
!REF: /s4/t2/b
|
|
associate(y => x%b)
|
|
!REF: /s4/OtherConstruct1/y
|
|
!REF: /s4/t1/a
|
|
y%a = 0.0
|
|
end associate
|
|
end subroutine
|
|
|
|
!DEF: /s5 (Subroutine) Subprogram
|
|
subroutine s5
|
|
!DEF: /s5/t DerivedType
|
|
type :: t
|
|
!DEF: /s5/t/a ObjectEntity REAL(4)
|
|
real :: a
|
|
end type
|
|
!DEF: /s5/b ObjectEntity REAL(4)
|
|
real b
|
|
!DEF: /s5/OtherConstruct1/x AssocEntity TYPE(t)
|
|
!DEF: /s5/f (Function) Subprogram TYPE(t)
|
|
associate(x => f())
|
|
!REF: /s5/b
|
|
!REF: /s5/OtherConstruct1/x
|
|
!REF: /s5/t/a
|
|
b = x%a
|
|
end associate
|
|
contains
|
|
!REF: /s5/f
|
|
function f()
|
|
!REF: /s5/t
|
|
!DEF: /s5/f/f ObjectEntity TYPE(t)
|
|
type(t) :: f
|
|
end function
|
|
end subroutine
|