[flang-commits] [flang] [flang] Stricter checking of v_list DIO arguments (PR #139329)

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

<details>
<summary>Changes</summary>

Catch assumed-rank arguments to defined I/O subroutines, and ensure that v_list dummy arguments are vectors.

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

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


2 Files Affected:

- (modified) flang/lib/Semantics/check-declarations.cpp (+11-4) 
- (modified) flang/test/Semantics/io11.f90 (+46-3) 


``````````diff
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 318085518cc57..25117964e078f 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1192,7 +1192,7 @@ void CheckHelper::CheckObjectEntity(
           typeName);
     } else if (evaluate::IsAssumedRank(symbol)) {
       SayWithDeclaration(symbol,
-          "Assumed Rank entity of %s type is not supported"_err_en_US,
+          "Assumed rank entity of %s type is not supported"_err_en_US,
           typeName);
     }
   }
@@ -3414,7 +3414,13 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
 bool CheckHelper::CheckDioDummyIsData(
     const Symbol &subp, const Symbol *arg, std::size_t position) {
   if (arg && arg->detailsIf<ObjectEntityDetails>()) {
-    return true;
+    if (evaluate::IsAssumedRank(*arg)) {
+      messages_.Say(arg->name(),
+          "Dummy argument '%s' may not be assumed-rank"_err_en_US, arg->name());
+      return false;
+    } else {
+      return true;
+    }
   } else {
     if (arg) {
       messages_.Say(arg->name(),
@@ -3592,9 +3598,10 @@ void CheckHelper::CheckDioVlistArg(
     CheckDioDummyIsDefaultInteger(subp, *arg);
     CheckDioDummyAttrs(subp, *arg, Attr::INTENT_IN);
     const auto *objectDetails{arg->detailsIf<ObjectEntityDetails>()};
-    if (!objectDetails || !objectDetails->shape().CanBeAssumedShape()) {
+    if (!objectDetails || !objectDetails->shape().CanBeAssumedShape() ||
+        objectDetails->shape().Rank() != 1) {
       messages_.Say(arg->name(),
-          "Dummy argument '%s' of a defined input/output procedure must be assumed shape"_err_en_US,
+          "Dummy argument '%s' of a defined input/output procedure must be assumed shape vector"_err_en_US,
           arg->name());
     }
   }
diff --git a/flang/test/Semantics/io11.f90 b/flang/test/Semantics/io11.f90
index 3529929003b01..c00deede6b516 100644
--- a/flang/test/Semantics/io11.f90
+++ b/flang/test/Semantics/io11.f90
@@ -342,7 +342,7 @@ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
   end subroutine
 end module m15
 
-module m16
+module m16a
   type,public :: t
     integer c
   contains
@@ -355,15 +355,58 @@ 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 assumed shape
+    !ERROR: Dummy argument 'vlist' of a defined input/output procedure must be assumed shape vector
     integer, intent(in) :: vlist(5)
     integer, intent(out) :: iostat
     character(len=*), intent(inout) :: iomsg
+    iostat = 343
+    stop 'fail'
+  end subroutine
+end module m16a
 
+module m16b
+  type,public :: t
+    integer c
+  contains
+    procedure, pass :: tbp=>formattedReadProc
+    generic :: read(formatted) => tbp
+  end type
+  private
+contains
+  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 assumed shape vector
+    integer, intent(in) :: vlist(:,:)
+    integer, intent(out) :: iostat
+    character(len=*), intent(inout) :: iomsg
+    iostat = 343
+    stop 'fail'
+  end subroutine
+end module m16b
+
+module m16c
+  type,public :: t
+    integer c
+  contains
+    procedure, pass :: tbp=>formattedReadProc
+    generic :: read(formatted) => tbp
+  end type
+  private
+contains
+  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' may not be assumed-rank
+    integer, intent(in) :: vlist(..)
+    integer, intent(out) :: iostat
+    character(len=*), intent(inout) :: iomsg
     iostat = 343
     stop 'fail'
   end subroutine
-end module m16
+end module m16c
 
 module m17
   ! Test the same defined input/output procedure specified as a generic

``````````

</details>


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