[flang-commits] [flang] 52711fb - [flang] Make builtin types more easily accessible; use them
peter klausler via flang-commits
flang-commits at lists.llvm.org
Wed Sep 29 13:06:10 PDT 2021
Author: peter klausler
Date: 2021-09-29T13:06:01-07:00
New Revision: 52711fb8da1b0151f09c41bce1a3f0b5689ff87a
URL: https://github.com/llvm/llvm-project/commit/52711fb8da1b0151f09c41bce1a3f0b5689ff87a
DIFF: https://github.com/llvm/llvm-project/commit/52711fb8da1b0151f09c41bce1a3f0b5689ff87a.diff
LOG: [flang] Make builtin types more easily accessible; use them
Rearrange the contents of __builtin_* module files a little and
make sure that semantics implicitly USEs the module __Fortran_builtins
before processing each source file. This ensures that the special derived
types for TEAM_TYPE, EVENT_TYPE, LOCK_TYPE, &c. exist in the symbol table
where they will be available for use in coarray intrinsic function
processing.
Update IsTeamType() to exploit access to the __Fortran_builtins
module rather than applying ad hoc name tests. Move it and some
other utilities from Semantics/tools.* to Evaluate/tools.* to make
them available to intrinsics processing.
Add/correct the intrinsic table definitions for GET_TEAM, TEAM_NUMBER,
and THIS_IMAGE to exercise the built-in TEAM_TYPE as an argument and
as a result.
Add/correct/extend tests accordingly.
Differential Revision: https://reviews.llvm.org/D110356
Added:
Modified:
flang/include/flang/Evaluate/intrinsics.h
flang/include/flang/Evaluate/tools.h
flang/include/flang/Evaluate/variable.h
flang/include/flang/Semantics/semantics.h
flang/include/flang/Semantics/tools.h
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Evaluate/tools.cpp
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/mod-file.cpp
flang/lib/Semantics/mod-file.h
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/runtime-type-info.cpp
flang/lib/Semantics/semantics.cpp
flang/lib/Semantics/tools.cpp
flang/module/__fortran_builtins.f90
flang/module/__fortran_type_info.f90
flang/test/Semantics/misc-declarations.f90
flang/test/Semantics/resolve88.f90
flang/test/Semantics/this_image.f90
flang/tools/f18/CMakeLists.txt
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/intrinsics.h b/flang/include/flang/Evaluate/intrinsics.h
index 1a71d91ed560b..5e06fcba389b2 100644
--- a/flang/include/flang/Evaluate/intrinsics.h
+++ b/flang/include/flang/Evaluate/intrinsics.h
@@ -23,6 +23,10 @@ namespace llvm {
class raw_ostream;
}
+namespace Fortran::semantics {
+class Scope;
+}
+
namespace Fortran::evaluate {
class FoldingContext;
@@ -74,6 +78,9 @@ class IntrinsicProcTable {
static IntrinsicProcTable Configure(
const common::IntrinsicTypeDefaultKinds &);
+ // Make *this aware of the __Fortran_builtins module to expose TEAM_TYPE &c.
+ void SupplyBuiltins(const semantics::Scope &) const;
+
// Check whether a name should be allowed to appear on an INTRINSIC
// statement.
bool IsIntrinsic(const std::string &) const;
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 5ebf3cd3b1fd7..a6e04c2023a91 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -1050,6 +1050,15 @@ bool IsDummy(const Symbol &);
bool IsFunctionResult(const Symbol &);
bool IsKindTypeParameter(const Symbol &);
bool IsLenTypeParameter(const Symbol &);
+bool IsExtensibleType(const DerivedTypeSpec *);
+bool IsBuiltinDerivedType(const DerivedTypeSpec *derived, const char *name);
+// Is this derived type TEAM_TYPE from module ISO_FORTRAN_ENV?
+bool IsTeamType(const DerivedTypeSpec *);
+// Is this derived type TEAM_TYPE, C_PTR, or C_FUNPTR?
+bool IsBadCoarrayType(const DerivedTypeSpec *);
+// Is this derived type either C_PTR or C_FUNPTR from module ISO_C_BINDING
+bool IsIsoCType(const DerivedTypeSpec *);
+bool IsEventTypeOrLockType(const DerivedTypeSpec *);
// ResolveAssociations() traverses use associations and host associations
// like GetUltimate(), but also resolves through whole variable associations
diff --git a/flang/include/flang/Evaluate/variable.h b/flang/include/flang/Evaluate/variable.h
index 6265bed61f539..5f5e7e1911c6b 100644
--- a/flang/include/flang/Evaluate/variable.h
+++ b/flang/include/flang/Evaluate/variable.h
@@ -226,7 +226,7 @@ class ArrayRef {
// R914 coindexed-named-object
// R924 image-selector, R926 image-selector-spec.
-// C824 severely limits the usage of derived types with coarray ultimate
+// C825 severely limits the usage of derived types with coarray ultimate
// components: they can't be pointers, allocatables, arrays, coarrays, or
// function results. They can be components of other derived types.
// Although the F'2018 Standard never prohibits multiple image-selectors
diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h
index c49672ea03667..07498c46bc43f 100644
--- a/flang/include/flang/Semantics/semantics.h
+++ b/flang/include/flang/Semantics/semantics.h
@@ -174,6 +174,13 @@ class SemanticsContext {
SourceName SaveTempName(std::string &&);
SourceName GetTempName(const Scope &);
+ // Locate and process the contents of a built-in module on demand
+ Scope *GetBuiltinModule(const char *name);
+
+ // Defines builtinsScope_ from the __Fortran_builtins module
+ void UseFortranBuiltinsModule();
+ const Scope *GetBuiltinsScope() const { return builtinsScope_; }
+
private:
void CheckIndexVarRedefine(
const parser::CharBlock &, const Symbol &, parser::MessageFixedText &&);
@@ -202,6 +209,7 @@ class SemanticsContext {
activeIndexVars_;
UnorderedSymbolSet errorSymbols_;
std::set<std::string> tempNames_;
+ const Scope *builtinsScope_{nullptr}; // module __Fortran_builtins
};
class Semantics {
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 5c23bc3ad853b..e5ed412cde9dc 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -97,13 +97,6 @@ bool IsBindCProcedure(const Symbol &);
bool IsBindCProcedure(const Scope &);
bool IsProcName(const Symbol &); // proc-name
bool IsFunctionResultWithSameNameAsFunction(const Symbol &);
-bool IsExtensibleType(const DerivedTypeSpec *);
-bool IsBuiltinDerivedType(const DerivedTypeSpec *derived, const char *name);
-// Is this derived type TEAM_TYPE from module ISO_FORTRAN_ENV
-bool IsTeamType(const DerivedTypeSpec *);
-// Is this derived type either C_PTR or C_FUNPTR from module ISO_C_BINDING
-bool IsIsoCType(const DerivedTypeSpec *);
-bool IsEventTypeOrLockType(const DerivedTypeSpec *);
bool IsOrContainsEventOrLockComponent(const Symbol &);
bool CanBeTypeBoundProc(const Symbol *);
// Does a non-PARAMETER symbol have explicit initialization with =value or
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 9ba5c04300b83..f4c3d16f6be48 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -16,6 +16,7 @@
#include "flang/Evaluate/shape.h"
#include "flang/Evaluate/tools.h"
#include "flang/Evaluate/type.h"
+#include "flang/Semantics/scope.h"
#include "flang/Semantics/tools.h"
#include "llvm/Support/raw_ostream.h"
#include <algorithm>
@@ -105,7 +106,7 @@ static constexpr TypePattern DefaultChar{CharType, KindCode::defaultCharKind};
static constexpr TypePattern DefaultLogical{
LogicalType, KindCode::defaultLogicalKind};
static constexpr TypePattern BOZ{IntType, KindCode::typeless};
-static constexpr TypePattern TEAM_TYPE{IntType, KindCode::teamType};
+static constexpr TypePattern TeamType{DerivedType, KindCode::teamType};
static constexpr TypePattern DoublePrecision{
RealType, KindCode::doublePrecision};
static constexpr TypePattern DoublePrecisionComplex{
@@ -237,6 +238,8 @@ static constexpr IntrinsicDummyArgument MissingDIM{"dim",
common::Intent::In};
static constexpr IntrinsicDummyArgument OptionalMASK{"mask", AnyLogical,
Rank::conformable, Optionality::optional, common::Intent::In};
+static constexpr IntrinsicDummyArgument OptionalTEAM{
+ "team", TeamType, Rank::scalar, Optionality::optional, common::Intent::In};
struct IntrinsicInterface {
static constexpr int maxArguments{7}; // if not a MAX/MIN(...)
@@ -247,7 +250,7 @@ struct IntrinsicInterface {
IntrinsicClass intrinsicClass{IntrinsicClass::elementalFunction};
std::optional<SpecificCall> Match(const CallCharacteristics &,
const common::IntrinsicTypeDefaultKinds &, ActualArguments &,
- FoldingContext &context) const;
+ FoldingContext &context, const semantics::Scope *builtins) const;
int CountArguments() const;
llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
};
@@ -452,6 +455,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"floor", {{"a", AnyReal}, DefaultingKIND}, KINDInt},
{"fraction", {{"x", SameReal}}, SameReal},
{"gamma", {{"x", SameReal}}, SameReal},
+ {"get_team", {{"level", DefaultInt, Rank::scalar, Optionality::optional}},
+ TeamType, Rank::scalar, IntrinsicClass::transformationalFunction},
{"huge", {{"x", SameIntOrReal, Rank::anyOrAssumedRank}}, SameIntOrReal,
Rank::scalar, IntrinsicClass::inquiryFunction},
{"hypot", {{"x", OperandReal}, {"y", OperandReal}}, OperandReal},
@@ -476,10 +481,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"ichar", {{"c", AnyChar}, DefaultingKIND}, KINDInt},
{"ieor", {{"i", SameInt}, {"j", SameInt, Rank::elementalOrBOZ}}, SameInt},
{"ieor", {{"i", BOZ}, {"j", SameInt}}, SameInt},
- {"image_status",
- {{"image", SameInt},
- {"team", TEAM_TYPE, Rank::scalar, Optionality::optional}},
- DefaultInt},
+ {"image_status", {{"image", SameInt}, OptionalTEAM}, DefaultInt},
{"index",
{{"string", SameChar}, {"substring", SameChar},
{"back", AnyLogical, Rank::scalar, Optionality::optional},
@@ -746,11 +748,14 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"tan", {{"x", SameFloating}}, SameFloating},
{"tand", {{"x", SameFloating}}, SameFloating},
{"tanh", {{"x", SameFloating}}, SameFloating},
- // optional team dummy arguments needed to complete the following
- // this_image versions
- {"this_image", {{"coarray", AnyData, Rank::coarray}, OptionalDIM},
+ {"team_number", {OptionalTEAM}, DefaultInt, Rank::scalar,
+ IntrinsicClass::transformationalFunction},
+ {"this_image",
+ {{"coarray", AnyData, Rank::coarray}, RequiredDIM, OptionalTEAM},
+ DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction},
+ {"this_image", {{"coarray", AnyData, Rank::coarray}, OptionalTEAM},
DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction},
- {"this_image", {}, DefaultInt, Rank::scalar,
+ {"this_image", {OptionalTEAM}, DefaultInt, Rank::scalar,
IntrinsicClass::transformationalFunction},
{"tiny", {{"x", SameReal, Rank::anyOrAssumedRank}}, SameReal, Rank::scalar,
IntrinsicClass::inquiryFunction},
@@ -824,8 +829,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
};
// TODO: Coarray intrinsic functions
-// LCOBOUND, UCOBOUND, FAILED_IMAGES, GET_TEAM, IMAGE_INDEX,
-// STOPPED_IMAGES, TEAM_NUMBER, COSHAPE
+// LCOBOUND, UCOBOUND, FAILED_IMAGES, IMAGE_INDEX,
+// STOPPED_IMAGES, COSHAPE
// TODO: Non-standard intrinsic functions
// AND, OR, XOR, LSHIFT, RSHIFT, SHIFT, ZEXT, IZEXT,
// COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT,
@@ -1129,12 +1134,34 @@ static const IntrinsicInterface intrinsicSubroutine[]{
// TODO: Atomic intrinsic subroutines: ATOMIC_ADD &al.
// TODO: Collective intrinsic subroutines: CO_BROADCAST &al.
+// Finds a built-in derived type and returns it as a DynamicType.
+static DynamicType GetBuiltinDerivedType(
+ const semantics::Scope *builtinsScope, const char *which) {
+ if (!builtinsScope) {
+ common::die("INTERNAL: The __fortran_builtins module was not found, and "
+ "the type '%s' was required",
+ which);
+ }
+ auto iter{
+ builtinsScope->find(semantics::SourceName{which, std::strlen(which)})};
+ if (iter == builtinsScope->cend()) {
+ common::die(
+ "INTERNAL: The __fortran_builtins module does not define the type '%s'",
+ which);
+ }
+ const semantics::Symbol &symbol{*iter->second};
+ const semantics::Scope &scope{DEREF(symbol.scope())};
+ const semantics::DerivedTypeSpec &derived{DEREF(scope.derivedTypeSpec())};
+ return DynamicType{derived};
+}
+
// Intrinsic interface matching against the arguments of a particular
// procedure reference.
std::optional<SpecificCall> IntrinsicInterface::Match(
const CallCharacteristics &call,
const common::IntrinsicTypeDefaultKinds &defaults,
- ActualArguments &arguments, FoldingContext &context) const {
+ ActualArguments &arguments, FoldingContext &context,
+ const semantics::Scope *builtinsScope) const {
auto &messages{context.messages()};
// Attempt to construct a 1-1 correspondence between the dummy arguments in
// a particular intrinsic procedure's generic interface and the actual
@@ -1293,9 +1320,13 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
switch (d.typePattern.kindCode) {
case KindCode::none:
case KindCode::typeless:
- case KindCode::teamType: // TODO: TEAM_TYPE
argOk = false;
break;
+ case KindCode::teamType:
+ argOk = !type->IsUnlimitedPolymorphic() &&
+ type->category() == TypeCategory::Derived &&
+ semantics::IsTeamType(&type->GetDerivedTypeSpec());
+ break;
case KindCode::defaultIntegerKind:
argOk = type->kind() == defaults.GetDefaultKind(TypeCategory::Integer);
break;
@@ -1620,9 +1651,14 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
resultType =
DynamicType{TypeCategory::Integer, defaults.sizeIntegerKind()};
break;
+ case KindCode::teamType:
+ CHECK(result.categorySet == DerivedType);
+ CHECK(*category == TypeCategory::Derived);
+ resultType = DynamicType{
+ GetBuiltinDerivedType(builtinsScope, "__builtin_team_type")};
+ break;
case KindCode::defaultCharKind:
case KindCode::typeless:
- case KindCode::teamType:
case KindCode::any:
case KindCode::kindArg:
case KindCode::dimArg:
@@ -1728,10 +1764,20 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
dummyArgs.emplace_back(dummyArgs[sameDummyArg.value()]);
} else {
auto category{d.typePattern.categorySet.LeastElement().value()};
- characteristics::TypeAndShape typeAndShape{
- DynamicType{category, defaults.GetDefaultKind(category)}};
- dummyArgs.emplace_back(std::string{d.keyword},
- characteristics::DummyDataObject{std::move(typeAndShape)});
+ if (category == TypeCategory::Derived) {
+ // TODO: any other built-in derived types used as optional intrinsic
+ // dummies?
+ CHECK(d.typePattern.kindCode == KindCode::teamType);
+ characteristics::TypeAndShape typeAndShape{
+ GetBuiltinDerivedType(builtinsScope, "__builtin_team_type")};
+ dummyArgs.emplace_back(std::string{d.keyword},
+ characteristics::DummyDataObject{std::move(typeAndShape)});
+ } else {
+ characteristics::TypeAndShape typeAndShape{
+ DynamicType{category, defaults.GetDefaultKind(category)}};
+ dummyArgs.emplace_back(std::string{d.keyword},
+ characteristics::DummyDataObject{std::move(typeAndShape)});
+ }
}
dummyArgs.back().SetOptional();
}
@@ -1772,6 +1818,10 @@ class IntrinsicProcTable::Implementation {
}
}
+ void SupplyBuiltins(const semantics::Scope &builtins) {
+ builtinsScope_ = &builtins;
+ }
+
bool IsIntrinsic(const std::string &) const;
bool IsIntrinsicFunction(const std::string &) const;
bool IsIntrinsicSubroutine(const std::string &) const;
@@ -1779,8 +1829,8 @@ class IntrinsicProcTable::Implementation {
IntrinsicClass GetIntrinsicClass(const std::string &) const;
std::string GetGenericIntrinsicName(const std::string &) const;
- std::optional<SpecificCall> Probe(const CallCharacteristics &,
- ActualArguments &, FoldingContext &, const IntrinsicProcTable &) const;
+ std::optional<SpecificCall> Probe(
+ const CallCharacteristics &, ActualArguments &, FoldingContext &) const;
std::optional<SpecificIntrinsicFunctionInterface> IsSpecificIntrinsicFunction(
const std::string &) const;
@@ -1797,6 +1847,7 @@ class IntrinsicProcTable::Implementation {
std::multimap<std::string, const IntrinsicInterface *> genericFuncs_;
std::multimap<std::string, const SpecificIntrinsicInterface *> specificFuncs_;
std::multimap<std::string, const IntrinsicInterface *> subroutines_;
+ const semantics::Scope *builtinsScope_{nullptr};
};
bool IntrinsicProcTable::Implementation::IsIntrinsicFunction(
@@ -2228,7 +2279,7 @@ static DynamicType GetReturnType(const SpecificIntrinsicInterface &interface,
// match for a given procedure reference.
std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
const CallCharacteristics &call, ActualArguments &arguments,
- FoldingContext &context, const IntrinsicProcTable &intrinsics) const {
+ FoldingContext &context) const {
// All special cases handled here before the table probes below must
// also be recognized as special names in IsIntrinsicSubroutine().
@@ -2248,8 +2299,8 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
if (call.isSubroutineCall) {
auto subrRange{subroutines_.equal_range(call.name)};
for (auto iter{subrRange.first}; iter != subrRange.second; ++iter) {
- if (auto specificCall{
- iter->second->Match(call, defaults_, arguments, context)}) {
+ if (auto specificCall{iter->second->Match(
+ call, defaults_, arguments, context, builtinsScope_)}) {
return specificCall;
}
}
@@ -2270,8 +2321,8 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
auto matchOrBufferMessages{
[&](const IntrinsicInterface &intrinsic,
parser::Messages &buffer) -> std::optional<SpecificCall> {
- if (auto specificCall{
- intrinsic.Match(call, defaults_, arguments, localContext)}) {
+ if (auto specificCall{intrinsic.Match(
+ call, defaults_, arguments, localContext, builtinsScope_)}) {
if (finalBuffer) {
finalBuffer->Annex(std::move(localBuffer));
}
@@ -2416,35 +2467,40 @@ IntrinsicProcTable IntrinsicProcTable::Configure(
return result;
}
+void IntrinsicProcTable::SupplyBuiltins(
+ const semantics::Scope &builtins) const {
+ DEREF(impl_.get()).SupplyBuiltins(builtins);
+}
+
bool IntrinsicProcTable::IsIntrinsic(const std::string &name) const {
- return DEREF(impl_).IsIntrinsic(name);
+ return DEREF(impl_.get()).IsIntrinsic(name);
}
bool IntrinsicProcTable::IsIntrinsicFunction(const std::string &name) const {
- return DEREF(impl_).IsIntrinsicFunction(name);
+ return DEREF(impl_.get()).IsIntrinsicFunction(name);
}
bool IntrinsicProcTable::IsIntrinsicSubroutine(const std::string &name) const {
- return DEREF(impl_).IsIntrinsicSubroutine(name);
+ return DEREF(impl_.get()).IsIntrinsicSubroutine(name);
}
IntrinsicClass IntrinsicProcTable::GetIntrinsicClass(
const std::string &name) const {
- return DEREF(impl_).GetIntrinsicClass(name);
+ return DEREF(impl_.get()).GetIntrinsicClass(name);
}
std::string IntrinsicProcTable::GetGenericIntrinsicName(
const std::string &name) const {
- return DEREF(impl_).GetGenericIntrinsicName(name);
+ return DEREF(impl_.get()).GetGenericIntrinsicName(name);
}
std::optional<SpecificCall> IntrinsicProcTable::Probe(
const CallCharacteristics &call, ActualArguments &arguments,
FoldingContext &context) const {
- return DEREF(impl_).Probe(call, arguments, context, *this);
+ return DEREF(impl_.get()).Probe(call, arguments, context);
}
std::optional<SpecificIntrinsicFunctionInterface>
IntrinsicProcTable::IsSpecificIntrinsicFunction(const std::string &name) const {
- return DEREF(impl_).IsSpecificIntrinsicFunction(name);
+ return DEREF(impl_.get()).IsSpecificIntrinsicFunction(name);
}
llvm::raw_ostream &TypePattern::Dump(llvm::raw_ostream &o) const {
@@ -2510,7 +2566,7 @@ llvm::raw_ostream &IntrinsicProcTable::Implementation::Dump(
}
llvm::raw_ostream &IntrinsicProcTable::Dump(llvm::raw_ostream &o) const {
- return impl_->Dump(o);
+ return DEREF(impl_.get()).Dump(o);
}
// In general C846 prohibits allocatable coarrays to be passed to INTENT(OUT)
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index bf50eb99e1267..e8a93260487fe 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1186,6 +1186,40 @@ bool IsLenTypeParameter(const Symbol &symbol) {
return param && param->attr() == common::TypeParamAttr::Len;
}
+bool IsExtensibleType(const DerivedTypeSpec *derived) {
+ return derived && !IsIsoCType(derived) &&
+ !derived->typeSymbol().attrs().test(Attr::BIND_C) &&
+ !derived->typeSymbol().get<DerivedTypeDetails>().sequence();
+}
+
+bool IsBuiltinDerivedType(const DerivedTypeSpec *derived, const char *name) {
+ if (!derived) {
+ return false;
+ } else {
+ const auto &symbol{derived->typeSymbol()};
+ return &symbol.owner() == symbol.owner().context().GetBuiltinsScope() &&
+ symbol.name() == "__builtin_"s + name;
+ }
+}
+
+bool IsIsoCType(const DerivedTypeSpec *derived) {
+ return IsBuiltinDerivedType(derived, "c_ptr") ||
+ IsBuiltinDerivedType(derived, "c_funptr");
+}
+
+bool IsTeamType(const DerivedTypeSpec *derived) {
+ return IsBuiltinDerivedType(derived, "team_type");
+}
+
+bool IsBadCoarrayType(const DerivedTypeSpec *derived) {
+ return IsTeamType(derived) || IsIsoCType(derived);
+}
+
+bool IsEventTypeOrLockType(const DerivedTypeSpec *derivedTypeSpec) {
+ return IsBuiltinDerivedType(derivedTypeSpec, "event_type") ||
+ IsBuiltinDerivedType(derivedTypeSpec, "lock_type");
+}
+
int CountLenParameters(const DerivedTypeSpec &type) {
return std::count_if(type.parameters().begin(), type.parameters().end(),
[](const auto &pair) { return pair.second.isLen(); });
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 33a8b19690f6d..2ff39ee2b812b 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -455,24 +455,30 @@ void CheckHelper::CheckObjectEntity(
CheckAssumedTypeEntity(symbol, details);
WarnMissingFinal(symbol);
if (!details.coshape().empty()) {
- bool isDeferredShape{details.coshape().IsDeferredShape()};
+ bool isDeferredCoshape{details.coshape().IsDeferredShape()};
if (IsAllocatable(symbol)) {
- if (!isDeferredShape) { // C827
+ if (!isDeferredCoshape) { // C827
messages_.Say("'%s' is an ALLOCATABLE coarray and must have a deferred"
" coshape"_err_en_US,
symbol.name());
}
} else if (symbol.owner().IsDerivedType()) { // C746
std::string deferredMsg{
- isDeferredShape ? "" : " and have a deferred coshape"};
+ isDeferredCoshape ? "" : " and have a deferred coshape"};
messages_.Say("Component '%s' is a coarray and must have the ALLOCATABLE"
" attribute%s"_err_en_US,
symbol.name(), deferredMsg);
} else {
if (!details.coshape().IsAssumedSize()) { // C828
messages_.Say(
- "Component '%s' is a non-ALLOCATABLE coarray and must have"
- " an explicit coshape"_err_en_US,
+ "'%s' is a non-ALLOCATABLE coarray and must have an explicit coshape"_err_en_US,
+ symbol.name());
+ }
+ }
+ if (const DeclTypeSpec * type{details.type()}) {
+ if (IsBadCoarrayType(type->AsDerived())) { // C747 & C824
+ messages_.Say(
+ "Coarray '%s' may not have type TEAM_TYPE, C_PTR, or C_FUNPTR"_err_en_US,
symbol.name());
}
}
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index fd372cb76bfe7..da3f2750c99df 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -3083,7 +3083,7 @@ MaybeExpr ExpressionAnalyzer::MakeFunctionRef(
parser::CharBlock intrinsic, ActualArguments &&arguments) {
if (std::optional<SpecificCall> specificCall{
context_.intrinsics().Probe(CallCharacteristics{intrinsic.ToString()},
- arguments, context_.foldingContext())}) {
+ arguments, GetFoldingContext())}) {
return MakeFunctionRef(intrinsic,
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
std::move(specificCall->arguments));
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index e93e4fbf1935a..32917d37fd99d 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -805,7 +805,8 @@ static bool VerifyHeader(llvm::ArrayRef<char> content) {
return expectSum == actualSum;
}
-Scope *ModFileReader::Read(const SourceName &name, Scope *ancestor) {
+Scope *ModFileReader::Read(
+ const SourceName &name, Scope *ancestor, bool silent) {
std::string ancestorName; // empty for module
if (ancestor) {
if (auto *scope{ancestor->FindSubmodule(name)}) {
@@ -826,10 +827,12 @@ Scope *ModFileReader::Read(const SourceName &name, Scope *ancestor) {
auto path{ModFileName(name, ancestorName, context_.moduleFileSuffix())};
const auto *sourceFile{parsing.Prescan(path, options)};
if (parsing.messages().AnyFatalError()) {
- for (auto &msg : parsing.messages().messages()) {
- std::string str{msg.ToString()};
- Say(name, ancestorName, parser::MessageFixedText{str.c_str(), str.size()},
- path);
+ if (!silent) {
+ for (auto &msg : parsing.messages().messages()) {
+ std::string str{msg.ToString()};
+ Say(name, ancestorName,
+ parser::MessageFixedText{str.c_str(), str.size()}, path);
+ }
}
return nullptr;
}
diff --git a/flang/lib/Semantics/mod-file.h b/flang/lib/Semantics/mod-file.h
index 08bf2e864ffa1..fb8e6a070fa2b 100644
--- a/flang/lib/Semantics/mod-file.h
+++ b/flang/lib/Semantics/mod-file.h
@@ -70,7 +70,8 @@ class ModFileReader {
// Find and read the module file for a module or submodule.
// If ancestor is specified, look for a submodule of that module.
// Return the Scope for that module/submodule or nullptr on error.
- Scope *Read(const SourceName &, Scope *ancestor = nullptr);
+ Scope *Read(
+ const SourceName &, Scope *ancestor = nullptr, bool silent = false);
private:
SemanticsContext &context_;
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 7a8b0b5daffa3..21f0b4fb46ec1 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -4224,17 +4224,7 @@ void DeclarationVisitor::Post(const parser::ComponentDecl &x) {
"POINTER or ALLOCATABLE"_err_en_US);
}
}
- if (!coarraySpec().empty()) { // C747
- if (IsTeamType(derived)) {
- Say("A coarray component may not be of type TEAM_TYPE from "
- "ISO_FORTRAN_ENV"_err_en_US);
- } else {
- if (IsIsoCType(derived)) {
- Say("A coarray component may not be of type C_PTR or C_FUNPTR from "
- "ISO_C_BINDING"_err_en_US);
- }
- }
- }
+ // TODO: This would be more appropriate in CheckDerivedType()
if (auto it{FindCoarrayUltimateComponent(*derived)}) { // C748
std::string ultimateName{it.BuildResultDesignatorName()};
// Strip off the leading "%"
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index e7879c72060c2..ddda7d1e7a8eb 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -1071,11 +1071,8 @@ void RuntimeTableBuilder::IncorporateDefinedIoGenericInterfaces(
RuntimeDerivedTypeTables BuildRuntimeDerivedTypeTables(
SemanticsContext &context) {
- ModFileReader reader{context};
RuntimeDerivedTypeTables result;
- static const char schemataName[]{"__fortran_type_info"};
- SourceName schemataModule{schemataName, std::strlen(schemataName)};
- result.schemata = reader.Read(schemataModule);
+ result.schemata = context.GetBuiltinModule("__fortran_type_info");
if (result.schemata) {
RuntimeTableBuilder builder{context, result};
builder.DescribeTypes(context.globalScope(), false);
diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
index 24bc5e3ea8160..89a4e22f46b4e 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -342,7 +342,35 @@ SourceName SemanticsContext::GetTempName(const Scope &scope) {
return SaveTempName(".F18."s + std::to_string(tempNames_.size()));
}
+Scope *SemanticsContext::GetBuiltinModule(const char *name) {
+ return ModFileReader{*this}.Read(
+ SourceName{name, std::strlen(name)}, nullptr, true /*silence errors*/);
+}
+
+void SemanticsContext::UseFortranBuiltinsModule() {
+ if (builtinsScope_ == nullptr) {
+ builtinsScope_ = GetBuiltinModule("__fortran_builtins");
+ if (builtinsScope_) {
+ intrinsics_.SupplyBuiltins(*builtinsScope_);
+ }
+ }
+}
+
bool Semantics::Perform() {
+ // Implicitly USE the __Fortran_builtins module so that special types
+ // (e.g., __builtin_team_type) are available to semantics, esp. for
+ // intrinsic checking.
+ if (!program_.v.empty()) {
+ const auto *frontModule{std::get_if<common::Indirection<parser::Module>>(
+ &program_.v.front().u)};
+ if (frontModule &&
+ std::get<parser::Statement<parser::ModuleStmt>>(frontModule->value().t)
+ .statement.v.source == "__fortran_builtins") {
+ // Don't try to read the builtins module when we're actually building it.
+ } else {
+ context_.UseFortranBuiltinsModule();
+ }
+ }
return ValidateLabels(context_, program_) &&
parser::CanonicalizeDo(program_) && // force line break
CanonicalizeAcc(context_.messages(), program_) &&
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 69d63310ca1bc..46b4c912695f7 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -519,38 +519,6 @@ const EquivalenceSet *FindEquivalenceSet(const Symbol &symbol) {
return nullptr;
}
-bool IsExtensibleType(const DerivedTypeSpec *derived) {
- return derived && !IsIsoCType(derived) &&
- !derived->typeSymbol().attrs().test(Attr::BIND_C) &&
- !derived->typeSymbol().get<DerivedTypeDetails>().sequence();
-}
-
-bool IsBuiltinDerivedType(const DerivedTypeSpec *derived, const char *name) {
- if (!derived) {
- return false;
- } else {
- const auto &symbol{derived->typeSymbol()};
- return symbol.owner().IsModule() &&
- (symbol.owner().GetName().value() == "__fortran_builtins" ||
- symbol.owner().GetName().value() == "__fortran_type_info") &&
- symbol.name() == "__builtin_"s + name;
- }
-}
-
-bool IsIsoCType(const DerivedTypeSpec *derived) {
- return IsBuiltinDerivedType(derived, "c_ptr") ||
- IsBuiltinDerivedType(derived, "c_funptr");
-}
-
-bool IsTeamType(const DerivedTypeSpec *derived) {
- return IsBuiltinDerivedType(derived, "team_type");
-}
-
-bool IsEventTypeOrLockType(const DerivedTypeSpec *derivedTypeSpec) {
- return IsBuiltinDerivedType(derivedTypeSpec, "event_type") ||
- IsBuiltinDerivedType(derivedTypeSpec, "lock_type");
-}
-
bool IsOrContainsEventOrLockComponent(const Symbol &original) {
const Symbol &symbol{ResolveAssociations(original)};
if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
diff --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90
index aaaa1eb0e6515..f76e648dc2a8d 100644
--- a/flang/module/__fortran_builtins.f90
+++ b/flang/module/__fortran_builtins.f90
@@ -12,8 +12,6 @@
! standard names of the procedures.
module __Fortran_builtins
- use __Fortran_type_info, only: __builtin_c_ptr, __builtin_c_funptr
-
intrinsic :: __builtin_c_f_pointer
intrinsic :: sizeof ! extension
@@ -21,6 +19,14 @@
private :: selected_int_kind
integer, parameter, private :: int64 = selected_int_kind(18)
+ type :: __builtin_c_ptr
+ integer(kind=int64) :: __address
+ end type
+
+ type :: __builtin_c_funptr
+ integer(kind=int64) :: __address
+ end type
+
type :: __builtin_event_type
integer(kind=int64) :: __count
end type
@@ -44,4 +50,12 @@
__builtin_ieee_support_standard, __builtin_ieee_support_subnormal, &
__builtin_ieee_support_underflow_control
+ type, private :: __force_derived_type_instantiations
+ type(__builtin_c_ptr) :: c_ptr
+ type(__builtin_c_funptr) :: c_funptr
+ type(__builtin_event_type) :: event_type
+ type(__builtin_lock_type) :: lock_type
+ type(__builtin_team_type) :: team_type
+ end type
+
end module
diff --git a/flang/module/__fortran_type_info.f90 b/flang/module/__fortran_type_info.f90
index f3a5904728983..554038c47f0f3 100644
--- a/flang/module/__fortran_type_info.f90
+++ b/flang/module/__fortran_type_info.f90
@@ -13,18 +13,12 @@
module __Fortran_type_info
+ use __Fortran_builtins, only: __builtin_c_ptr, __builtin_c_funptr
+
private
integer, parameter :: int64 = selected_int_kind(18)
- type, public :: __builtin_c_ptr
- integer(kind=int64) :: __address
- end type
-
- type, public :: __builtin_c_funptr
- integer(kind=int64) :: __address
- end type
-
type :: DerivedType
! "TBP" bindings appear first. Inherited bindings, with overrides already
! applied, appear in the initial entries in the same order as they
diff --git a/flang/test/Semantics/misc-declarations.f90 b/flang/test/Semantics/misc-declarations.f90
index 485b82d36062b..ec8eb7a7e924d 100644
--- a/flang/test/Semantics/misc-declarations.f90
+++ b/flang/test/Semantics/misc-declarations.f90
@@ -6,7 +6,7 @@
module m
!ERROR: 'mustbedeferred' is an ALLOCATABLE coarray and must have a deferred coshape
real, allocatable :: mustBeDeferred[*] ! C827
- !ERROR: Component 'mustbeexplicit' is a non-ALLOCATABLE coarray and must have an explicit coshape
+ !ERROR: 'mustbeexplicit' is a non-ALLOCATABLE coarray and must have an explicit coshape
real :: mustBeExplicit[:] ! C828
type :: hasCoarray
real, allocatable :: coarray[:]
diff --git a/flang/test/Semantics/resolve88.f90 b/flang/test/Semantics/resolve88.f90
index c02561ffa29b6..3794e9b28a6d3 100644
--- a/flang/test/Semantics/resolve88.f90
+++ b/flang/test/Semantics/resolve88.f90
@@ -41,17 +41,17 @@ module m
end type goodC_funptrCoarrayType
type team_typeCoarrayType
- !ERROR: A coarray component may not be of type TEAM_TYPE from ISO_FORTRAN_ENV
+ !ERROR: Coarray 'field' may not have type TEAM_TYPE, C_PTR, or C_FUNPTR
type(team_type), allocatable, codimension[:] :: field
end type team_typeCoarrayType
type c_ptrCoarrayType
- !ERROR: A coarray component may not be of type C_PTR or C_FUNPTR from ISO_C_BINDING
+ !ERROR: Coarray 'field' may not have type TEAM_TYPE, C_PTR, or C_FUNPTR
type(c_ptr), allocatable, codimension[:] :: field
end type c_ptrCoarrayType
type c_funptrCoarrayType
- !ERROR: A coarray component may not be of type C_PTR or C_FUNPTR from ISO_C_BINDING
+ !ERROR: Coarray 'field' may not have type TEAM_TYPE, C_PTR, or C_FUNPTR
type(c_funptr), allocatable, codimension[:] :: field
end type c_funptrCoarrayType
diff --git a/flang/test/Semantics/this_image.f90 b/flang/test/Semantics/this_image.f90
index 089ab15768a30..0e59aa3fa27c6 100644
--- a/flang/test/Semantics/this_image.f90
+++ b/flang/test/Semantics/this_image.f90
@@ -3,20 +3,29 @@
subroutine test
use, intrinsic :: iso_fortran_env, only: team_type
- type(team_type) :: oregon, coteam[*]
+ type(team_type) :: team
+ !ERROR: Coarray 'coteam' may not have type TEAM_TYPE, C_PTR, or C_FUNPTR
+ type(team_type) :: coteam[*]
integer :: coscalar[*], coarray(3)[*]
save :: coteam, coscalar, coarray
! correct calls, should produce no errors
+ team = get_team()
print *, this_image()
+ print *, this_image(team)
print *, this_image(coarray)
- print *, this_image(coscalar,1)
- print *, this_image(coarray,1)
+ print *, this_image(coarray, team)
+ print *, this_image(coarray, 1)
+ print *, this_image(coarray, 1, team)
+ print *, this_image(coscalar)
+ print *, this_image(coscalar, team)
+ print *, this_image(coscalar, 1)
+ print *, this_image(coscalar, 1, team)
!ERROR: 'coarray=' argument must have corank > 0 for intrinsic 'this_image'
print *, this_image(array,1)
- ! TODO: More complete testing requires implementation of team_type
- ! actual arguments in flang/lib/Evaluate/intrinsics.cpp
+ print *, team_number()
+ print *, team_number(team)
end subroutine
diff --git a/flang/tools/f18/CMakeLists.txt b/flang/tools/f18/CMakeLists.txt
index 5cd9d758d30cc..16f2dbcd12b3e 100644
--- a/flang/tools/f18/CMakeLists.txt
+++ b/flang/tools/f18/CMakeLists.txt
@@ -20,12 +20,13 @@ set(MODULES
# Create module files directly from the top-level module source directory
foreach(filename ${MODULES})
set(base ${FLANG_INTRINSIC_MODULES_DIR}/${filename})
- if(${filename} MATCHES "__fortran_type_info")
+ if(${filename} MATCHES "__fortran_builtins")
set(depends "")
- elseif(${filename} MATCHES "__fortran_builtins")
- set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_type_info.mod)
else()
set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_builtins.mod)
+ if(NOT ${filename} MATCHES "__fortran_type_info")
+ set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_type_info.mod)
+ endif()
endif()
add_custom_command(OUTPUT ${base}.mod
COMMAND ${CMAKE_COMMAND} -E make_directory ${FLANG_INTRINSIC_MODULES_DIR}
More information about the flang-commits
mailing list