* Kind specification with `*`, e.g. `REAL*4`
* `DOUBLE COMPLEX`
* Signed complex literal constants
-* DEC `STRUCTURE`, `RECORD`, `UNION`, and `MAP`
+* DEC `STRUCTURE`, `RECORD`, with '%FILL'; but `UNION`, and `MAP`
+ are not yet supported throughout compilation, and elicit a
+ "not yet implemented" message.
* Structure field access with `.field`
* `BYTE` as synonym for `INTEGER(KIND=1)`
* Quad precision REAL literals with `Q`
template <typename A, typename B, bool COPY>
static auto Unwrap(const Indirection<B, COPY> &p) -> Constify<A, B> * {
- return Unwrap<A>(*p);
+ return Unwrap<A>(p.value());
}
template <typename A, typename B>
NODE(parser, ComponentAttrSpec)
NODE(parser, ComponentDataSource)
NODE(parser, ComponentDecl)
+ NODE(parser, FillDecl)
+ NODE(parser, ComponentOrFill)
NODE(parser, ComponentDefStmt)
NODE(parser, ComponentSpec)
NODE(parser, ComputedGotoStmt)
t;
};
+// A %FILL component for a DEC STRUCTURE. The name will be replaced
+// with a distinct compiler-generated name.
+struct FillDecl {
+ TUPLE_CLASS_BOILERPLATE(FillDecl);
+ std::tuple<Name, std::optional<ComponentArraySpec>, std::optional<CharLength>>
+ t;
+};
+
+struct ComponentOrFill {
+ UNION_CLASS_BOILERPLATE(ComponentOrFill);
+ std::variant<ComponentDecl, FillDecl> u;
+};
+
// R737 data-component-def-stmt ->
// declaration-type-spec [[, component-attr-spec-list] ::]
// component-decl-list
struct DataComponentDefStmt {
TUPLE_CLASS_BOILERPLATE(DataComponentDefStmt);
std::tuple<DeclarationTypeSpec, std::list<ComponentAttrSpec>,
- std::list<ComponentDecl>>
+ std::list<ComponentOrFill>>
t;
};
struct StructureStmt {
TUPLE_CLASS_BOILERPLATE(StructureStmt);
- std::tuple<Name, bool /*slashes*/, std::list<EntityDecl>> t;
+ std::tuple<std::optional<Name>, std::list<EntityDecl>> t;
};
struct StructureDef {
const Name &GetLastName(const AllocateObject &);
// GetFirstName() isolates and returns a reference to the leftmost Name
-// in a variable.
+// in a variable or entity declaration.
const Name &GetFirstName(const Name &);
const Name &GetFirstName(const StructureComponent &);
const Name &GetFirstName(const DataRef &);
using resultType = DataComponentDefStmt;
static std::optional<DataComponentDefStmt> Parse(ParseState &);
};
+
+struct NestedStructureStmt {
+ using resultType = StructureStmt;
+ static std::optional<StructureStmt> Parse(ParseState &);
+};
} // namespace Fortran::parser
#endif // FORTRAN_PARSER_USER_STATE_H_
const Assignment *Analyze(const parser::AssignmentStmt &);
const Assignment *Analyze(const parser::PointerAssignmentStmt &);
+ // Builds a typed Designator from an untyped DataRef
+ MaybeExpr Designate(DataRef &&);
+
protected:
int IntegerTypeSpecKind(const parser::IntegerTypeSpec &);
const std::list<parser::SectionSubscript> &);
std::optional<Component> CreateComponent(
DataRef &&, const Symbol &, const semantics::Scope &);
- MaybeExpr Designate(DataRef &&);
MaybeExpr CompleteSubscripts(ArrayRef &&);
MaybeExpr ApplySubscripts(DataRef &&, std::vector<Subscript> &&);
MaybeExpr TopLevelChecks(DataRef &&);
SymbolVector GetIndexVars(IndexVarKind);
SourceName SaveTempName(std::string &&);
SourceName GetTempName(const Scope &);
+ static bool IsTempName(const std::string &);
// Locate and process the contents of a built-in module on demand
Scope *GetBuiltinModule(const char *name);
const std::list<SourceName> ¶mNames() const { return paramNames_; }
const SymbolVector ¶mDecls() const { return paramDecls_; }
bool sequence() const { return sequence_; }
+ bool isDECStructure() const { return isDECStructure_; }
std::map<SourceName, SymbolRef> &finals() { return finals_; }
const std::map<SourceName, SymbolRef> &finals() const { return finals_; }
bool isForwardReferenced() const { return isForwardReferenced_; }
void add_paramDecl(const Symbol &symbol) { paramDecls_.push_back(symbol); }
void add_component(const Symbol &);
void set_sequence(bool x = true) { sequence_ = x; }
+ void set_isDECStructure(bool x = true) { isDECStructure_ = x; }
void set_isForwardReferenced(bool value) { isForwardReferenced_ = value; }
const std::list<SourceName> &componentNames() const {
return componentNames_;
std::list<SourceName> componentNames_;
std::map<SourceName, SymbolRef> finals_; // FINAL :: subr
bool sequence_{false};
+ bool isDECStructure_{false};
bool isForwardReferenced_{false};
friend llvm::raw_ostream &operator<<(
llvm::raw_ostream &, const DerivedTypeDetails &);
LocalityLocal, // named in LOCAL locality-spec
LocalityLocalInit, // named in LOCAL_INIT locality-spec
LocalityShared, // named in SHARED locality-spec
- InDataStmt, // initialized in a DATA statement
- InNamelist, // flag is set if the symbol is in Namelist statement
+ InDataStmt, // initialized in a DATA statement, =>object, or /init/
+ InNamelist, // in a Namelist group
CompilerCreated,
// OpenACC data-sharing attribute
AccPrivate, AccFirstPrivate, AccShared,
std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
const Symbol &symbol, ConstantSubscript which) {
- if (semantics::IsPointer(symbol) || semantics::IsAllocatable(symbol)) {
+ if (IsAllocatableOrPointer(symbol)) {
// A pointer may appear as a DATA statement object if it is the
// rightmost symbol in a designator and has no subscripts.
// An allocatable may appear if its initializer is NULL().
if (auto bytes{ToInt64(
type->MeasureSizeInBytes(context_, GetRank(*extents) > 0))}) {
OffsetSymbol result{symbol, static_cast<std::size_t>(*bytes)};
- auto stride{*bytes};
- for (auto extent : *extents) {
- if (extent == 0) {
- return std::nullopt;
- }
- auto quotient{which / extent};
- auto remainder{which - extent * quotient};
- result.Augment(stride * remainder);
- which = quotient;
- stride *= extent;
- }
- if (which > 0) {
- isEmpty_ = true;
+ if (which < GetSize(*extents)) {
+ result.Augment(*bytes * which);
+ return result;
} else {
- return std::move(result);
+ isEmpty_ = true;
}
}
}
const Component &component, ConstantSubscript which) {
const Symbol &comp{component.GetLastSymbol()};
const DataRef &base{component.base()};
- std::optional<OffsetSymbol> result, baseResult;
+ std::optional<OffsetSymbol> baseResult, compResult;
if (base.Rank() == 0) { // A%X(:) - apply "which" to component
baseResult = FoldDesignator(base, 0);
- result = FoldDesignator(comp, which);
+ compResult = FoldDesignator(comp, which);
} else { // A(:)%X - apply "which" to base
baseResult = FoldDesignator(base, which);
- result = FoldDesignator(comp, 0);
+ compResult = FoldDesignator(comp, 0);
}
- if (result && baseResult) {
- result->set_symbol(baseResult->symbol());
- result->Augment(baseResult->offset() + comp.offset());
- return result;
+ if (baseResult && compResult) {
+ OffsetSymbol result{baseResult->symbol(), compResult->size()};
+ result.Augment(baseResult->offset() + compResult->offset() + comp.offset());
+ return {std::move(result)};
} else {
return std::nullopt;
}
construct<DeclarationTypeSpec::ClassStar>())) ||
extension<LanguageFeature::DECStructures>(
construct<DeclarationTypeSpec>(
+ // As is also done for the STRUCTURE statement, the name of
+ // the structure includes the surrounding slashes to avoid
+ // name clashes.
construct<DeclarationTypeSpec::Record>(
- "RECORD /" >> name / "/"))))
+ "RECORD" >> sourced("/" >> name / "/")))))
// R704 intrinsic-type-spec ->
// integer-type-spec | REAL [kind-selector] | DOUBLE PRECISION |
// N.B. The standard requires double colons if there's an initializer.
TYPE_PARSER(construct<DataComponentDefStmt>(declarationTypeSpec,
optionalListBeforeColons(Parser<ComponentAttrSpec>{}),
- nonemptyList(
- "expected component declarations"_err_en_US, Parser<ComponentDecl>{})))
+ nonemptyList("expected component declarations"_err_en_US,
+ Parser<ComponentOrFill>{})))
// R738 component-attr-spec ->
// access-spec | ALLOCATABLE |
TYPE_CONTEXT_PARSER("component declaration"_en_US,
construct<ComponentDecl>(name, maybe(Parser<ComponentArraySpec>{}),
maybe(coarraySpec), maybe("*" >> charLength), maybe(initialization)))
+// The source field of the Name will be replaced with a distinct generated name.
+TYPE_CONTEXT_PARSER("%FILL item"_en_US,
+ extension<LanguageFeature::DECStructures>(
+ construct<FillDecl>(space >> sourced("%FILL" >> construct<Name>()),
+ maybe(Parser<ComponentArraySpec>{}), maybe("*" >> charLength))))
+TYPE_PARSER(construct<ComponentOrFill>(Parser<ComponentDecl>{}) ||
+ construct<ComponentOrFill>(Parser<FillDecl>{}))
// R740 component-array-spec ->
// explicit-shape-spec-list | deferred-shape-spec-list
construct<BasedPointer>("(" >> objectName / ",",
objectName, maybe(Parser<ArraySpec>{}) / ")")))))
-TYPE_PARSER(construct<StructureStmt>("STRUCTURE /" >> name / "/", pure(true),
- optionalList(entityDecl)) ||
- construct<StructureStmt>(
- "STRUCTURE" >> name, pure(false), pure<std::list<EntityDecl>>()))
+// Subtle: the name includes the surrounding slashes, which avoids
+// clashes with other uses of the name in the same scope.
+TYPE_PARSER(construct<StructureStmt>(
+ "STRUCTURE" >> maybe(sourced("/" >> name / "/")), optionalList(entityDecl)))
+
+constexpr auto nestedStructureDef{
+ CONTEXT_PARSER("nested STRUCTURE definition"_en_US,
+ construct<StructureDef>(statement(NestedStructureStmt{}),
+ many(Parser<StructureField>{}),
+ statement(construct<StructureDef::EndStructureStmt>(
+ "END STRUCTURE"_tok))))};
TYPE_PARSER(construct<StructureField>(statement(StructureComponents{})) ||
construct<StructureField>(indirect(Parser<Union>{})) ||
- construct<StructureField>(indirect(Parser<StructureDef>{})))
+ construct<StructureField>(indirect(nestedStructureDef)))
TYPE_CONTEXT_PARSER("STRUCTURE definition"_en_US,
extension<LanguageFeature::DECStructures>(construct<StructureDef>(
void Unparse(const DataComponentDefStmt &x) { // R737
const auto &dts{std::get<DeclarationTypeSpec>(x.t)};
const auto &attrs{std::get<std::list<ComponentAttrSpec>>(x.t)};
- const auto &decls{std::get<std::list<ComponentDecl>>(x.t)};
+ const auto &decls{std::get<std::list<ComponentOrFill>>(x.t)};
Walk(dts), Walk(", ", attrs, ", ");
if (!attrs.empty() ||
(!std::holds_alternative<DeclarationTypeSpec::Record>(dts.u) &&
std::none_of(
- decls.begin(), decls.end(), [](const ComponentDecl &d) {
- const auto &init{
- std::get<std::optional<Initialization>>(d.t)};
- return init &&
- std::holds_alternative<
- std::list<common::Indirection<DataStmtValue>>>(
- init->u);
+ decls.begin(), decls.end(), [](const ComponentOrFill &c) {
+ return std::visit(
+ common::visitors{
+ [](const ComponentDecl &d) {
+ const auto &init{
+ std::get<std::optional<Initialization>>(d.t)};
+ return init &&
+ std::holds_alternative<std::list<
+ common::Indirection<DataStmtValue>>>(
+ init->u);
+ },
+ [](const FillDecl &) { return false; },
+ },
+ c.u);
}))) {
Put(" ::");
}
Walk("*", std::get<std::optional<CharLength>>(x.t));
Walk(std::get<std::optional<Initialization>>(x.t));
}
+ void Unparse(const FillDecl &x) { // DEC extension
+ Put("%FILL");
+ Walk("(", std::get<std::optional<ComponentArraySpec>>(x.t), ")");
+ Walk("*", std::get<std::optional<CharLength>>(x.t));
+ }
void Unparse(const ComponentArraySpec &x) { // R740
std::visit(common::visitors{
[&](const std::list<ExplicitShapeSpec> &y) { Walk(y, ","); },
void Unparse(const BasedPointerStmt &x) { Walk("POINTER ", x.v, ","); }
void Post(const StructureField &x) {
if (const auto *def{std::get_if<Statement<DataComponentDefStmt>>(&x.u)}) {
- for (const auto &decl :
- std::get<std::list<ComponentDecl>>(def->statement.t)) {
- structureComponents_.insert(std::get<Name>(decl.t).source);
+ for (const auto &item :
+ std::get<std::list<ComponentOrFill>>(def->statement.t)) {
+ if (const auto *comp{std::get_if<ComponentDecl>(&item.u)}) {
+ structureComponents_.insert(std::get<Name>(comp->t).source);
+ }
}
}
}
void Unparse(const StructureStmt &x) {
Word("STRUCTURE ");
- if (std::get<bool>(x.t)) { // slashes around name
- Put('/'), Walk(std::get<Name>(x.t)), Put('/');
- Walk(" ", std::get<std::list<EntityDecl>>(x.t), ", ");
- } else {
- CHECK(std::get<std::list<EntityDecl>>(x.t).empty());
- Walk(std::get<Name>(x.t));
- }
+ // The name, if present, includes the /slashes/
+ Walk(std::get<std::optional<Name>>(x.t));
+ Walk(" ", std::get<std::list<EntityDecl>>(x.t), ", ");
Indent();
}
void Post(const Union::UnionStmt &) { Word("UNION"), Indent(); }
return {Success{}};
}
+// These special parsers for bits of DEC STRUCTURE capture the names of
+// their components and nested structures in the user state so that
+// references to these fields with periods can be recognized as special
+// cases.
+
std::optional<Name> OldStructureComponentName::Parse(ParseState &state) {
if (std::optional<Name> n{name.Parse(state)}) {
if (const auto *ustate{state.userState()}) {
std::optional<DataComponentDefStmt> defs{stmt.Parse(state)};
if (defs) {
if (auto *ustate{state.userState()}) {
- for (const auto &decl : std::get<std::list<ComponentDecl>>(defs->t)) {
- ustate->NoteOldStructureComponent(std::get<Name>(decl.t).source);
+ for (const auto &item : std::get<std::list<ComponentOrFill>>(defs->t)) {
+ if (const auto *decl{std::get_if<ComponentDecl>(&item.u)}) {
+ ustate->NoteOldStructureComponent(std::get<Name>(decl->t).source);
+ }
}
}
}
return defs;
}
+
+std::optional<StructureStmt> NestedStructureStmt::Parse(ParseState &state) {
+ std::optional<StructureStmt> stmt{Parser<StructureStmt>{}.Parse(state)};
+ if (stmt) {
+ if (auto *ustate{state.userState()}) {
+ for (const auto &entity : std::get<std::list<EntityDecl>>(stmt->t)) {
+ ustate->NoteOldStructureComponent(std::get<Name>(entity.t).source);
+ }
+ }
+ }
+ return stmt;
+}
} // namespace Fortran::parser
currentSetHasFatalErrors_ = false;
}
+// Handle legacy DATA-style initialization, e.g. REAL PI/3.14159/, for
+// variables and components (esp. for DEC STRUCTUREs)
+template <typename A> void DataChecker::LegacyDataInit(const A &decl) {
+ if (const auto &init{
+ std::get<std::optional<parser::Initialization>>(decl.t)}) {
+ const Symbol *name{std::get<parser::Name>(decl.t).symbol};
+ const auto *list{
+ std::get_if<std::list<common::Indirection<parser::DataStmtValue>>>(
+ &init->u)};
+ if (name && list) {
+ AccumulateDataInitializations(inits_, exprAnalyzer_, *name, *list);
+ }
+ }
+}
+
+void DataChecker::Leave(const parser::ComponentDecl &decl) {
+ LegacyDataInit(decl);
+}
+
+void DataChecker::Leave(const parser::EntityDecl &decl) {
+ LegacyDataInit(decl);
+}
+
void DataChecker::CompileDataInitializationsIntoInitializers() {
ConvertToInitializers(inits_, exprAnalyzer_);
}
void Enter(const parser::DataImpliedDo &);
void Leave(const parser::DataImpliedDo &);
void Leave(const parser::DataStmtSet &);
+ // These cases are for legacy DATA-like /initializations/
+ void Leave(const parser::ComponentDecl &);
+ void Leave(const parser::EntityDecl &);
// After all DATA statements have been processed, converts their
// initializations into per-symbol static initializers.
template <typename T> void CheckIfConstantSubscript(const T &);
void CheckSubscript(const parser::SectionSubscript &);
bool CheckAllSubscriptsInDataRef(const parser::DataRef &, parser::CharBlock);
+ template <typename A> void LegacyDataInit(const A &);
DataInitializations inits_;
evaluate::ExpressionAnalyzer exprAnalyzer_;
// Steps through a list of values in a DATA statement set; implements
// repetition.
-class ValueListIterator {
+template <typename DSV = parser::DataStmtValue> class ValueListIterator {
public:
- explicit ValueListIterator(const parser::DataStmtSet &set)
- : end_{std::get<std::list<parser::DataStmtValue>>(set.t).end()},
- at_{std::get<std::list<parser::DataStmtValue>>(set.t).begin()} {
+ explicit ValueListIterator(const std::list<DSV> &list)
+ : end_{list.end()}, at_{list.begin()} {
SetRepetitionCount();
}
bool hasFatalError() const { return hasFatalError_; }
}
private:
- using listIterator = std::list<parser::DataStmtValue>::const_iterator;
+ using listIterator = typename std::list<DSV>::const_iterator;
void SetRepetitionCount();
+ const parser::DataStmtValue &GetValue() const {
+ return DEREF(common::Unwrap<const parser::DataStmtValue>(*at_));
+ }
const parser::DataStmtConstant &GetConstant() const {
- return std::get<parser::DataStmtConstant>(at_->t);
+ return std::get<parser::DataStmtConstant>(GetValue().t);
}
- listIterator end_;
- listIterator at_;
+ listIterator end_, at_;
ConstantSubscript repetitionsRemaining_{0};
bool hasFatalError_{false};
};
-void ValueListIterator::SetRepetitionCount() {
+template <typename DSV> void ValueListIterator<DSV>::SetRepetitionCount() {
for (repetitionsRemaining_ = 1; at_ != end_; ++at_) {
- if (at_->repetitions < 0) {
+ auto repetitions{GetValue().repetitions};
+ if (repetitions < 0) {
hasFatalError_ = true;
- }
- if (at_->repetitions > 0) {
- repetitionsRemaining_ = at_->repetitions - 1;
+ } else if (repetitions > 0) {
+ repetitionsRemaining_ = repetitions - 1;
return;
}
}
// Expands the implied DO loops and array references.
// Applies checks that validate each distinct elemental initialization
// of the variables in a data-stmt-set, as well as those that apply
-// to the corresponding values being use to initialize each element.
+// to the corresponding values being used to initialize each element.
+template <typename DSV = parser::DataStmtValue>
class DataInitializationCompiler {
public:
DataInitializationCompiler(DataInitializations &inits,
- evaluate::ExpressionAnalyzer &a, const parser::DataStmtSet &set)
- : inits_{inits}, exprAnalyzer_{a}, values_{set} {}
+ evaluate::ExpressionAnalyzer &a, const std::list<DSV> &list)
+ : inits_{inits}, exprAnalyzer_{a}, values_{list} {}
const DataInitializations &inits() const { return inits_; }
bool HasSurplusValues() const { return !values_.IsAtEnd(); }
bool Scan(const parser::DataStmtObject &);
+ // Initializes all elements of whole variable or component
+ bool Scan(const Symbol &);
private:
bool Scan(const parser::Variable &);
// Initializes all elements of a designator, which can be an array or section.
bool InitDesignator(const SomeExpr &);
- // Initializes a single object.
+ // Initializes a single scalar object.
bool InitElement(const evaluate::OffsetSymbol &, const SomeExpr &designator);
// If the returned flag is true, emit a warning about CHARACTER misusage.
std::optional<std::pair<SomeExpr, bool>> ConvertElement(
DataInitializations &inits_;
evaluate::ExpressionAnalyzer &exprAnalyzer_;
- ValueListIterator values_;
+ ValueListIterator<DSV> values_;
};
-bool DataInitializationCompiler::Scan(const parser::DataStmtObject &object) {
+template <typename DSV>
+bool DataInitializationCompiler<DSV>::Scan(
+ const parser::DataStmtObject &object) {
return std::visit(
common::visitors{
[&](const common::Indirection<parser::Variable> &var) {
object.u);
}
-bool DataInitializationCompiler::Scan(const parser::Variable &var) {
+template <typename DSV>
+bool DataInitializationCompiler<DSV>::Scan(const parser::Variable &var) {
if (const auto *expr{GetExpr(var)}) {
exprAnalyzer_.GetFoldingContext().messages().SetLocation(var.GetSource());
if (InitDesignator(*expr)) {
return false;
}
-bool DataInitializationCompiler::Scan(const parser::Designator &designator) {
+template <typename DSV>
+bool DataInitializationCompiler<DSV>::Scan(
+ const parser::Designator &designator) {
if (auto expr{exprAnalyzer_.Analyze(designator)}) {
exprAnalyzer_.GetFoldingContext().messages().SetLocation(
parser::FindSourceLocation(designator));
return false;
}
-bool DataInitializationCompiler::Scan(const parser::DataImpliedDo &ido) {
+template <typename DSV>
+bool DataInitializationCompiler<DSV>::Scan(const parser::DataImpliedDo &ido) {
const auto &bounds{std::get<parser::DataImpliedDo::Bounds>(ido.t)};
auto name{bounds.name.thing.thing};
const auto *lowerExpr{GetExpr(bounds.lower.thing.thing)};
return false;
}
-bool DataInitializationCompiler::Scan(const parser::DataIDoObject &object) {
+template <typename DSV>
+bool DataInitializationCompiler<DSV>::Scan(
+ const parser::DataIDoObject &object) {
return std::visit(
common::visitors{
[&](const parser::Scalar<common::Indirection<parser::Designator>>
object.u);
}
-bool DataInitializationCompiler::InitDesignator(const SomeExpr &designator) {
+template <typename DSV>
+bool DataInitializationCompiler<DSV>::Scan(const Symbol &symbol) {
+ auto designator{exprAnalyzer_.Designate(evaluate::DataRef{symbol})};
+ CHECK(designator.has_value());
+ return InitDesignator(*designator);
+}
+
+template <typename DSV>
+bool DataInitializationCompiler<DSV>::InitDesignator(
+ const SomeExpr &designator) {
evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()};
evaluate::DesignatorFolder folder{context};
while (auto offsetSymbol{folder.FoldDesignator(designator)}) {
return folder.isEmpty();
}
+template <typename DSV>
std::optional<std::pair<SomeExpr, bool>>
-DataInitializationCompiler::ConvertElement(
+DataInitializationCompiler<DSV>::ConvertElement(
const SomeExpr &expr, const evaluate::DynamicType &type) {
if (auto converted{evaluate::ConvertToType(type, SomeExpr{expr})}) {
return {std::make_pair(std::move(*converted), false)};
return std::nullopt;
}
-bool DataInitializationCompiler::InitElement(
+template <typename DSV>
+bool DataInitializationCompiler<DSV>::InitElement(
const evaluate::OffsetSymbol &offsetSymbol, const SomeExpr &designator) {
const Symbol &symbol{offsetSymbol.symbol()};
const Symbol *lastSymbol{GetLastSymbol(designator)};
void AccumulateDataInitializations(DataInitializations &inits,
evaluate::ExpressionAnalyzer &exprAnalyzer,
const parser::DataStmtSet &set) {
- DataInitializationCompiler scanner{inits, exprAnalyzer, set};
+ DataInitializationCompiler scanner{
+ inits, exprAnalyzer, std::get<std::list<parser::DataStmtValue>>(set.t)};
for (const auto &object :
std::get<std::list<parser::DataStmtObject>>(set.t)) {
if (!scanner.Scan(object)) {
}
}
+void AccumulateDataInitializations(DataInitializations &inits,
+ evaluate::ExpressionAnalyzer &exprAnalyzer, const Symbol &symbol,
+ const std::list<common::Indirection<parser::DataStmtValue>> &list) {
+ DataInitializationCompiler<common::Indirection<parser::DataStmtValue>>
+ scanner{inits, exprAnalyzer, list};
+ if (scanner.Scan(symbol) && scanner.HasSurplusValues()) {
+ exprAnalyzer.context().Say(
+ "DATA statement set has more values than objects"_err_en_US);
+ }
+}
+
// Looks for default derived type component initialization -- but
// *not* allocatables.
static const DerivedTypeSpec *HasDefaultInitialization(const Symbol &symbol) {
namespace Fortran::parser {
struct DataStmtSet;
+struct DataStmtValue;
}
namespace Fortran::evaluate {
class ExpressionAnalyzer;
void AccumulateDataInitializations(DataInitializations &,
evaluate::ExpressionAnalyzer &, const parser::DataStmtSet &);
+// For legacy DATA-style initialization extension: integer n(2)/1,2/
+void AccumulateDataInitializations(DataInitializations &,
+ evaluate::ExpressionAnalyzer &, const Symbol &,
+ const std::list<common::Indirection<parser::DataStmtValue>> &);
+
void ConvertToInitializers(
DataInitializations &, evaluate::ExpressionAnalyzer &);
static std::optional<SourceName> GetSubmoduleParent(const parser::Program &);
static void CollectSymbols(const Scope &, SymbolVector &, SymbolVector &);
-static void PutEntity(llvm::raw_ostream &, const Symbol &);
-static void PutObjectEntity(llvm::raw_ostream &, const Symbol &);
-static void PutProcEntity(llvm::raw_ostream &, const Symbol &);
static void PutPassName(llvm::raw_ostream &, const std::optional<SourceName> &);
-static void PutTypeParam(llvm::raw_ostream &, const Symbol &);
-static void PutEntity(
- llvm::raw_ostream &, const Symbol &, std::function<void()>, Attrs);
static void PutInit(llvm::raw_ostream &, const Symbol &, const MaybeExpr &);
static void PutInit(llvm::raw_ostream &, const MaybeIntExpr &);
static void PutBound(llvm::raw_ostream &, const Bound &);
+static void PutShapeSpec(llvm::raw_ostream &, const ShapeSpec &);
+static void PutShape(
+ llvm::raw_ostream &, const ArraySpec &, char open, char close);
llvm::raw_ostream &PutAttrs(llvm::raw_ostream &, Attrs,
const std::string * = nullptr, std::string before = ","s,
std::string after = ""s);
}
// Put out the visible symbols from scope.
-bool ModFileWriter::PutSymbols(const Scope &scope) {
+void ModFileWriter::PutSymbols(const Scope &scope) {
SymbolVector sorted;
SymbolVector uses;
CollectSymbols(scope, sorted, uses);
decls_ << ")\n";
}
}
+ CHECK(typeBindings.str().empty());
+}
+
+// Emit components in order
+bool ModFileWriter::PutComponents(const Symbol &typeSymbol) {
+ const auto &scope{DEREF(typeSymbol.scope())};
+ std::string buf; // stuff after CONTAINS in derived type
+ llvm::raw_string_ostream typeBindings{buf};
+ UnorderedSymbolSet emitted;
+ SymbolVector symbols{scope.GetSymbols()};
+ // Emit type parameters first
+ for (const Symbol &symbol : symbols) {
+ if (symbol.has<TypeParamDetails>()) {
+ PutSymbol(typeBindings, symbol);
+ emitted.emplace(symbol);
+ }
+ }
+ // Emit components in component order.
+ const auto &details{typeSymbol.get<DerivedTypeDetails>()};
+ for (SourceName name : details.componentNames()) {
+ auto iter{scope.find(name)};
+ if (iter != scope.end()) {
+ const Symbol &component{*iter->second};
+ if (!component.test(Symbol::Flag::ParentComp)) {
+ PutSymbol(typeBindings, component);
+ }
+ emitted.emplace(component);
+ }
+ }
+ // Emit remaining symbols from the type's scope
+ for (const Symbol &symbol : symbols) {
+ if (emitted.find(symbol) == emitted.end()) {
+ PutSymbol(typeBindings, symbol);
+ }
+ }
if (auto str{typeBindings.str()}; !str.empty()) {
CHECK(scope.IsDerivedType());
decls_ << "contains\n" << str;
symbol.details());
}
-void ModFileWriter::PutDerivedType(const Symbol &typeSymbol) {
+void ModFileWriter::PutDerivedType(
+ const Symbol &typeSymbol, const Scope *scope) {
auto &details{typeSymbol.get<DerivedTypeDetails>()};
+ if (details.isDECStructure()) {
+ PutDECStructure(typeSymbol, scope);
+ return;
+ }
PutAttrs(decls_ << "type", typeSymbol.attrs());
if (const DerivedTypeSpec * extends{typeSymbol.GetParentTypeSpec()}) {
decls_ << ",extends(" << extends->name() << ')';
}
decls_ << "::" << typeSymbol.name();
- auto &typeScope{*typeSymbol.scope()};
if (!details.paramNames().empty()) {
char sep{'('};
for (const auto &name : details.paramNames()) {
if (details.sequence()) {
decls_ << "sequence\n";
}
- bool contains{PutSymbols(typeScope)};
+ bool contains{PutComponents(typeSymbol)};
if (!details.finals().empty()) {
const char *sep{contains ? "final::" : "contains\nfinal::"};
for (const auto &pair : details.finals()) {
decls_ << "end type\n";
}
+void ModFileWriter::PutDECStructure(
+ const Symbol &typeSymbol, const Scope *scope) {
+ if (emittedDECStructures_.find(typeSymbol) != emittedDECStructures_.end()) {
+ return;
+ }
+ if (!scope && context_.IsTempName(typeSymbol.name().ToString())) {
+ return; // defer until used
+ }
+ emittedDECStructures_.insert(typeSymbol);
+ decls_ << "structure ";
+ if (!context_.IsTempName(typeSymbol.name().ToString())) {
+ decls_ << typeSymbol.name();
+ }
+ if (scope && scope->kind() == Scope::Kind::DerivedType) {
+ // Nested STRUCTURE: emit entity declarations right now
+ // on the STRUCTURE statement.
+ bool any{false};
+ for (const auto &ref : scope->GetSymbols()) {
+ const auto *object{ref->detailsIf<ObjectEntityDetails>()};
+ if (object && object->type() &&
+ object->type()->category() == DeclTypeSpec::TypeDerived &&
+ &object->type()->derivedTypeSpec().typeSymbol() == &typeSymbol) {
+ if (any) {
+ decls_ << ',';
+ } else {
+ any = true;
+ }
+ decls_ << ref->name();
+ PutShape(decls_, object->shape(), '(', ')');
+ PutInit(decls_, *ref, object->init());
+ emittedDECFields_.insert(*ref);
+ } else if (any) {
+ break; // any later use of this structure will use RECORD/str/
+ }
+ }
+ }
+ decls_ << '\n';
+ PutComponents(typeSymbol);
+ decls_ << "end structure\n";
+}
+
// Attributes that may be in a subprogram prefix
static const Attrs subprogramPrefixAttrs{Attr::ELEMENTAL, Attr::IMPURE,
Attr::MODULE, Attr::NON_RECURSIVE, Attr::PURE, Attr::RECURSIVE};
sorted.end() - commonSize, sorted.end(), SymbolSourcePositionCompare{});
}
-void PutEntity(llvm::raw_ostream &os, const Symbol &symbol) {
+void ModFileWriter::PutEntity(llvm::raw_ostream &os, const Symbol &symbol) {
std::visit(
common::visitors{
[&](const ObjectEntityDetails &) { PutObjectEntity(os, symbol); },
}
}
-void PutObjectEntity(llvm::raw_ostream &os, const Symbol &symbol) {
+void ModFileWriter::PutObjectEntity(
+ llvm::raw_ostream &os, const Symbol &symbol) {
auto &details{symbol.get<ObjectEntityDetails>()};
+ if (details.type() &&
+ details.type()->category() == DeclTypeSpec::TypeDerived) {
+ const Symbol &typeSymbol{details.type()->derivedTypeSpec().typeSymbol()};
+ if (typeSymbol.get<DerivedTypeDetails>().isDECStructure()) {
+ PutDerivedType(typeSymbol, &symbol.owner());
+ if (emittedDECFields_.find(symbol) != emittedDECFields_.end()) {
+ return; // symbol was emitted on STRUCTURE statement
+ }
+ }
+ }
PutEntity(
os, symbol, [&]() { PutType(os, DEREF(symbol.GetType())); },
symbol.attrs());
os << '\n';
}
-void PutProcEntity(llvm::raw_ostream &os, const Symbol &symbol) {
+void ModFileWriter::PutProcEntity(llvm::raw_ostream &os, const Symbol &symbol) {
if (symbol.attrs().test(Attr::INTRINSIC)) {
os << "intrinsic::" << symbol.name() << '\n';
if (symbol.attrs().test(Attr::PRIVATE)) {
os << ",pass(" << *passName << ')';
}
}
-void PutTypeParam(llvm::raw_ostream &os, const Symbol &symbol) {
+
+void ModFileWriter::PutTypeParam(llvm::raw_ostream &os, const Symbol &symbol) {
auto &details{symbol.get<TypeParamDetails>()};
PutEntity(
os, symbol,
// Write an entity (object or procedure) declaration.
// writeType is called to write out the type.
-void PutEntity(llvm::raw_ostream &os, const Symbol &symbol,
+void ModFileWriter::PutEntity(llvm::raw_ostream &os, const Symbol &symbol,
std::function<void()> writeType, Attrs attrs) {
writeType();
PutAttrs(os, attrs, symbol.GetBindName());
- os << "::" << symbol.name();
+ if (symbol.owner().kind() == Scope::Kind::DerivedType &&
+ context_.IsTempName(symbol.name().ToString())) {
+ os << "::%FILL";
+ } else {
+ os << "::" << symbol.name();
+ }
}
// Put out each attribute to os, surrounded by `before` and `after` and
#define FORTRAN_SEMANTICS_MOD_FILE_H_
#include "flang/Semantics/attr.h"
+#include "flang/Semantics/symbol.h"
#include "llvm/Support/raw_ostream.h"
#include <string>
std::string useExtraAttrsBuf_;
std::string declsBuf_;
std::string containsBuf_;
+ // Tracks nested DEC structures and fields of that type
+ UnorderedSymbolSet emittedDECStructures_, emittedDECFields_;
llvm::raw_string_ostream uses_{usesBuf_};
llvm::raw_string_ostream useExtraAttrs_{
void WriteOne(const Scope &);
void Write(const Symbol &);
std::string GetAsString(const Symbol &);
+ void PutSymbols(const Scope &);
// Returns true if a derived type with bindings and "contains" was emitted
- bool PutSymbols(const Scope &);
+ bool PutComponents(const Symbol &);
void PutSymbol(llvm::raw_ostream &, const Symbol &);
- void PutDerivedType(const Symbol &);
+ void PutEntity(llvm::raw_ostream &, const Symbol &);
+ void PutEntity(
+ llvm::raw_ostream &, const Symbol &, std::function<void()>, Attrs);
+ void PutObjectEntity(llvm::raw_ostream &, const Symbol &);
+ void PutProcEntity(llvm::raw_ostream &, const Symbol &);
+ void PutDerivedType(const Symbol &, const Scope * = nullptr);
+ void PutDECStructure(const Symbol &, const Scope * = nullptr);
+ void PutTypeParam(llvm::raw_ostream &, const Symbol &);
void PutSubprogram(const Symbol &);
void PutGeneric(const Symbol &);
void PutUse(const Symbol &);
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::DeclarationTypeSpec::Record &);
void Post(const parser::DerivedTypeSpec &);
bool Pre(const parser::DerivedTypeDef &);
bool Pre(const parser::DerivedTypeStmt &);
bool Pre(const parser::ComponentDefStmt &) { return BeginDecl(); }
void Post(const parser::ComponentDefStmt &) { EndDecl(); }
void Post(const parser::ComponentDecl &);
+ void Post(const parser::FillDecl &);
bool Pre(const parser::ProcedureDeclarationStmt &);
void Post(const parser::ProcedureDeclarationStmt &);
bool Pre(const parser::DataComponentDefStmt &); // returns false
void Post(const parser::TypeBoundProcedureStmt::WithInterface &);
void Post(const parser::FinalProcedureStmt &);
bool Pre(const parser::TypeBoundGenericStmt &);
+ bool Pre(const parser::StructureDef &); // returns false
+ bool Pre(const parser::Union::UnionStmt &);
+ bool Pre(const parser::StructureField &);
+ void Post(const parser::StructureField &);
bool Pre(const parser::AllocateStmt &);
void Post(const parser::AllocateStmt &);
bool Pre(const parser::StructureConstructor &);
std::optional<ParamValue> length;
std::optional<KindExpr> kind;
} charInfo_;
- // Info about current derived type while walking DerivedTypeDef
+ // Info about current derived type or STRUCTURE while walking
+ // DerivedTypeDef / StructureDef
struct {
const parser::Name *extends{nullptr}; // EXTENDS(name)
bool privateComps{false}; // components are private by default
bool sawContains{false}; // currently processing bindings
bool sequence{false}; // is a sequence type
const Symbol *type{nullptr}; // derived type being defined
+ bool isStructure{false}; // is a DEC STRUCTURE
} derivedTypeInfo_;
// In a ProcedureDeclarationStmt or ProcComponentDefStmt, this is
// the interface name, if any.
}
}
-bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Record &) {
- // TODO
- return true;
-}
-
void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) {
const auto &typeName{std::get<parser::Name>(x.t)};
auto spec{ResolveDerivedType(typeName)};
x.derivedTypeSpec = &GetDeclTypeSpec()->derivedTypeSpec();
}
+void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Record &rec) {
+ const auto &typeName{rec.v};
+ if (auto spec{ResolveDerivedType(typeName)}) {
+ spec->CookParameters(GetFoldingContext());
+ spec->EvaluateParameters(context());
+ if (const DeclTypeSpec *
+ extant{currScope().FindInstantiatedDerivedType(
+ *spec, DeclTypeSpec::TypeDerived)}) {
+ SetDeclTypeSpec(*extant);
+ } else {
+ Say(typeName.source, "%s is not a known STRUCTURE"_err_en_US,
+ typeName.source);
+ }
+ }
+}
+
// The descendents of DerivedTypeDef in the parse tree are visited directly
// in this Pre() routine so that recursive use of the derived type can be
// supported in the components.
if (derivedTypeInfo_.extends) { // C735
Say(stmt.source,
"A sequence type may not have the EXTENDS attribute"_err_en_US);
- } else {
- for (const auto &componentName : details.componentNames()) {
- const Symbol *componentSymbol{scope.FindComponent(componentName)};
- if (componentSymbol && componentSymbol->has<ObjectEntityDetails>()) {
- const auto &componentDetails{
- componentSymbol->get<ObjectEntityDetails>()};
- const DeclTypeSpec *componentType{componentDetails.type()};
- if (componentType && // C740
- !componentType->AsIntrinsic() &&
- !componentType->IsSequenceType()) {
- Say(componentSymbol->name(),
- "A sequence type data component must either be of an"
- " intrinsic type or a derived sequence type"_err_en_US);
- }
- }
- }
}
}
Walk(std::get<std::optional<parser::TypeBoundProcedurePart>>(x.t));
PopScope();
return false;
}
+
bool DeclarationVisitor::Pre(const parser::DerivedTypeStmt &) {
return BeginAttrs();
}
ClearArraySpec();
ClearCoarraySpec();
}
+void DeclarationVisitor::Post(const parser::FillDecl &x) {
+ // Replace "%FILL" with a distinct generated name
+ const auto &name{std::get<parser::Name>(x.t)};
+ const_cast<SourceName &>(name.source) = context().GetTempName(currScope());
+ if (OkToAddComponent(name)) {
+ auto &symbol{DeclareObjectEntity(name, GetAttrs())};
+ currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol);
+ }
+ ClearArraySpec();
+}
bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &) {
CHECK(!interfaceName_);
return BeginDecl();
GetAttrs().HasAny({Attr::POINTER, Attr::ALLOCATABLE}));
Walk(std::get<parser::DeclarationTypeSpec>(x.t));
set_allowForwardReferenceToDerivedType(false);
- Walk(std::get<std::list<parser::ComponentDecl>>(x.t));
+ if (derivedTypeInfo_.sequence) { // C740
+ if (const auto *declType{GetDeclTypeSpec()}) {
+ if (!declType->AsIntrinsic() && !declType->IsSequenceType()) {
+ Say("A sequence type data component must either be of an"
+ " intrinsic type or a derived sequence type"_err_en_US);
+ }
+ }
+ }
+ Walk(std::get<std::list<parser::ComponentOrFill>>(x.t));
return false;
}
bool DeclarationVisitor::Pre(const parser::ProcComponentDefStmt &) {
NoteInterfaceName(*name);
}
}
-
void DeclarationVisitor::Post(const parser::ProcDecl &x) {
const auto &name{std::get<parser::Name>(x.t)};
ProcInterface interface;
return false;
}
+// DEC STRUCTUREs are handled thus to allow for nested definitions.
+bool DeclarationVisitor::Pre(const parser::StructureDef &def) {
+ const auto &structureStatement{
+ std::get<parser::Statement<parser::StructureStmt>>(def.t)};
+ auto saveDerivedTypeInfo{derivedTypeInfo_};
+ derivedTypeInfo_ = {};
+ derivedTypeInfo_.isStructure = true;
+ derivedTypeInfo_.sequence = true;
+ Scope *previousStructure{nullptr};
+ if (saveDerivedTypeInfo.isStructure) {
+ previousStructure = &currScope();
+ PopScope();
+ }
+ const parser::StructureStmt &structStmt{structureStatement.statement};
+ const auto &name{std::get<std::optional<parser::Name>>(structStmt.t)};
+ if (!name) {
+ // Construct a distinct generated name for an anonymous structure
+ auto &mutableName{const_cast<std::optional<parser::Name> &>(name)};
+ mutableName.emplace(
+ parser::Name{context().GetTempName(currScope()), nullptr});
+ }
+ auto &symbol{MakeSymbol(*name, DerivedTypeDetails{})};
+ symbol.ReplaceName(name->source);
+ symbol.get<DerivedTypeDetails>().set_sequence(true);
+ symbol.get<DerivedTypeDetails>().set_isDECStructure(true);
+ derivedTypeInfo_.type = &symbol;
+ PushScope(Scope::Kind::DerivedType, &symbol);
+ const auto &fields{std::get<std::list<parser::StructureField>>(def.t)};
+ Walk(fields);
+ PopScope();
+ // Complete the definition
+ DerivedTypeSpec derivedTypeSpec{symbol.name(), symbol};
+ derivedTypeSpec.set_scope(DEREF(symbol.scope()));
+ derivedTypeSpec.CookParameters(GetFoldingContext());
+ derivedTypeSpec.EvaluateParameters(context());
+ DeclTypeSpec &type{currScope().MakeDerivedType(
+ DeclTypeSpec::TypeDerived, std::move(derivedTypeSpec))};
+ type.derivedTypeSpec().Instantiate(currScope());
+ // Restore previous structure definition context, if any
+ derivedTypeInfo_ = saveDerivedTypeInfo;
+ if (previousStructure) {
+ PushScope(*previousStructure);
+ }
+ // Handle any entity declarations on the STRUCTURE statement
+ const auto &decls{std::get<std::list<parser::EntityDecl>>(structStmt.t)};
+ if (!decls.empty()) {
+ BeginDecl();
+ SetDeclTypeSpec(type);
+ Walk(decls);
+ EndDecl();
+ }
+ return false;
+}
+
+bool DeclarationVisitor::Pre(const parser::Union::UnionStmt &) {
+ Say("UNION is not yet supported"_err_en_US); // TODO
+ return true;
+}
+
+bool DeclarationVisitor::Pre(const parser::StructureField &x) {
+ if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>(
+ x.u)) {
+ BeginDecl();
+ }
+ return true;
+}
+
+void DeclarationVisitor::Post(const parser::StructureField &x) {
+ if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>(
+ x.u)) {
+ EndDecl();
+ }
+}
+
bool DeclarationVisitor::Pre(const parser::AllocateStmt &) {
BeginDeclTypeSpec();
return true;
component.name(), "Component with ALLOCATABLE attribute"_en_US);
return;
}
- if (const auto *details{component.detailsIf<ObjectEntityDetails>()}) {
- if (details->init()) {
- Say2(name,
- "Derived type variable '%s' may not appear in a COMMON block"
- " due to component with default initialization"_err_en_US,
- component.name(), "Component with default initialization"_en_US);
- return;
- }
+ const auto *details{component.detailsIf<ObjectEntityDetails>()};
+ if (component.test(Symbol::Flag::InDataStmt) ||
+ (details && details->init())) {
+ Say2(name,
+ "Derived type variable '%s' may not appear in a COMMON block due to component with default initialization"_err_en_US,
+ component.name(), "Component with default initialization"_en_US);
+ return;
+ }
+ if (details) {
if (const auto *type{details->type()}) {
if (const auto *derived{type->AsDerived()}) {
CheckCommonBlockDerivedType(name, derived->typeSymbol());
// Defer analysis to the end of the specification part
// so that forward references and attribute checks like SAVE
// work better.
+ ultimate.set(Symbol::Flag::InDataStmt);
},
[&](const std::list<Indirection<parser::DataStmtValue>> &) {
- // TODO: Need to Walk(init.u); when implementing this case
- if (inComponentDecl) {
- Say(name,
- "Component '%s' initialized with DATA statement values"_err_en_US);
- } else {
- // TODO - DATA statements and DATA-like initialization extension
- }
+ // Handled later in data-to-inits conversion
+ ultimate.set(Symbol::Flag::InDataStmt);
},
},
init.u);
auto locationRestorer{common::ScopedSet(location_, dtSymbol->name())};
// Check for an existing description that can be imported from a USE'd module
std::string typeName{dtSymbol->name().ToString()};
- if (typeName.empty() || typeName[0] == '.') {
+ if (typeName.empty() ||
+ (typeName.front() == '.' && !context_.IsTempName(typeName))) {
return nullptr;
}
std::string distinctName{typeName};
SomeExpr RuntimeTableBuilder::SaveNameAsPointerTarget(
Scope &scope, const std::string &name) {
CHECK(!name.empty());
- CHECK(name.front() != '.');
+ CHECK(name.front() != '.' || context_.IsTempName(name));
ObjectEntityDetails object;
auto len{static_cast<common::ConstantSubscript>(name.size())};
if (const auto *spec{scope.FindType(DeclTypeSpec{CharacterTypeSpec{
SourceName SemanticsContext::GetTempName(const Scope &scope) {
for (const auto &str : tempNames_) {
- if (str.size() > 5 && str.substr(0, 5) == ".F18.") {
+ if (IsTempName(str)) {
SourceName name{str};
if (scope.find(name) == scope.end()) {
return name;
return SaveTempName(".F18."s + std::to_string(tempNames_.size()));
}
+bool SemanticsContext::IsTempName(const std::string &name) {
+ return name.size() > 5 && name.substr(0, 5) == ".F18.";
+}
+
Scope *SemanticsContext::GetBuiltinModule(const char *name) {
return ModFileReader{*this}.Read(
SourceName{name, std::strlen(name)}, nullptr, true /*silence errors*/);
case Character:
return characterTypeSpec().AsFortran();
case TypeDerived:
- return "TYPE(" + derivedTypeSpec().AsFortran() + ')';
+ if (derivedTypeSpec()
+ .typeSymbol()
+ .get<DerivedTypeDetails>()
+ .isDECStructure()) {
+ return "RECORD" + derivedTypeSpec().typeSymbol().name().ToString();
+ } else {
+ return "TYPE(" + derivedTypeSpec().AsFortran() + ')';
+ }
case ClassDerived:
return "CLASS(" + derivedTypeSpec().AsFortran() + ')';
case TypeStar:
--- /dev/null
+! RUN: %python %S/test_modfile.py %s %flang_fc1
+! Check legacy DEC structures
+module m
+ structure /s1/
+ integer n/1/
+ integer na(2)/2,3/
+ structure /s1a/ m, ma(2)
+ integer j/4/
+ integer ja(2)/5,6/
+ end structure
+ structure m2(2), m3 ! anonymous
+ integer k/7/
+ integer %fill(3)
+ integer ka(2)/8,9/
+ real %fill(2)
+ end structure
+ end structure
+ record/s1/ ra1, rb1
+ record/s1a/ ra1a
+ common/s1/ foo ! not a name conflict
+ character*8 s1 ! not a name conflict
+ integer t(2) /2*10/ ! DATA-like entity initialization
+end
+
+!Expect: m.mod
+!module m
+!structure /s1/
+!integer(4)::n=1_4
+!integer(4)::na(1_8:2_8)=[INTEGER(4)::2_4,3_4]
+!structure /s1a/m,ma(1_8:2_8)
+!integer(4)::j=4_4
+!integer(4)::ja(1_8:2_8)=[INTEGER(4)::5_4,6_4]
+!end structure
+!structure m2(1_8:2_8),m3
+!integer(4)::k=7_4
+!integer(4)::%FILL(1_8:3_8)
+!integer(4)::ka(1_8:2_8)=[INTEGER(4)::8_4,9_4]
+!real(4)::%FILL(1_8:2_8)
+!end structure
+!end structure
+!record/s1/::ra1
+!record/s1/::rb1
+!record/s1a/::ra1a
+!real(4)::foo
+!character(8_8,1)::s1
+!integer(4)::t(1_8:2_8)
+!common/s1/foo
+!end
--- /dev/null
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Check for new semantic errors from misuse of the DEC STRUCTURE extension
+program main
+ !ERROR: Derived type '/undeclared/' not found
+ record /undeclared/ var
+ structure /s/
+ !ERROR: /s/ is not a known STRUCTURE
+ record /s/ attemptToRecurse
+ !ERROR: UNION is not yet supported
+ union
+ map
+ integer j
+ end map
+ map
+ real x
+ end map
+ end union
+ end structure
+end
!DEF: /m/op2 POINTER, PUBLIC ObjectEntity REAL(4)
!DEF: /m/null INTRINSIC, PUBLIC, PURE (Function) ProcEntity
real, pointer :: op2 => null()
- !DEF: /m/op3 POINTER, PUBLIC ObjectEntity REAL(4)
+ !DEF: /m/op3 POINTER, PUBLIC (InDataStmt) ObjectEntity REAL(4)
!DEF: /m/x PUBLIC, TARGET ObjectEntity REAL(4)
real, pointer :: op3 => x
- !DEF: /m/op4 POINTER, PUBLIC ObjectEntity REAL(4)
+ !DEF: /m/op4 POINTER, PUBLIC (InDataStmt) ObjectEntity REAL(4)
!DEF: /m/y PUBLIC, TARGET ObjectEntity REAL(4)
real, pointer :: op4 => y(1)
!REF: /m/iface
!DEF: /m/t1/opc2 POINTER ObjectEntity REAL(4)
!REF: /m/null
real, pointer :: opc2 => null()
- !DEF: /m/t1/opc3 POINTER ObjectEntity REAL(4)
+ !DEF: /m/t1/opc3 POINTER (InDataStmt) ObjectEntity REAL(4)
!REF: /m/x
real, pointer :: opc3 => x
- !DEF: /m/t1/opc4 POINTER ObjectEntity REAL(4)
+ !DEF: /m/t1/opc4 POINTER (InDataStmt) ObjectEntity REAL(4)
!REF: /m/y
real, pointer :: opc4 => y(1)
!REF: /m/iface
!DEF: /m/pdt1/opc2 POINTER ObjectEntity REAL(4)
!REF: /m/null
real, pointer :: opc2 => null()
- !DEF: /m/pdt1/opc3 POINTER ObjectEntity REAL(4)
+ !DEF: /m/pdt1/opc3 POINTER (InDataStmt) ObjectEntity REAL(4)
!REF: /m/x
real, pointer :: opc3 => x
- !DEF: /m/pdt1/opc4 POINTER ObjectEntity REAL(4)
+ !DEF: /m/pdt1/opc4 POINTER (InDataStmt) ObjectEntity REAL(4)
!REF: /m/y
!REF: /m/pdt1/k
real, pointer :: opc4 => y(k)
subroutine ext2
end subroutine
end interface
- !DEF: /m/op10 POINTER, PUBLIC ObjectEntity REAL(4)
+ !DEF: /m/op10 POINTER, PUBLIC(InDataStmt) ObjectEntity REAL(4)
!REF: /m/x
real, pointer :: op10 => x
- !DEF: /m/op11 POINTER, PUBLIC ObjectEntity REAL(4)
+ !DEF: /m/op11 POINTER, PUBLIC(InDataStmt) ObjectEntity REAL(4)
!REF: /m/y
real, pointer :: op11 => y(1)
!REF: /m/iface
procedure(iface), pointer :: pp11 => ext2
!DEF: /m/t2 PUBLIC DerivedType
type :: t2
- !DEF: /m/t2/opc10 POINTER ObjectEntity REAL(4)
+ !DEF: /m/t2/opc10 POINTER (InDataStmt) ObjectEntity REAL(4)
!REF: /m/x
real, pointer :: opc10 => x
- !DEF: /m/t2/opc11 POINTER ObjectEntity REAL(4)
+ !DEF: /m/t2/opc11 POINTER (InDataStmt) ObjectEntity REAL(4)
!REF: /m/y
real, pointer :: opc11 => y(1)
!REF: /m/iface
type :: pdt2(k)
!REF: /m/pdt2/k
integer, kind :: k
- !DEF: /m/pdt2/opc10 POINTER ObjectEntity REAL(4)
+ !DEF: /m/pdt2/opc10 POINTER (InDataStmt) ObjectEntity REAL(4)
!REF: /m/x
real, pointer :: opc10 => x
- !DEF: /m/pdt2/opc11 POINTER ObjectEntity REAL(4)
+ !DEF: /m/pdt2/opc11 POINTER (InDataStmt) ObjectEntity REAL(4)
!REF: /m/y
!REF: /m/pdt2/k
real, pointer :: opc11 => y(k)