[flang] Runtime assigned format errors

[vdonaldson]

Summary

Generate a runtime error message for a reference to an invalid
assigned format such as:

if (.true.) print n
end

[PeteSteinfeld]

All builds and tests correctly and looks good.

[vdonaldson]

https://reviews.llvm.org/D158039

flang/lib/Lower/IO.cpp

 #include "flang/Lower/Runtime.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/Support/Utils.h"
 #include "flang/Lower/VectorSubscripts.h"
 #include "flang/Optimizer/Builder/Character.h"
 #include "flang/Optimizer/Builder/Complex.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
+#include "flang/Optimizer/Builder/Runtime/Stop.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/Dialect/FIRDialect.h"
 #include "flang/Optimizer/Dialect/Support/FIRContext.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Runtime/io-api.h"
 #include "flang/Semantics/runtime-type-info.h"
 #include "flang/Semantics/tools.h"
 #include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h"

 /// Lowers a format statment that uses an assigned variable label reference as
 /// a select operation to allow for run-time selection of the format statement.
 static std::tuple<mlir::Value, mlir::Value, mlir::Value>
 lowerReferenceAsStringSelect(Fortran::lower::AbstractConverter &converter,
                              mlir::Location loc,
                              const Fortran::lower::SomeExpr &expr,
                              mlir::Type strTy, mlir::Type lenTy,
                              Fortran::lower::StatementContext &stmtCtx) {
-  // Possible optimization TODO: Instead of inlining a selectOp every time there
-  // is a variable reference to a format statement, a function with the selectOp
-  // could be generated to reduce code size. It is not clear if such an
-  // optimization would be deployed very often or improve the object code
-  // beyond, say, what GVN/GCM might produce.
-
   // Create the requisite blocks to inline a selectOp.
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   mlir::Block *startBlock = builder.getBlock();
   mlir::Block *endBlock = startBlock->splitBlock(builder.getInsertionPoint());
   mlir::Block *block = startBlock->splitBlock(builder.getInsertionPoint());
   builder.setInsertionPointToEnd(block);
 
   llvm::SmallVector<int64_t> indexList;
   llvm::SmallVector<mlir::Block *> blockList;
 
   auto symbol = GetLastSymbol(&expr);
   Fortran::lower::pft::LabelSet labels;
-  [[maybe_unused]] auto foundLabelSet =
-      converter.lookupLabelSet(*symbol, labels);
-  assert(foundLabelSet && "Label not found in map");
 
   for (auto label : labels) {
     indexList.push_back(label);
     auto *eval = converter.lookupLabel(label);
     assert(eval && "Label is missing from the table");
 
     llvm::StringRef text = toStringRef(eval->position);
     mlir::Value stringRef;
for (auto label : labels) {
     blockList.push_back(block);
     block = block->splitBlock(builder.getInsertionPoint());
     builder.setInsertionPointToEnd(block);
   }
 
   // Create the unit case which should result in an error.
   auto *unitBlock = block->splitBlock(builder.getInsertionPoint());
   builder.setInsertionPointToEnd(unitBlock);
-
-  // Crash the program.
+  fir::runtime::genReportFatalUserError(
+      builder, loc,
+      "Assigned format variable '" + symbol->name().ToString() +
+          "' has not been assigned a valid format label");
   builder.create<fir::UnreachableOp>(loc);
-
-  // Add unit case to the select statement.
   blockList.push_back(unitBlock);
 
   // Lower the selectOp.
   builder.setInsertionPointToEnd(startBlock);
   auto label = fir::getBase(converter.genExprValue(loc, &expr, stmtCtx));
   builder.create<fir::SelectOp>(loc, label, indexList, blockList);
 
   builder.setInsertionPointToEnd(endBlock);

flang/test/Lower/format-statement.f90

subroutine formatAssign(flag1, flag2, flag3)
     ! CHECK: cond_br %{{.*}}, ^bb[[BLK1:.*]], ^bb[[BLK2:.*]]
     ! CHECK: ^bb[[BLK1]]:
     ! CHECK: fir.store %[[ONE]]
     ! CHECK: br ^bb[[END_BLOCK:.*]]
     ! CHECK: ^bb[[BLK2]]:
     ! CHECK: fir.store %[[TWO]]
     ! CHECK: br ^bb[[END_BLOCK]]
     ! CHECK: ^bb[[END_BLOCK]]
+    ! CHECK: fir.call @{{.*}}ReportFatalUserError
+    ! CHECK: fir.unreachable
     ! CHECK: fir.call @{{.*}}BeginExternalFormattedOutput
     ! CHECK: fir.call @{{.*}}OutputAscii
     ! CHECK: fir.call @{{.*}}OutputReal32
     ! CHECK: fir.call @{{.*}}EndIoStatement
     pi = 3.141592653589
     write(*, label) " PI=", pi
+    ! CHECK: fir.call @{{.*}}ReportFatalUserError
+    ! CHECK: fir.unreachable
     ! CHECK: fir.call @{{.*}}BeginExternalFormattedOutput
     ! CHECK: fir.call @{{.*}}OutputAscii
     ! CHECK: fir.call @{{.*}}OutputReal32
     ! CHECK: fir.call @{{.*}}EndIoStatement
     if (flag2) write(*, label) "2PI=", 2*pi
     if (flag1 .and. flag2 .and. flag3) then
        assign 100 to label
     else
        assign 200 to label
     end if
     if (flag3) then
+      ! CHECK: fir.call @{{.*}}ReportFatalUserError
+      ! CHECK: fir.unreachable
       ! CHECK: fir.call @{{.*}}BeginExternalFormattedOutput
       ! CHECK: fir.call @{{.*}}OutputAscii
       ! CHECK: fir.call @{{.*}}OutputReal32
       ! CHECK: fir.call @{{.*}}EndIoStatement
       write(*, label) "3PI=", 3*pi
     endif
 
 100 format (A, F10.3)