diff --git a/flang/lib/Semantics/rewrite-parse-tree.cpp b/flang/lib/Semantics/rewrite-parse-tree.cpp index c90ae66342840..577558e7e33b2 100644 --- a/flang/lib/Semantics/rewrite-parse-tree.cpp +++ b/flang/lib/Semantics/rewrite-parse-tree.cpp @@ -40,8 +40,11 @@ class RewriteMutator { template void Post(T &) {} void Post(parser::Name &); - void Post(parser::SpecificationPart &); - bool Pre(parser::ExecutionPart &); + bool Pre(parser::MainProgram &); + bool Pre(parser::FunctionSubprogram &); + bool Pre(parser::SubroutineSubprogram &); + bool Pre(parser::SeparateModuleSubprogram &); + bool Pre(parser::BlockConstruct &); bool Pre(parser::ActionStmt &); void Post(parser::ReadStmt &); void Post(parser::WriteStmt &); @@ -65,12 +68,11 @@ class RewriteMutator { bool Pre(parser::EndTypeStmt &) { return false; } private: - using stmtFuncType = - parser::Statement>; + void FixMisparsedStmtFuncs(parser::SpecificationPart &, parser::Block &); + SemanticsContext &context_; bool errorOnUnresolvedName_{true}; parser::Messages &messages_; - std::list stmtFuncsToConvert_; }; // Check that name has been resolved to a symbol @@ -94,23 +96,33 @@ static bool ReturnsDataPointer(const Symbol &symbol) { return false; } -// Find mis-parsed statement functions and move to stmtFuncsToConvert_ list. -void RewriteMutator::Post(parser::SpecificationPart &x) { - auto &list{std::get>(x.t)}; +// Finds misparsed statement functions in a specification part, rewrites +// them into array element assignment statements, and moves them into the +// beginning of the corresponding (execution part's) block. +void RewriteMutator::FixMisparsedStmtFuncs( + parser::SpecificationPart &specPart, parser::Block &block) { + auto &list{std::get>(specPart.t)}; + auto origFirst{block.begin()}; // insert each elem before origFirst for (auto it{list.begin()}; it != list.end();) { - bool isAssignment{false}; - if (auto *stmt{std::get_if(&it->u)}) { + bool convert{false}; + if (auto *stmt{std::get_if< + parser::Statement>>( + &it->u)}) { if (const Symbol * symbol{std::get(stmt->statement.value().t).symbol}) { const Symbol &ultimate{symbol->GetUltimate()}; - isAssignment = + convert = ultimate.has() || ReturnsDataPointer(ultimate); - if (isAssignment) { - stmtFuncsToConvert_.emplace_back(std::move(*stmt)); + if (convert) { + auto newStmt{stmt->statement.value().ConvertToAssignment()}; + newStmt.source = stmt->source; + block.insert(origFirst, + parser::ExecutionPartConstruct{ + parser::ExecutableConstruct{std::move(newStmt)}}); } } } - if (isAssignment) { + if (convert) { it = list.erase(it); } else { ++it; @@ -118,17 +130,33 @@ void RewriteMutator::Post(parser::SpecificationPart &x) { } } -// Insert converted assignments at start of ExecutionPart. -bool RewriteMutator::Pre(parser::ExecutionPart &x) { - auto origFirst{x.v.begin()}; // insert each elem before origFirst - for (stmtFuncType &sf : stmtFuncsToConvert_) { - auto stmt{sf.statement.value().ConvertToAssignment()}; - stmt.source = sf.source; - x.v.insert(origFirst, - parser::ExecutionPartConstruct{ - parser::ExecutableConstruct{std::move(stmt)}}); - } - stmtFuncsToConvert_.clear(); +bool RewriteMutator::Pre(parser::MainProgram &program) { + FixMisparsedStmtFuncs(std::get(program.t), + std::get(program.t).v); + return true; +} + +bool RewriteMutator::Pre(parser::FunctionSubprogram &func) { + FixMisparsedStmtFuncs(std::get(func.t), + std::get(func.t).v); + return true; +} + +bool RewriteMutator::Pre(parser::SubroutineSubprogram &subr) { + FixMisparsedStmtFuncs(std::get(subr.t), + std::get(subr.t).v); + return true; +} + +bool RewriteMutator::Pre(parser::SeparateModuleSubprogram &subp) { + FixMisparsedStmtFuncs(std::get(subp.t), + std::get(subp.t).v); + return true; +} + +bool RewriteMutator::Pre(parser::BlockConstruct &block) { + FixMisparsedStmtFuncs(std::get(block.t).v, + std::get(block.t)); return true; } diff --git a/flang/test/Semantics/rewrite03.f90 b/flang/test/Semantics/rewrite03.f90 new file mode 100644 index 0000000000000..03d09f0af2432 --- /dev/null +++ b/flang/test/Semantics/rewrite03.f90 @@ -0,0 +1,50 @@ +!RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s +!Test rewriting of misparsed statement function definitions +!into array element assignment statements. + +program main + real sf(1) + integer :: j = 1 +!CHECK: sf(int(j,kind=8))=1._4 + sf(j) = 1. +end + +function func + real sf(1) + integer :: j = 1 +!CHECK: sf(int(j,kind=8))=2._4 + sf(j) = 2. + func = 0. +end + +subroutine subr + real sf(1) + integer :: j = 1 +!CHECK: sf(int(j,kind=8))=3._4 + sf(j) = 3. +end + +module m + interface + module subroutine smp + end + end interface +end +submodule(m) sm + contains + module procedure smp + real sf(1) + integer :: j = 1 +!CHECK: sf(int(j,kind=8))=4._4 + sf(j) = 4. + end +end + +subroutine block + block + real sf(1) + integer :: j = 1 +!CHECK: sf(int(j,kind=8))=5._4 + sf(j) = 5. + end block +end