[flang-commits] [flang] 4148f27 - [flang] Check for non-interoperable intrinsic types in BIND(C) derived types
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Feb 13 16:53:22 PST 2023
Author: Peter Klausler
Date: 2023-02-13T16:53:08-08:00
New Revision: 4148f2768b877b38ef453c2b202f6e539e485f58
URL: https://github.com/llvm/llvm-project/commit/4148f2768b877b38ef453c2b202f6e539e485f58
DIFF: https://github.com/llvm/llvm-project/commit/4148f2768b877b38ef453c2b202f6e539e485f58.diff
LOG: [flang] Check for non-interoperable intrinsic types in BIND(C) derived types
Every component of a BIND(C) interoperable derived type must have an
interoperable type. Semantics was checking components with derived types,
but not components with intrinsic types.
Differential Revision: https://reviews.llvm.org/D143832
Added:
Modified:
flang/include/flang/Evaluate/type.h
flang/include/flang/Semantics/type.h
flang/lib/Evaluate/type.cpp
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/type.cpp
flang/test/Semantics/bind-c06.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index 6ebf54be5ba4..a37df69e6ee4 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -465,6 +465,8 @@ int SelectedCharKind(const std::string &, int defaultKind);
std::optional<DynamicType> 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
index 6277a8b729cd..76866c8e994b 100644
--- a/flang/include/flang/Semantics/type.h
+++ b/flang/include/flang/Semantics/type.h
@@ -445,5 +445,7 @@ inline const DerivedTypeSpec *DeclTypeSpec::AsDerived() const {
return const_cast<DeclTypeSpec *>(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
index 8d49f629930a..7c9219e15f7f 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -574,4 +574,21 @@ std::optional<DynamicType> ComparisonType(
}
}
+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
index 490608ba4353..caaea48825d8 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -2211,13 +2211,21 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
"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
index 04f1729e910c..bc8667e43f10 100644
--- 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 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DeclTypeSpec &x) {
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
index e24c192076c9..c0a78a03c474 100644
--- a/flang/test/Semantics/bind-c06.f90
+++ b/flang/test/Semantics/bind-c06.f90
@@ -62,4 +62,25 @@ program main
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
More information about the flang-commits
mailing list