[flang] IO condition specfier control flow

[vdonaldson]

Summary

Execution of a statement such as

read(internal,*,err=666,iostat=stat) k

that terminates with an END or EOR condition must not take the ERR branch.

[PeteSteinfeld]

All builds and tests correctly and looks good.

[vdonaldson]

https://reviews.llvm.org/D147338

flang/lib/Lower/Bridge.cpp

genConstructExitBranch(const Fortran::lower::pft::Evaluation &targetEval) {
     }
     genBranch(targetEval.block);
   }
 
   /// Generate a SelectOp or branch sequence that compares \p selector against
   /// 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. If \p inIoErrContext, the ERR label branch
-  /// is an inverted comparison (ne vs. eq 0). An empty \p valueList indicates
-  /// an ArithmeticIfStmt context that requires two comparisons against 0,
-  /// and the selector may have either INTEGER or REAL type.
+  /// There are two special cases.
+  ///
+  /// An empty \p valueList indicates an ArithmeticIfStmt context that requires
+  /// two comparisons against 0 or 0.0. The selector may have either INTEGER
+  /// or REAL type.
+  ///
+  /// A nonpositive \p valuelist value indicates an IO statement context
+  /// (0 for ERR, -1 for END, -2 for EOR). An ERR branch must be taken for
+  /// any positive (IOSTAT) value. A missing (zero) label requires a branch
+  /// to \p defaultEval for that value.
   ///
   /// 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.
   /// Otherwise, branch directly to the target.
   void genMultiwayBranch(mlir::Value selector,
                          llvm::SmallVector<int64_t> valueList,
                          llvm::SmallVector<Fortran::parser::Label> labelList,
-                         const Fortran::lower::pft::Evaluation &defaultEval,
-                         bool inIoErrContext = false) {
+                         const Fortran::lower::pft::Evaluation &defaultEval) {
     bool inArithmeticIfContext = valueList.empty();
     assert(((inArithmeticIfContext && labelList.size() == 2) ||
             (valueList.size() && labelList.size() == valueList.size())) &&
            "mismatched multiway branch targets");
     bool defaultHasExitCode = hasExitCode(defaultEval);
     bool hasAnyExitCode = defaultHasExitCode;
     if (!hasAnyExitCode)
       for (auto label : labelList)
-        if (hasExitCode(evalOfLabel(label))) {
+        if (label && hasExitCode(evalOfLabel(label))) {
           hasAnyExitCode = true;
           break;
         }
     mlir::Location loc = toLocation();
     size_t branchCount = labelList.size();
     if (!inArithmeticIfContext && !hasAnyExitCode &&
         !getEval().forceAsUnstructured()) { // from -no-structured-fir option
       // Generate a SelectOp.
       llvm::SmallVector<mlir::Block *> blockList;
-      for (auto label : labelList)
-        blockList.push_back(evalOfLabel(label).block);
+      for (auto label : labelList) {
+        mlir::Block *block =
+            label ? evalOfLabel(label).block : defaultEval.block;
+        assert(block && "missing multiway branch block");
+        blockList.push_back(block);
+      }
       blockList.push_back(defaultEval.block);
-      if (inIoErrContext) { // Swap ERR and default fallthrough blocks.
-        assert(!valueList[branchCount - 1] && "invalid IO ERR value");
+      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);
       return;
     }
     mlir::Type selectorType = selector.getType();
     bool realSelector = selectorType.isa<mlir::FloatType>();
     assert((inArithmeticIfContext || !realSelector) && "invalid selector type");
     mlir::Value zero;
     if (inArithmeticIfContext)
       zero =
           realSelector
               ? builder->create<mlir::arith::ConstantOp>(
                     loc, selectorType, builder->getFloatAttr(selectorType, 0.0))
               : builder->createIntegerConstant(loc, selectorType, 0);
     for (auto label : llvm::enumerate(labelList)) {
       mlir::Value cond;
       if (realSelector) // inArithmeticIfContext
         cond = builder->create<mlir::arith::CmpFOp>(
             loc,
             label.index() == 0 ? mlir::arith::CmpFPredicate::OLT
                                : mlir::arith::CmpFPredicate::OGT,
             selector, zero);
-      else if (inArithmeticIfContext)
+      else if (inArithmeticIfContext) // INTEGER selector
         cond = builder->create<mlir::arith::CmpIOp>(
             loc,
             label.index() == 0 ? mlir::arith::CmpIPredicate::slt
                                : mlir::arith::CmpIPredicate::sgt,
             selector, zero);
-      else
+      else // A value of 0 is an IO ERR branch: invert comparison.
         cond = builder->create<mlir::arith::CmpIOp>(
             loc,
-            inIoErrContext && valueList[label.index()] == 0
-                ? mlir::arith::CmpIPredicate::ne
+            valueList[label.index()] == 0 ? mlir::arith::CmpIPredicate::ne
                                           : mlir::arith::CmpIPredicate::eq,
             selector,
             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 acts as an "else" target.
+      // directly to the target. defaultEval is the "else" target.
       bool lastBranch = label.index() == branchCount - 1;
       mlir::Block *nextBlock =
           lastBranch && !defaultHasExitCode
               ? defaultEval.block
               : builder->getBlock()->splitBlock(builder->getInsertionPoint());
-      if (hasExitCode(evalOfLabel(label.value()))) {
+      const Fortran::lower::pft::Evaluation &targetEval =
+          label.value() ? evalOfLabel(label.value()) : defaultEval;
+      if (hasExitCode(targetEval)) {
         mlir::Block *jumpBlock =
             builder->getBlock()->splitBlock(builder->getInsertionPoint());
         genConditionalBranch(cond, jumpBlock, nextBlock);
         startBlock(jumpBlock);
-        genConstructExitBranch(evalOfLabel(label.value()));
+        genConstructExitBranch(targetEval);
       } else {
-        genConditionalBranch(cond, evalOfLabel(label.value()).block, nextBlock);
+        genConditionalBranch(cond, targetEval.block, nextBlock);
       }
       if (!lastBranch) {
         startBlock(nextBlock);
       } else if (defaultHasExitCode) {
         startBlock(nextBlock);
         genConstructExitBranch(defaultEval);
       }
     }
void genFIR(const Fortran::parser::ArithmeticIfStmt &stmt) {
     mlir::Value expr = createFIRExpr(
         toLocation(),
         Fortran::semantics::GetExpr(std::get<Fortran::parser::Expr>(stmt.t)),
         stmtCtx);
     stmtCtx.finalizeAndReset();
     // Raise an exception if REAL expr is a NaN.
     if (expr.getType().isa<mlir::FloatType>())
       expr = builder->create<mlir::arith::AddFOp>(toLocation(), expr, expr);
+    // An empty valueList indicates to genMultiwayBranch that the branch is
+    // an ArithmeticIfStmt that has two branches on value 0 or 0.0.
     llvm::SmallVector<int64_t> valueList;
     llvm::SmallVector<Fortran::parser::Label> labelList;
     labelList.push_back(std::get<1>(stmt.t));
     labelList.push_back(std::get<3>(stmt.t));
     const Fortran::lower::pft::LabelEvalMap &labelEvaluationMap =
         getEval().getOwningProcedure()->labelEvaluationMap;
     const auto iter = labelEvaluationMap.find(std::get<2>(stmt.t));
     assert(iter != labelEvaluationMap.end() && "label missing from map");

   void genIoConditionBranches(Fortran::lower::pft::Evaluation &eval,
                               const A &specList, mlir::Value iostat) {
     if (!iostat)
       return;
 
     Fortran::parser::Label endLabel{};
     Fortran::parser::Label eorLabel{};
     Fortran::parser::Label errLabel{};
+    bool hasIostat{};
     for (const auto &spec : specList) {
-      std::visit(Fortran::common::visitors{
-                     [&](const Fortran::parser::EndLabel &label) {
-                       endLabel = label.v;
-                     },
-                     [&](const Fortran::parser::EorLabel &label) {
-                       eorLabel = label.v;
-                     },
-                     [&](const Fortran::parser::ErrLabel &label) {
-                       errLabel = label.v;
-                     },
-                     [](const auto &) {}},
-                 spec.u);
+      std::visit(
+          Fortran::common::visitors{
+              [&](const Fortran::parser::StatVariable &) { hasIostat = true; },
     }
     if (!endLabel && !eorLabel && !errLabel)
       return;
 
+    // An ERR specifier branch is taken on any positive error value rather than
+    // some single specific value. If ERR and IOSTAT specifiers are given and
+    // END and EOR specifiers are allowed, the latter two specifiers must have
+    // explicit branch targets to allow the ERR branch to be implemented as a
+    // default/else target. A label=0 target for an absent END or EOR specifier
+    // indicates that these specifiers have a fallthrough target. END and EOR
+    // specifiers may appear on READ and WAIT statements.
+    bool allSpecifiersRequired = errLabel && hasIostat &&
+                                 (eval.isA<Fortran::parser::ReadStmt>() ||
+                                  eval.isA<Fortran::parser::WaitStmt>());
     mlir::Value selector =
         builder->createConvert(toLocation(), builder->getIndexType(), iostat);
-    llvm::SmallVector<int64_t> indexList;
+    llvm::SmallVector<int64_t> valueList;
     llvm::SmallVector<Fortran::parser::Label> labelList;
-    if (eorLabel) {
-      indexList.push_back(Fortran::runtime::io::IostatEor);
-      labelList.push_back(eorLabel);
-    }
-    if (endLabel) {
-      indexList.push_back(Fortran::runtime::io::IostatEnd);
-      labelList.push_back(endLabel);
+    if (eorLabel || allSpecifiersRequired) {
+      valueList.push_back(Fortran::runtime::io::IostatEor);
+      labelList.push_back(eorLabel ? eorLabel : 0);
+    }
+    if (endLabel || allSpecifiersRequired) {
+      valueList.push_back(Fortran::runtime::io::IostatEnd);
+      labelList.push_back(endLabel ? endLabel : 0);
     }
     if (errLabel) {
-      // IostatEor and IostatEnd are fixed negative values. IOSTAT ERR values
-      // are positive. Placing the ERR value last allows recognition of an
-      // unexpected negative value as an error.
-      indexList.push_back(0);
+      // Must be last. Value 0 is interpreted as any positive value, or
+      // equivalently as any value other than 0, IostatEor, or IostatEnd.
+      valueList.push_back(0);
       labelList.push_back(errLabel);
     }
-    genMultiwayBranch(selector, indexList, labelList, eval.nonNopSuccessor(),
-                      /*inIoErrContext=*/errLabel != Fortran::parser::Label{});
+    genMultiwayBranch(selector, valueList, labelList, eval.nonNopSuccessor());
   }
 
   //===--------------------------------------------------------------------===//
   // Memory allocation and deallocation
   //===--------------------------------------------------------------------===//
 
   void genFIR(const Fortran::parser::AllocateStmt &stmt) {
     Fortran::lower::genAllocateStmt(*this, stmt, toLocation());

flang/test/Lower/io-statement-2.f90

 ! CHECK: = arith.select
 ! CHECK: fir.result
 ! CHECK: fir.if %{{[0-9]*}}#1
 ! CHECK: OutputInteger
 ! CHECK: EndIoStatement
 write(*,'(8F4.1,I5)',iostat=m) (c,d,j=11,14), j
 end
 
+! CHECK-LABEL: func @_QPcontrol3
+subroutine control3 ! I/O condition specifier control flow
+    character(10) :: internal(2) = ['aaa','bbb']
+    integer stat, k(3)
+    ! CHECK:   BeginInternalArrayListInput
+    ! CHECK:   EnableHandlers
+    ! CHECK:   InputDescriptor
+    ! CHECK:   %[[V_15:[0-9]+]] = fir.call @_FortranAioEndIoStatement
+    ! CHECK:   %[[V_16:[0-9]+]] = fir.convert %[[V_15]] : (i32) -> index
+    ! CHECK:   fir.select %[[V_16]] : index [-2, ^bb1, -1, ^bb1, 0, ^bb1, unit, ^bb2]
+    read(internal,*,err=666,iostat=stat) k ! set stat to IOSTAT_END (-1)
+    ! CHECK: ^bb1:  // 3 preds: ^bb0, ^bb0, ^bb0
+    ! CHECK:   StopStatementText
+    ! CHECK:   fir.unreachable
+    stop 'fallthrough -> ok'
+    ! CHECK: ^bb2:  // pred: ^bb0
+    ! CHECK:   BeginExternalListOutput
+    ! CHECK:   OutputAscii
+    ! CHECK:   EndIoStatement
+666 print*, 'FAIL'
+    end
+
 ! CHECK-LABEL: func @_QPloopnest
 subroutine loopnest
    integer :: aa(3,3)
    aa = 10
    ! CHECK: BeginExternalListOutput
    ! CHECK: EnableHandlers
    ! CHECK: {{.*}}:2 = fir.iterate_while ({{.*}} = {{.*}} to {{.*}} step {{.*}}) and ({{.*}} = {{.*}}) -> (index, i1) {
    ! CHECK:   fir.if {{.*}} -> (i1) {