[flang-commits] [PATCH] D158039: [flang] Runtime assigned format errors

vdonaldson via Phabricator via flang-commits flang-commits at lists.llvm.org
Tue Aug 15 16:40:20 PDT 2023


vdonaldson created this revision.
vdonaldson added a project: Flang.
Herald added subscribers: mehdi_amini, jdoerfert.
Herald added a reviewer: sscalpone.
Herald added a project: All.
vdonaldson requested review of this revision.

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

  if (.true.) print n
  end


https://reviews.llvm.org/D158039

Files:
  flang/lib/Lower/IO.cpp
  flang/test/Lower/format-statement.f90


Index: flang/test/Lower/format-statement.f90
===================================================================
--- flang/test/Lower/format-statement.f90
+++ flang/test/Lower/format-statement.f90
@@ -22,12 +22,16 @@
     ! 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
@@ -39,6 +43,8 @@
        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
Index: flang/lib/Lower/IO.cpp
===================================================================
--- flang/lib/Lower/IO.cpp
+++ flang/lib/Lower/IO.cpp
@@ -28,6 +28,7 @@
 #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"
@@ -1639,12 +1640,6 @@
                              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();
@@ -1657,9 +1652,7 @@
 
   auto symbol = GetLastSymbol(&expr);
   Fortran::lower::pft::LabelSet labels;
-  [[maybe_unused]] auto foundLabelSet =
-      converter.lookupLabelSet(*symbol, labels);
-  assert(foundLabelSet && "Label not found in map");
+  converter.lookupLabelSet(*symbol, labels);
 
   for (auto label : labels) {
     indexList.push_back(label);
@@ -1698,11 +1691,11 @@
   // 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.


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D158039.550543.patch
Type: text/x-patch
Size: 3391 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230815/342377d2/attachment-0001.bin>


More information about the flang-commits mailing list