From: Pete Steinfeld Date: Tue, 11 Feb 2020 20:14:04 +0000 (-0800) Subject: [flang] Semantic check for C708 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=79f38ab4bb612f5bcebd35c3318e1fcf9516babb;p=platform%2Fupstream%2Fllvm.git [flang] Semantic check for C708 An entity declared with the CLASS keyword shall be a dummy argument or have the ALLOCATABLE or POINTER attribute. Implementing this check revealed a problem in the test resolve44.cpp. It also showed that we were doing semantic checking on the entities created by the compiler for LOCAL and LOCAL_INIT locality-specs. So I changed the creation of symbols associated with LOCAL and LOCAL_INIT locality-specs to be host associated with the outer symbol rather than new object entities. In the process, I also changed things so that the `parser::Name` associated with the newly created symbols was set to the symbol rather than being set to nullptr. Original-commit: flang-compiler/f18@5dd0b0bbe811a908374b2907bb38c75ca76127d2 Reviewed-on: https://github.com/flang-compiler/f18/pull/981 --- diff --git a/flang/lib/semantics/check-declarations.cpp b/flang/lib/semantics/check-declarations.cpp index 7cd81c9..57f4d78 100644 --- a/flang/lib/semantics/check-declarations.cpp +++ b/flang/lib/semantics/check-declarations.cpp @@ -371,6 +371,14 @@ void CheckHelper::CheckObjectEntity( } } } + if (const DeclTypeSpec * type{details.type()}) { // C708 + if (type->IsPolymorphic() && + !(IsAllocatableOrPointer(symbol) || symbol.IsDummy())) { + messages_.Say("CLASS entity '%s' must be a dummy argument or have " + "ALLOCATABLE or POINTER attribute"_err_en_US, + symbol.name()); + } + } } // The six different kinds of array-specs: diff --git a/flang/lib/semantics/resolve-names.cpp b/flang/lib/semantics/resolve-names.cpp index f075fa3..61e9ed0 100644 --- a/flang/lib/semantics/resolve-names.cpp +++ b/flang/lib/semantics/resolve-names.cpp @@ -4314,12 +4314,8 @@ Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) { if (!PassesLocalityChecks(name, prev)) { return nullptr; } - name.symbol = nullptr; - Symbol &symbol{DeclareEntity(name, {})}; - if (auto *type{prev.GetType()}) { - symbol.SetType(*type); - symbol.set(Symbol::Flag::Implicit, prev.test(Symbol::Flag::Implicit)); - } + Symbol &symbol{MakeSymbol(name, HostAssocDetails{prev})}; + name.symbol = &symbol; return &symbol; } diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt index 4873a0f..c292824 100644 --- a/flang/test/semantics/CMakeLists.txt +++ b/flang/test/semantics/CMakeLists.txt @@ -101,6 +101,7 @@ set(ERROR_TESTS resolve68.f90 resolve69.f90 resolve70.f90 + resolve71.f90 stop01.f90 structconst01.f90 structconst02.f90 diff --git a/flang/test/semantics/allocate01.f90 b/flang/test/semantics/allocate01.f90 index 137286e..6944e2b 100644 --- a/flang/test/semantics/allocate01.f90 +++ b/flang/test/semantics/allocate01.f90 @@ -16,7 +16,8 @@ module m contains function mfoo(x) - class(a_type) :: foo, x + class(a_type) :: x + class(a_type), allocatable :: foo foo = x end function subroutine mbar(x) diff --git a/flang/test/semantics/allocate09.f90 b/flang/test/semantics/allocate09.f90 index 49736f9..e47cd81 100644 --- a/flang/test/semantics/allocate09.f90 +++ b/flang/test/semantics/allocate09.f90 @@ -24,7 +24,7 @@ subroutine C946(param_ca_4_assumed, param_ta_4_assumed, param_ca_4_deferred) real(kind=4) srcx, srcx_array(10) real(kind=8) srcx8, srcx8_array(10) - class(WithParam(4, 2)) src_a_4_2 + class(WithParam(4, 2)), allocatable :: src_a_4_2 type(WithParam(8, 2)) src_a_8_2 class(WithParam(4, :)), allocatable :: src_a_4_def class(WithParam(8, :)), allocatable :: src_a_8_def @@ -33,8 +33,10 @@ subroutine C946(param_ca_4_assumed, param_ta_4_assumed, param_ca_4_deferred) type(WithParamExtent(8, 2, 8, 3)) src_b_8_2_8_3 class(WithParamExtent(8, :, 8, 3)), allocatable :: src_b_8_def_8_3 type(WithParamExtent2(k1=4, l1=5, k2=5, l2=6, l3=8 )) src_c_4_5_5_6_8_8 - class(WithParamExtent2(k1=4, l1=2, k2=5, l2=6, k3=5, l3=8)) src_c_4_2_5_6_5_8 - class(WithParamExtent2(k2=5, l2=6, k3=5, l3=8)) src_c_1_2_5_6_5_8 + class(WithParamExtent2(k1=4, l1=2, k2=5, l2=6, k3=5, l3=8)), & + allocatable :: src_c_4_2_5_6_5_8 + class(WithParamExtent2(k2=5, l2=6, k3=5, l3=8)), & + allocatable :: src_c_1_2_5_6_5_8 type(WithParamExtent2(k1=5, l1=5, k2=5, l2=6, l3=8 )) src_c_5_5_5_6_8_8 type(WithParamExtent2(k1=5, l1=2, k2=5, l2=6, k3=5, l3=8)) src_c_5_2_5_6_5_8 diff --git a/flang/test/semantics/resolve44.f90 b/flang/test/semantics/resolve44.f90 index af6a40d..f6e7a89 100644 --- a/flang/test/semantics/resolve44.f90 +++ b/flang/test/semantics/resolve44.f90 @@ -7,6 +7,7 @@ program main type(recursive1), pointer :: ok1 type(recursive1), allocatable :: ok2 !ERROR: Recursive use of the derived type requires POINTER or ALLOCATABLE + !ERROR: CLASS entity 'bad2' must be a dummy argument or have ALLOCATABLE or POINTER attribute class(recursive1) :: bad2 class(recursive1), pointer :: ok3 class(recursive1), allocatable :: ok4 @@ -19,6 +20,7 @@ program main type(recursive2(kind,len)), pointer :: ok1 type(recursive2(kind,len)), allocatable :: ok2 !ERROR: Recursive use of the derived type requires POINTER or ALLOCATABLE + !ERROR: CLASS entity 'bad2' must be a dummy argument or have ALLOCATABLE or POINTER attribute class(recursive2(kind,len)) :: bad2 class(recursive2(kind,len)), pointer :: ok3 class(recursive2(kind,len)), allocatable :: ok4 @@ -31,6 +33,7 @@ program main type(recursive3), pointer :: ok1 type(recursive3), allocatable :: ok2 !ERROR: Recursive use of the derived type requires POINTER or ALLOCATABLE + !ERROR: CLASS entity 'bad2' must be a dummy argument or have ALLOCATABLE or POINTER attribute class(recursive3) :: bad2 class(recursive3), pointer :: ok3 class(recursive3), allocatable :: ok4 diff --git a/flang/test/semantics/resolve70.f90 b/flang/test/semantics/resolve70.f90 index b771fd0..8824ea4 100644 --- a/flang/test/semantics/resolve70.f90 +++ b/flang/test/semantics/resolve70.f90 @@ -51,8 +51,8 @@ subroutine s1() end type ! This one's OK - class(extensible) :: y + class(extensible), allocatable :: y !ERROR: Non-extensible derived type 'inextensible' may not be used with CLASS keyword - class(inextensible) :: x + class(inextensible), allocatable :: x end subroutine s1 diff --git a/flang/test/semantics/resolve71.f90 b/flang/test/semantics/resolve71.f90 new file mode 100644 index 0000000..d570233 --- /dev/null +++ b/flang/test/semantics/resolve71.f90 @@ -0,0 +1,23 @@ +! C708 An entity declared with the CLASS keyword shall be a dummy argument +! or have the ALLOCATABLE or POINTER attribute. +subroutine s() + type :: parentType + end type + + class(parentType), pointer :: pvar + class(parentType), allocatable :: avar + class(*), allocatable :: starAllocatableVar + class(*), pointer :: starPointerVar + !ERROR: CLASS entity 'barevar' must be a dummy argument or have ALLOCATABLE or POINTER attribute + class(parentType) :: bareVar + !ERROR: CLASS entity 'starvar' must be a dummy argument or have ALLOCATABLE or POINTER attribute + class(*) :: starVar + + contains + subroutine inner(arg1, arg2, arg3, arg4, arg5) + class (parenttype) :: arg1, arg3 + type(parentType) :: arg2 + class (parenttype), pointer :: arg4 + class (parenttype), allocatable :: arg5 + end subroutine inner +end subroutine s diff --git a/flang/test/semantics/symbol09.f90 b/flang/test/semantics/symbol09.f90 index 480f719..8dca133 100644 --- a/flang/test/semantics/symbol09.f90 +++ b/flang/test/semantics/symbol09.f90 @@ -104,8 +104,8 @@ subroutine s6 !DEF: /s6/a ObjectEntity INTEGER(4) integer :: a(5) = 1 !DEF: /s6/Block1/i ObjectEntity INTEGER(4) - !DEF: /s6/Block1/j (LocalityLocal) ObjectEntity INTEGER(8) - !DEF: /s6/Block1/k (Implicit, LocalityLocalInit) ObjectEntity INTEGER(4) + !DEF: /s6/Block1/j (LocalityLocal) HostAssoc INTEGER(8) + !DEF: /s6/Block1/k (LocalityLocalInit) HostAssoc INTEGER(4) !DEF: /s6/Block1/a (LocalityShared) HostAssoc INTEGER(4) do concurrent(integer::i=1:5)local(j)local_init(k)shared(a) !REF: /s6/Block1/a