From 702d3075acb24cd8e2ff27a492aa04e468d4e221 Mon Sep 17 00:00:00 2001 From: Pete Steinfeld Date: Mon, 10 Feb 2020 13:24:32 -0800 Subject: [PATCH] [flang] Semantic checks for constraints on types I implemented and added tests for constraints C703, C704, C705, C706, and C796. In some cases, the code and/or test already existed, and all I did was add a notation indicating the associated constraint. Original-commit: flang-compiler/f18@49a64c4c2374e930f6890b270289a6f49ba63edd Reviewed-on: https://github.com/flang-compiler/f18/pull/978 --- flang/lib/semantics/check-declarations.cpp | 2 +- flang/lib/semantics/resolve-names.cpp | 33 ++++++++++++++--- flang/test/semantics/CMakeLists.txt | 1 + flang/test/semantics/allocate04.f90 | 2 +- flang/test/semantics/resolve52.f90 | 1 + flang/test/semantics/resolve69.f90 | 9 +++++ flang/test/semantics/resolve70.f90 | 58 ++++++++++++++++++++++++++++++ flang/test/semantics/structconst01.f90 | 4 ++- 8 files changed, 103 insertions(+), 7 deletions(-) create mode 100644 flang/test/semantics/resolve70.f90 diff --git a/flang/lib/semantics/check-declarations.cpp b/flang/lib/semantics/check-declarations.cpp index a96bc6f..7cd81c9 100644 --- a/flang/lib/semantics/check-declarations.cpp +++ b/flang/lib/semantics/check-declarations.cpp @@ -495,7 +495,7 @@ void CheckHelper::CheckDerivedType( } if (const DeclTypeSpec * parent{FindParentTypeSpec(symbol)}) { const DerivedTypeSpec *parentDerived{parent->AsDerived()}; - if (!IsExtensibleType(parentDerived)) { + if (!IsExtensibleType(parentDerived)) { // C705 messages_.Say("The parent type is not extensible"_err_en_US); } if (!symbol.attrs().test(Attr::ABSTRACT) && parentDerived && diff --git a/flang/lib/semantics/resolve-names.cpp b/flang/lib/semantics/resolve-names.cpp index 197a32b..f075fa3 100644 --- a/flang/lib/semantics/resolve-names.cpp +++ b/flang/lib/semantics/resolve-names.cpp @@ -343,6 +343,7 @@ protected: } KindExpr GetKindParamExpr( TypeCategory, const std::optional &); + void CheckForAbstractType(const Symbol &typeSymbol); private: State state_; @@ -731,7 +732,9 @@ public: void Post(const parser::LengthSelector &); bool Pre(const parser::KindParam &); bool Pre(const parser::DeclarationTypeSpec::Type &); + void Post(const parser::DeclarationTypeSpec::Type &); bool Pre(const parser::DeclarationTypeSpec::Class &); + void Post(const parser::DeclarationTypeSpec::Class &); bool Pre(const parser::DeclarationTypeSpec::Record &); void Post(const parser::DerivedTypeSpec &); bool Pre(const parser::DerivedTypeDef &); @@ -1590,9 +1593,7 @@ void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) { case DeclTypeSpec::Character: typeSpec.declTypeSpec = spec; break; case DeclTypeSpec::TypeDerived: if (const DerivedTypeSpec * derived{spec->AsDerived()}) { - if (derived->typeSymbol().attrs().test(Attr::ABSTRACT)) { - Say("ABSTRACT derived type may not be used here"_err_en_US); - } + CheckForAbstractType(derived->typeSymbol()); // C703 typeSpec.declTypeSpec = spec; } break; @@ -1613,6 +1614,12 @@ void DeclTypeSpecVisitor::MakeNumericType(TypeCategory category, int kind) { SetDeclTypeSpec(context().MakeNumericType(category, kind)); } +void DeclTypeSpecVisitor::CheckForAbstractType(const Symbol &typeSymbol) { + if (typeSymbol.attrs().test(Attr::ABSTRACT)) { + Say("ABSTRACT derived type may not be used here"_err_en_US); + } +} + void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::ClassStar &) { SetDeclTypeSpec(context().globalScope().MakeClassStarType()); } @@ -3287,11 +3294,29 @@ bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Type &) { return true; } +void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Type &type) { + const parser::Name &derivedName{std::get(type.derived.t)}; + if (const Symbol * derivedSymbol{derivedName.symbol}) { + CheckForAbstractType(*derivedSymbol); // C706 + } +} + bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Class &) { SetDeclTypeSpecCategory(DeclTypeSpec::Category::ClassDerived); return true; } +void DeclarationVisitor::Post( + const parser::DeclarationTypeSpec::Class &parsedClass) { + const auto &typeName{std::get(parsedClass.derived.t)}; + if (auto spec{ResolveDerivedType(typeName)}; + spec && !IsExtensibleType(&*spec)) { // C705 + SayWithDecl(typeName, *typeName.symbol, + "Non-extensible derived type '%s' may not be used with CLASS" + " keyword"_err_en_US); + } +} + bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Record &) { // TODO return true; @@ -4501,7 +4526,7 @@ ParamValue DeclarationVisitor::GetParamValue( const parser::TypeParamValue &x, common::TypeParamAttr attr) { return std::visit( common::visitors{ - [=](const parser::ScalarIntExpr &x) { + [=](const parser::ScalarIntExpr &x) { // C704 return ParamValue{EvaluateIntExpr(x), attr}; }, [=](const parser::Star &) { return ParamValue::Assumed(attr); }, diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt index c69569b..4873a0f 100644 --- a/flang/test/semantics/CMakeLists.txt +++ b/flang/test/semantics/CMakeLists.txt @@ -100,6 +100,7 @@ set(ERROR_TESTS resolve67.f90 resolve68.f90 resolve69.f90 + resolve70.f90 stop01.f90 structconst01.f90 structconst02.f90 diff --git a/flang/test/semantics/allocate04.f90 b/flang/test/semantics/allocate04.f90 index 4ccf014..3b7ce25 100644 --- a/flang/test/semantics/allocate04.f90 +++ b/flang/test/semantics/allocate04.f90 @@ -47,7 +47,7 @@ subroutine C933_b(n) allocate(p3%y) !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is of abstract type allocate(p4(2)%y) - !WRONG allocate(Base:: u1) !C703 + !WRONG allocate(Base:: u1) ! No error expected allocate(real:: u1, u2(2)) diff --git a/flang/test/semantics/resolve52.f90 b/flang/test/semantics/resolve52.f90 index 3df7f7f..3ee41dd 100644 --- a/flang/test/semantics/resolve52.f90 +++ b/flang/test/semantics/resolve52.f90 @@ -114,6 +114,7 @@ module m7 end type contains subroutine s(x) + !ERROR: Non-extensible derived type 't' may not be used with CLASS keyword class(t) :: x end end diff --git a/flang/test/semantics/resolve69.f90 b/flang/test/semantics/resolve69.f90 index 5950f66..bf08c3a 100644 --- a/flang/test/semantics/resolve69.f90 +++ b/flang/test/semantics/resolve69.f90 @@ -1,8 +1,14 @@ subroutine s1() ! C701 (R701) The type-param-value for a kind type parameter shall be a ! constant expression. + ! ! C702 (R701) A colon shall not be used as a type-param-value except in the ! declaration of an entity that has the POINTER or ALLOCATABLE attribute. + ! + ! C704 (R703) In a declaration-type-spec, every type-param-value that is + ! not a colon or an asterisk shall be a specification expression. + ! Section 10.1.11 defines specification expressions + ! integer, parameter :: constVal = 1 integer :: nonConstVal = 1 !ERROR: Invalid specification expression: reference to local entity 'nonconstval' @@ -20,6 +26,9 @@ subroutine s1() !OK because of the allocatable attribute character(:), allocatable :: colonString3 +!ERROR: Must have INTEGER type, but is REAL(4) + character(3.5) :: badParamValue + type derived(typeKind, typeLen) integer, kind :: typeKind integer, len :: typeLen diff --git a/flang/test/semantics/resolve70.f90 b/flang/test/semantics/resolve70.f90 new file mode 100644 index 0000000..b771fd0 --- /dev/null +++ b/flang/test/semantics/resolve70.f90 @@ -0,0 +1,58 @@ +! C703 (R702) The derived-type-spec shall not specify an abstract type (7.5.7). +! This constraint refers to the derived-type-spec in a type-spec. A type-spec +! can appear in an ALLOCATE statement, an ac-spec for an array constructor, and +! in the type specifier of a TYPE GUARD statement +! +! C706 TYPE(derived-type-spec) shall not specify an abstract type (7.5.7). +! This is for a declaration-type-spec +! +! C796 (R756) The derived-type-spec shall not specify an abstract type (7.5.7). +! +! C705 (R703) In a declaration-type-spec that uses the CLASS keyword, +! derived-type-spec shall specify an extensible type (7.5.7). +subroutine s() + type, abstract :: abstractType + end type abstractType + + type, extends(abstractType) :: concreteType + end type concreteType + + ! declaration-type-spec + !ERROR: ABSTRACT derived type may not be used here + type (abstractType), allocatable :: abstractVar + + ! ac-spec for an array constructor + !ERROR: ABSTRACT derived type may not be used here + !ERROR: ABSTRACT derived type may not be used here + type (abstractType), parameter :: abstractArray(*) = (/ abstractType :: /) + + class(*), allocatable :: selector + + ! Structure constructor + !ERROR: ABSTRACT derived type may not be used here + !ERROR: ABSTRACT derived type 'abstracttype' may not be used in a structure constructor + type (abstractType) :: abstractVar1 = abstractType() + + ! Allocate statement + !ERROR: ABSTRACT derived type may not be used here + allocate(abstractType :: abstractVar) + + select type(selector) + ! Type specifier for a type guard statement + !ERROR: ABSTRACT derived type may not be used here + type is (abstractType) + end select +end subroutine s + +subroutine s1() + type :: extensible + end type + type, bind(c) :: inextensible + end type + + ! This one's OK + class(extensible) :: y + + !ERROR: Non-extensible derived type 'inextensible' may not be used with CLASS keyword + class(inextensible) :: x +end subroutine s1 diff --git a/flang/test/semantics/structconst01.f90 b/flang/test/semantics/structconst01.f90 index 5a4bd7b..a83286c 100644 --- a/flang/test/semantics/structconst01.f90 +++ b/flang/test/semantics/structconst01.f90 @@ -3,6 +3,8 @@ ! errors meant to be caught by expression semantic analysis, as well as ! acceptable use cases. ! Type parameters are used here to make the parses unambiguous. +! C796 (R756) The derived-type-spec shall not specify an abstract type (7.5.7). +! This refers to a derived-type-spec used in a structure constructor module module1 type :: type1(j) @@ -29,7 +31,7 @@ module module1 type(type2(0,0)), intent(in) :: x end subroutine type2arg subroutine abstractarg(x) - type(abstract(0)), intent(in) :: x + class(abstract(0)), intent(in) :: x end subroutine abstractarg subroutine errors call type1arg(type1(0)()) -- 2.7.4