diff --git a/flang/include/flang/Common/Fortran-consts.h b/flang/include/flang/Common/Fortran-consts.h index 466fc8a5cf4b..599e0b25d98a 100644 --- a/flang/include/flang/Common/Fortran-consts.h +++ b/flang/include/flang/Common/Fortran-consts.h @@ -28,6 +28,10 @@ ENUM_CLASS(IoStmtKind, None, Backspace, Close, Endfile, Flush, Inquire, Open, ENUM_CLASS( DefinedIo, ReadFormatted, ReadUnformatted, WriteFormatted, WriteUnformatted) +// Vector type categories for DerivedTypeSpec +ENUM_CLASS( + VectorTypeCategory, DerivedType, IntrinsicVector, PairVector, QuadVector) + RT_OFFLOAD_VAR_GROUP_BEGIN // Fortran arrays may have up to 15 dimensions (See Fortran 2018 section 5.4.6). static constexpr int maxRank{15}; diff --git a/flang/include/flang/Support/Fortran.h b/flang/include/flang/Support/Fortran.h index c71e1164ef3a..057b0c3da8c4 100644 --- a/flang/include/flang/Support/Fortran.h +++ b/flang/include/flang/Support/Fortran.h @@ -103,6 +103,10 @@ bool AreCompatibleCUDADataAttrs(std::optional, bool isHostDeviceProcedure, const LanguageFeatureControl *features = nullptr); +// Format vector type as Fortran string +std::string FormatVectorTypeAsFortran( + int category, int64_t elementCategory, int64_t elementKind); + static constexpr char blankCommonObjectName[] = "__BLNK__"; // Get the assembly name for a non BIND(C) external symbol other than the blank diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp index f6595baee260..360448425419 100644 --- a/flang/lib/Evaluate/formatting.cpp +++ b/flang/lib/Evaluate/formatting.cpp @@ -20,6 +20,9 @@ namespace Fortran::evaluate { +// Forward declaration for static helper function +static std::string FormatVectorType(const semantics::DerivedTypeSpec &); + // Constant arrays can have non-default lower bounds, but this can't be // expressed in Fortran syntax directly, only implied through the use of // named constant (PARAMETER) definitions. For debugging, setting this flag @@ -676,6 +679,9 @@ llvm::raw_ostream &StructureConstructor::AsFortran(llvm::raw_ostream &o) const { std::string DynamicType::AsFortran() const { if (derived_) { CHECK(category_ == TypeCategory::Derived); + if (derived_->IsVectorType()) { + return FormatVectorType(*derived_); + } std::string result{DerivedTypeSpecAsFortran(*derived_)}; if (IsPolymorphic()) { result = "CLASS("s + result + ')'; @@ -884,6 +890,25 @@ llvm::raw_ostream &Assignment::AsFortran(llvm::raw_ostream &o) const { return o; } +static std::string FormatVectorType(const semantics::DerivedTypeSpec &derived) { + int64_t vecElemKind{0}; + int64_t vecElemCategory{-1}; + + if (derived.category() == + semantics::DerivedTypeSpec::Category::IntrinsicVector) { + for (const auto &pair : derived.parameters()) { + if (pair.first == "element_category") { + vecElemCategory = ToInt64(pair.second.GetExplicit()).value_or(-1); + } else if (pair.first == "element_kind") { + vecElemKind = ToInt64(pair.second.GetExplicit()).value_or(0); + } + } + } + + return common::FormatVectorTypeAsFortran( + static_cast(derived.category()), vecElemCategory, vecElemKind); +} + #ifdef _MSC_VER // disable bogus warning about missing definitions #pragma warning(disable : 4661) #endif diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 8ee0613bdfc5..ceca9436e267 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -5538,7 +5538,9 @@ std::string ArgumentAnalyzer::TypeAsFortran(std::size_t i) { : type->IsUnlimitedPolymorphic() ? "CLASS(*)"s : type->IsPolymorphic() ? type->AsFortran() : type->category() == TypeCategory::Derived - ? "TYPE("s + type->AsFortran() + ')' + ? (type->GetDerivedTypeSpec().IsVectorType() + ? type->AsFortran() + : "TYPE("s + type->AsFortran() + ')') : type->category() == TypeCategory::Character ? "CHARACTER(KIND="s + std::to_string(type->kind()) + ')' : ToUpperCase(type->AsFortran()); diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp index f2c1637a604a..cddb83fe6aca 100644 --- a/flang/lib/Semantics/type.cpp +++ b/flang/lib/Semantics/type.cpp @@ -758,15 +758,10 @@ const DeclTypeSpec *CloneDerivedTypeForUseDevice(Scope &containingScope, } std::string DerivedTypeSpec::VectorTypeAsFortran() const { - std::string buf; - llvm::raw_string_ostream ss{buf}; - - switch (category()) { - SWITCH_COVERS_ALL_CASES - case (Fortran::semantics::DerivedTypeSpec::Category::IntrinsicVector): { - int64_t vecElemKind; - int64_t vecElemCategory; + int64_t vecElemKind{0}; + int64_t vecElemCategory{-1}; + if (category() == Category::IntrinsicVector) { for (const auto &pair : parameters()) { if (pair.first == "element_category") { vecElemCategory = @@ -776,39 +771,10 @@ std::string DerivedTypeSpec::VectorTypeAsFortran() const { Fortran::evaluate::ToInt64(pair.second.GetExplicit()).value_or(0); } } - - assert((vecElemCategory >= 0 && - static_cast(vecElemCategory) < - Fortran::common::VectorElementCategory_enumSize) && - "Vector element type is not specified"); - assert(vecElemKind && "Vector element kind is not specified"); - - ss << "vector("; - switch (static_cast(vecElemCategory)) { - SWITCH_COVERS_ALL_CASES - case common::VectorElementCategory::Integer: - ss << "integer(" << vecElemKind << ")"; - break; - case common::VectorElementCategory::Unsigned: - ss << "unsigned(" << vecElemKind << ")"; - break; - case common::VectorElementCategory::Real: - ss << "real(" << vecElemKind << ")"; - break; - } - ss << ")"; - break; } - case (Fortran::semantics::DerivedTypeSpec::Category::PairVector): - ss << "__vector_pair"; - break; - case (Fortran::semantics::DerivedTypeSpec::Category::QuadVector): - ss << "__vector_quad"; - break; - case (Fortran::semantics::DerivedTypeSpec::Category::DerivedType): - Fortran::common::die("Vector element type not implemented"); - } - return buf; + + return common::FormatVectorTypeAsFortran( + static_cast(category()), vecElemCategory, vecElemKind); } std::string DerivedTypeSpec::AsFortran() const { diff --git a/flang/lib/Support/Fortran.cpp b/flang/lib/Support/Fortran.cpp index 39a3d64a464f..e3263df9fcbf 100644 --- a/flang/lib/Support/Fortran.cpp +++ b/flang/lib/Support/Fortran.cpp @@ -8,6 +8,7 @@ #include "flang/Support/Fortran.h" #include "flang/Support/Fortran-features.h" +#include "llvm/Support/raw_ostream.h" namespace Fortran::common { @@ -181,4 +182,39 @@ bool AreCompatibleCUDADataAttrs(std::optional x, } } +std::string FormatVectorTypeAsFortran( + int category, int64_t elementCategory, int64_t elementKind) { + std::string buf; + llvm::raw_string_ostream ss{buf}; + + switch (static_cast(category)) { + case (VectorTypeCategory::IntrinsicVector): { + CHECK(elementCategory >= 0 && elementKind > 0); + ss << "vector("; + switch (static_cast(elementCategory)) { + case VectorElementCategory::Integer: + ss << "integer(" << elementKind << ")"; + break; + case VectorElementCategory::Unsigned: + ss << "unsigned(" << elementKind << ")"; + break; + case VectorElementCategory::Real: + ss << "real(" << elementKind << ")"; + break; + } + ss << ")"; + break; + } + case (VectorTypeCategory::PairVector): + ss << "__vector_pair"; + break; + case (VectorTypeCategory::QuadVector): + ss << "__vector_quad"; + break; + default: + CHECK(false && "Vector element type not implemented"); + } + return buf; +} + } // namespace Fortran::common diff --git a/flang/test/Semantics/PowerPC/ppc-vector-diagnostics.f90 b/flang/test/Semantics/PowerPC/ppc-vector-diagnostics.f90 new file mode 100644 index 000000000000..636c3a764f05 --- /dev/null +++ b/flang/test/Semantics/PowerPC/ppc-vector-diagnostics.f90 @@ -0,0 +1,15 @@ +! RUN: %python %S/../test_errors.py %s %flang_fc1 +! REQUIRES: target=powerpc{{.*}} + +subroutine test_vector_add() + vector(integer(4)) :: v1, v2 + !ERROR: Operands of + must be numeric; have vector(integer(4)) and vector(integer(4)) + v1 = v1 + v2 +end subroutine + +subroutine test_vector_assignment() + vector(integer(4)) :: v1 + vector(real(4)) :: v2 + !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types vector(integer(4)) and vector(real(4)) + v1 = v2 +end subroutine