diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h --- a/flang/include/flang/Evaluate/type.h +++ b/flang/include/flang/Evaluate/type.h @@ -465,6 +465,8 @@ std::optional ComparisonType( const DynamicType &, const DynamicType &); +bool IsInteroperableIntrinsicType(const DynamicType &); + // For generating "[extern] template class", &c. boilerplate #define EXPAND_FOR_EACH_INTEGER_KIND(M, P, S) \ M(P, S, 1) M(P, S, 2) M(P, S, 4) M(P, S, 8) M(P, S, 16) diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h --- a/flang/include/flang/Semantics/type.h +++ b/flang/include/flang/Semantics/type.h @@ -445,5 +445,7 @@ return const_cast(this)->AsDerived(); } +bool IsInteroperableIntrinsicType(const DeclTypeSpec &); + } // namespace Fortran::semantics #endif // FORTRAN_SEMANTICS_TYPE_H_ diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp --- a/flang/lib/Evaluate/type.cpp +++ b/flang/lib/Evaluate/type.cpp @@ -574,4 +574,21 @@ } } +bool IsInteroperableIntrinsicType(const DynamicType &type) { + switch (type.category()) { + case TypeCategory::Integer: + return true; + case TypeCategory::Real: + case TypeCategory::Complex: + return type.kind() >= 4; // no short or half floats + case TypeCategory::Logical: + return type.kind() == 1; // C_BOOL + case TypeCategory::Character: + return type.kind() == 1 /* C_CHAR */ && type.knownLength().value_or(0) == 1; + default: + // Derived types are tested in Semantics/check-declarations.cpp + return false; + } +} + } // namespace Fortran::evaluate diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -2211,13 +2211,21 @@ "A derived type with the BIND attribute cannot have a pointer or allocatable component"_err_en_US); context_.SetError(symbol); break; - } else if (component->GetType() && component->GetType()->AsDerived() && - !component->GetType()->AsDerived()->typeSymbol().attrs().test( - Attr::BIND_C)) { - messages_.Say(component->GetType()->AsDerived()->typeSymbol().name(), - "The component of the interoperable derived type must have the BIND attribute"_err_en_US); - context_.SetError(symbol); - break; + } else if (const auto *type{component->GetType()}) { + if (const auto *derived{type->AsDerived()}) { + if (!derived->typeSymbol().attrs().test(Attr::BIND_C)) { + messages_.Say( + component->GetType()->AsDerived()->typeSymbol().name(), + "The component of the interoperable derived type must have the BIND attribute"_err_en_US); + context_.SetError(symbol); + break; + } + } else if (!IsInteroperableIntrinsicType(*type)) { + messages_.Say(component->name(), + "Each component of an interoperable derived type must have an interoperable type"_err_en_US); + context_.SetError(symbol); + break; + } } } } diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp --- a/flang/lib/Semantics/type.cpp +++ b/flang/lib/Semantics/type.cpp @@ -11,6 +11,7 @@ #include "compute-offsets.h" #include "flang/Evaluate/fold.h" #include "flang/Evaluate/tools.h" +#include "flang/Evaluate/type.h" #include "flang/Parser/characters.h" #include "flang/Parser/parse-tree-visitor.h" #include "flang/Semantics/scope.h" @@ -795,4 +796,9 @@ return o << x.AsFortran(); } +bool IsInteroperableIntrinsicType(const DeclTypeSpec &type) { + auto dyType{evaluate::DynamicType::From(type)}; + return dyType && IsInteroperableIntrinsicType(*dyType); +} + } // namespace Fortran::semantics diff --git a/flang/test/Semantics/bind-c06.f90 b/flang/test/Semantics/bind-c06.f90 --- a/flang/test/Semantics/bind-c06.f90 +++ b/flang/test/Semantics/bind-c06.f90 @@ -62,4 +62,25 @@ integer :: z end type + type, bind(c) :: t10 + !ERROR: Each component of an interoperable derived type must have an interoperable type + character(len=2) x + end type + type, bind(c) :: t11 + !ERROR: Each component of an interoperable derived type must have an interoperable type + character(kind=2) x + end type + type, bind(c) :: t12 + !ERROR: Each component of an interoperable derived type must have an interoperable type + logical(kind=8) x + end type + type, bind(c) :: t13 + !ERROR: Each component of an interoperable derived type must have an interoperable type + real(kind=2) x + end type + type, bind(c) :: t14 + !ERROR: Each component of an interoperable derived type must have an interoperable type + complex(kind=2) x + end type + end