[flang-commits] [flang] [flang] Fix bogus error on defined I/O procedure. (PR #125898)

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

<details>
<summary>Changes</summary>

The check that "v_list" be deferred shape is just wrong; there are no deferred shape non-pointer non-allocatable dummy arguments in Fortran.  Correct to check for an assumed shape dummy argument.  And de-split the error messages that were split across multiple source lines, making them much harder to find with grep.

Fixes https://github.com/llvm/llvm-project/issues/125878.

---
Full diff: https://github.com/llvm/llvm-project/pull/125898.diff


2 Files Affected:

- (modified) flang/lib/Semantics/check-declarations.cpp (+11-19) 
- (modified) flang/test/Semantics/io11.f90 (+1-1) 


``````````diff
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 5c26469b9fa248..1dc33754143aa5 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -3368,8 +3368,7 @@ void CheckHelper::CheckDioDummyIsDerived(const Symbol &subp, const Symbol &arg,
       }
     } else {
       messages_.Say(arg.name(),
-          "Dummy argument '%s' of a defined input/output procedure must have a"
-          " derived type"_err_en_US,
+          "Dummy argument '%s' of a defined input/output procedure must have a derived type"_err_en_US,
           arg.name());
     }
   }
@@ -3385,16 +3384,14 @@ void CheckHelper::CheckDioDummyIsDefaultInteger(
     }
   }
   messages_.Say(arg.name(),
-      "Dummy argument '%s' of a defined input/output procedure"
-      " must be an INTEGER of default KIND"_err_en_US,
+      "Dummy argument '%s' of a defined input/output procedure must be an INTEGER of default KIND"_err_en_US,
       arg.name());
 }
 
 void CheckHelper::CheckDioDummyIsScalar(const Symbol &subp, const Symbol &arg) {
   if (arg.Rank() > 0 || arg.Corank() > 0) {
     messages_.Say(arg.name(),
-        "Dummy argument '%s' of a defined input/output procedure"
-        " must be a scalar"_err_en_US,
+        "Dummy argument '%s' of a defined input/output procedure must be a scalar"_err_en_US,
         arg.name());
   }
 }
@@ -3471,8 +3468,7 @@ void CheckHelper::CheckDioAssumedLenCharacterArg(const Symbol &subp,
                 context_.defaultKinds().GetDefaultKind(
                     TypeCategory::Character))) {
       messages_.Say(arg->name(),
-          "Dummy argument '%s' of a defined input/output procedure"
-          " must be assumed-length CHARACTER of default kind"_err_en_US,
+          "Dummy argument '%s' of a defined input/output procedure must be assumed-length CHARACTER of default kind"_err_en_US,
           arg->name());
     }
   }
@@ -3485,10 +3481,9 @@ void CheckHelper::CheckDioVlistArg(
     CheckDioDummyIsDefaultInteger(subp, *arg);
     CheckDioDummyAttrs(subp, *arg, Attr::INTENT_IN);
     const auto *objectDetails{arg->detailsIf<ObjectEntityDetails>()};
-    if (!objectDetails || !objectDetails->shape().CanBeDeferredShape()) {
+    if (!objectDetails || !objectDetails->shape().CanBeAssumedShape()) {
       messages_.Say(arg->name(),
-          "Dummy argument '%s' of a defined input/output procedure must be"
-          " deferred shape"_err_en_US,
+          "Dummy argument '%s' of a defined input/output procedure must be assumed shape"_err_en_US,
           arg->name());
     }
   }
@@ -3503,8 +3498,7 @@ void CheckHelper::CheckDioArgCount(
               : 4)};
   if (argCount != requiredArgCount) {
     SayWithDeclaration(subp,
-        "Defined input/output procedure '%s' must have"
-        " %d dummy arguments rather than %d"_err_en_US,
+        "Defined input/output procedure '%s' must have %d dummy arguments rather than %d"_err_en_US,
         subp.name(), requiredArgCount, argCount);
     context_.SetError(subp);
   }
@@ -3516,15 +3510,13 @@ void CheckHelper::CheckDioDummyAttrs(
   Attrs attrs{arg.attrs()};
   if (!attrs.test(goodIntent)) {
     messages_.Say(arg.name(),
-        "Dummy argument '%s' of a defined input/output procedure"
-        " must have intent '%s'"_err_en_US,
+        "Dummy argument '%s' of a defined input/output procedure must have intent '%s'"_err_en_US,
         arg.name(), AttrToString(goodIntent));
   }
   attrs = attrs - Attr::INTENT_IN - Attr::INTENT_OUT - Attr::INTENT_INOUT;
   if (!attrs.empty()) {
     messages_.Say(arg.name(),
-        "Dummy argument '%s' of a defined input/output procedure may not have"
-        " any attributes"_err_en_US,
+        "Dummy argument '%s' of a defined input/output procedure may not have any attributes"_err_en_US,
         arg.name());
   }
 }
@@ -3537,8 +3529,8 @@ void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
     const auto *binding{ultimate.detailsIf<ProcBindingDetails>()};
     const Symbol &specific{*(binding ? &binding->symbol() : &ultimate)};
     if (ultimate.attrs().test(Attr::NOPASS)) { // C774
-      messages_.Say("Defined input/output procedure '%s' may not have NOPASS "
-                    "attribute"_err_en_US,
+      messages_.Say(
+          "Defined input/output procedure '%s' may not have NOPASS attribute"_err_en_US,
           ultimate.name());
       context_.SetError(ultimate);
     }
diff --git a/flang/test/Semantics/io11.f90 b/flang/test/Semantics/io11.f90
index 9b5ad1b8427d91..23f0081f4b9fa3 100644
--- a/flang/test/Semantics/io11.f90
+++ b/flang/test/Semantics/io11.f90
@@ -355,7 +355,7 @@ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
     class(t), intent(inout) :: dtv
     integer, intent(in) :: unit
     character(len=*), intent(in) :: iotype
-    !ERROR: Dummy argument 'vlist' of a defined input/output procedure must be deferred shape
+    !ERROR: Dummy argument 'vlist' of a defined input/output procedure must be assumed shape
     integer, intent(in) :: vlist(5)
     integer, intent(out) :: iostat
     character(len=*), intent(inout) :: iomsg

``````````

</details>


https://github.com/llvm/llvm-project/pull/125898