[flang-commits] [flang] fd922e6 - [flang] Nonconformant assigned gotos
V Donaldson via flang-commits
flang-commits at lists.llvm.org
Wed Apr 5 14:53:38 PDT 2023
Author: V Donaldson
Date: 2023-04-05T14:53:23-07:00
New Revision: fd922e6ab0b5324cdf36e2646132d802d3a04ce0
URL: https://github.com/llvm/llvm-project/commit/fd922e6ab0b5324cdf36e2646132d802d3a04ce0
DIFF: https://github.com/llvm/llvm-project/commit/fd922e6ab0b5324cdf36e2646132d802d3a04ce0.diff
LOG: [flang] Nonconformant assigned gotos
Modify code generation for assigned gotos to generate a runtime error
for most cases that violate F90 Clause 8.2.4, rather than treating a
nonconformant GOTO as a nop. For example, generate a runtime error for
a GOTO that attempts to branch to a label for a FORMAT statement.
Relax the requirement that an assigned GOTO with a label list must
branch to a label in the list, and instead allow a branch to any valid
assigned GOTO target in scope.
Added:
Modified:
flang/lib/Lower/Bridge.cpp
flang/test/Lower/assigned-goto.f90
Removed:
################################################################################
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index f27902c9c08c..2035a62128a3 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -37,6 +37,7 @@
#include "flang/Optimizer/Builder/Runtime/Derived.h"
#include "flang/Optimizer/Builder/Runtime/EnvironmentDefaults.h"
#include "flang/Optimizer/Builder/Runtime/Ragged.h"
+#include "flang/Optimizer/Builder/Runtime/Stop.h"
#include "flang/Optimizer/Builder/Todo.h"
#include "flang/Optimizer/Dialect/FIRAttr.h"
#include "flang/Optimizer/Dialect/FIRDialect.h"
@@ -1030,7 +1031,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
/// values in \p valueList and targets corresponding labels in \p labelList.
/// If no value matches the selector, branch to \p defaultEval.
///
- /// There are two special cases.
+ /// Three cases require special processing.
///
/// An empty \p valueList indicates an ArithmeticIfStmt context that requires
/// two comparisons against 0 or 0.0. The selector may have either INTEGER
@@ -1041,6 +1042,11 @@ class FirConverter : public Fortran::lower::AbstractConverter {
/// any positive (IOSTAT) value. A missing (zero) label requires a branch
/// to \p defaultEval for that value.
///
+ /// A non-null \p errorBlock indicates an AssignedGotoStmt context that
+ /// must always branch to an explicit target. There is no valid defaultEval
+ /// in this case. Generate a branch to \p errorBlock for an AssignedGotoStmt
+ /// that violates this program requirement.
+ ///
/// If this is not an ArithmeticIfStmt and no targets have exit code,
/// generate a SelectOp. Otherwise, for each target, if it has exit code,
/// branch to a new block, insert exit code, and then branch to the target.
@@ -1048,12 +1054,14 @@ class FirConverter : public Fortran::lower::AbstractConverter {
void genMultiwayBranch(mlir::Value selector,
llvm::SmallVector<int64_t> valueList,
llvm::SmallVector<Fortran::parser::Label> labelList,
- const Fortran::lower::pft::Evaluation &defaultEval) {
+ const Fortran::lower::pft::Evaluation &defaultEval,
+ mlir::Block *errorBlock = nullptr) {
bool inArithmeticIfContext = valueList.empty();
assert(((inArithmeticIfContext && labelList.size() == 2) ||
(valueList.size() && labelList.size() == valueList.size())) &&
"mismatched multiway branch targets");
- bool defaultHasExitCode = hasExitCode(defaultEval);
+ mlir::Block *defaultBlock = errorBlock ? errorBlock : defaultEval.block;
+ bool defaultHasExitCode = !errorBlock && hasExitCode(defaultEval);
bool hasAnyExitCode = defaultHasExitCode;
if (!hasAnyExitCode)
for (auto label : labelList)
@@ -1073,7 +1081,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
assert(block && "missing multiway branch block");
blockList.push_back(block);
}
- blockList.push_back(defaultEval.block);
+ blockList.push_back(defaultBlock);
if (valueList[branchCount - 1] == 0) // Swap IO ERR and default blocks.
std::swap(blockList[branchCount - 1], blockList[branchCount]);
builder->create<fir::SelectOp>(loc, selector, valueList, blockList);
@@ -1112,11 +1120,11 @@ class FirConverter : public Fortran::lower::AbstractConverter {
builder->createIntegerConstant(loc, selectorType,
valueList[label.index()]));
// Branch to a new block with exit code and then to the target, or branch
- // directly to the target. defaultEval is the "else" target.
+ // directly to the target. defaultBlock is the "else" target.
bool lastBranch = label.index() == branchCount - 1;
mlir::Block *nextBlock =
lastBranch && !defaultHasExitCode
- ? defaultEval.block
+ ? defaultBlock
: builder->getBlock()->splitBlock(builder->getInsertionPoint());
const Fortran::lower::pft::Evaluation &targetEval =
label.value() ? evalOfLabel(label.value()) : defaultEval;
@@ -1344,50 +1352,48 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
void genFIR(const Fortran::parser::AssignedGotoStmt &stmt) {
- // Program requirement 1990 8.2.4 -
- //
- // At the time of execution of an assigned GOTO statement, the integer
- // variable must be defined with the value of a statement label of a
- // branch target statement that appears in the same scoping unit.
- // Note that the variable may be defined with a statement label value
- // only by an ASSIGN statement in the same scoping unit as the assigned
- // GOTO statement.
-
+ // See Fortran 90 Clause 8.2.4.
+ // Relax the requirement that the GOTO variable must have a value in the
+ // label list when a list is present, and allow a branch to any non-format
+ // target that has an ASSIGN statement for the variable.
mlir::Location loc = toLocation();
Fortran::lower::pft::Evaluation &eval = getEval();
+ Fortran::lower::pft::FunctionLikeUnit &owningProc =
+ *eval.getOwningProcedure();
const Fortran::lower::pft::SymbolLabelMap &symbolLabelMap =
- eval.getOwningProcedure()->assignSymbolLabelMap;
+ owningProc.assignSymbolLabelMap;
+ const Fortran::lower::pft::LabelEvalMap &labelEvalMap =
+ owningProc.labelEvaluationMap;
const Fortran::semantics::Symbol &symbol =
*std::get<Fortran::parser::Name>(stmt.t).symbol;
- auto selectExpr =
- builder->create<fir::LoadOp>(loc, getSymbolAddress(symbol));
- auto iter = symbolLabelMap.find(symbol);
- if (iter == symbolLabelMap.end()) {
- // Fail for a nonconforming program unit that does not have any ASSIGN
- // statements. The front end should check for this.
- mlir::emitError(loc, "(semantics issue) no assigned goto targets");
- exit(1);
- }
- auto labelSet = iter->second;
+ auto labelSetIter = symbolLabelMap.find(symbol);
llvm::SmallVector<int64_t> valueList;
llvm::SmallVector<Fortran::parser::Label> labelList;
- // Add labels from an explicit list. The list may have duplicates.
- for (Fortran::parser::Label label :
- std::get<std::list<Fortran::parser::Label>>(stmt.t)) {
- // Ignore duplicates.
- if (labelSet.count(label) && !llvm::is_contained(labelList, label)) {
- valueList.push_back(label); // label as an integer
- labelList.push_back(label);
+ if (labelSetIter != symbolLabelMap.end()) {
+ for (auto &label : labelSetIter->second) {
+ const auto evalIter = labelEvalMap.find(label);
+ assert(evalIter != labelEvalMap.end() && "assigned goto label missing");
+ if (evalIter->second->block) { // non-format statement
+ valueList.push_back(label); // label as an integer
+ labelList.push_back(label);
+ }
}
}
- // Absent an explicit list, add all possible label targets.
- if (labelList.empty())
- for (auto &label : labelSet) {
- valueList.push_back(label); // label as an integer
- labelList.push_back(label);
- }
- // Add a nop/fallthrough branch for a nonconforming program.
- genMultiwayBranch(selectExpr, valueList, labelList, eval.nonNopSuccessor());
+ if (!labelList.empty()) {
+ auto selectExpr =
+ builder->create<fir::LoadOp>(loc, getSymbolAddress(symbol));
+ // Add a default error target in case the goto is nonconforming.
+ mlir::Block *errorBlock =
+ builder->getBlock()->splitBlock(builder->getInsertionPoint());
+ genMultiwayBranch(selectExpr, valueList, labelList,
+ eval.nonNopSuccessor(), errorBlock);
+ startBlock(errorBlock);
+ }
+ fir::runtime::genReportFatalUserError(
+ *builder, loc,
+ "Assigned GOTO variable '" + symbol.name().ToString() +
+ "' does not have a valid target label value");
+ builder->create<fir::UnreachableOp>(loc);
}
/// Collect DO CONCURRENT or FORALL loop control information.
diff --git a/flang/test/Lower/assigned-goto.f90 b/flang/test/Lower/assigned-goto.f90
index 81690b7113d0..4184839337de 100644
--- a/flang/test/Lower/assigned-goto.f90
+++ b/flang/test/Lower/assigned-goto.f90
@@ -7,6 +7,7 @@ subroutine nolist
! CHECK: fir.store %c31{{.*}} to %{{.}}
assign 31 to L
! CHECK: fir.select %{{.}} : i32 [31, ^bb{{.}}, unit, ^bb{{.}}]
+ ! CHECK: fir.call @_FortranAReportFatalUserError
goto L ! no list
21 V = 2
go to 41
@@ -16,13 +17,17 @@ subroutine nolist
! CHECK-LABEL: func @_QPlist
subroutine list
- integer L, V
+ integer L, L1, V
+ 66 format("Nonsense")
+ assign 66 to L
+ assign 42 to L1
! CHECK: fir.store %c22{{.*}} to %{{.}}
assign 22 to L
12 V = 100
! CHECK: fir.store %c32{{.*}} to %{{.}}
assign 32 to L
- ! CHECK: fir.select %{{.}} : i32 [32, ^bb{{.}}, 22, ^bb{{.}}, unit, ^bb{{.}}]
+ ! CHECK: fir.select %{{.}} : i32 [22, ^bb{{.}}, 32, ^bb{{.}}, unit, ^bb{{.}}]
+ ! CHECK: fir.call @_FortranAReportFatalUserError
goto L (42, 32, 22, 32, 32) ! duplicate labels are allowed
22 V = 200
go to 42
More information about the flang-commits
mailing list