[flang] Catch disallowed usage of coarrays in defined I/O

[klausler]

Defined input/output subroutines must conform to documented interfaces that do not allow for coarray dummy arguments.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

Defined input/output subroutines must conform to documented interfaces that do not allow for coarray dummy arguments.

---

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

2 Files Affected:

• (modified) flang/lib/Semantics/check-declarations.cpp (+8-1)
• (modified) flang/test/Semantics/io11.f90 (+28-6)

diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 25e9262e46a75..e5a01657e4a15 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -3486,7 +3486,7 @@ void CheckHelper::CheckDioDummyIsDefaultInteger(
 }
 
 void CheckHelper::CheckDioDummyIsScalar(const Symbol &subp, const Symbol &arg) {
-  if (arg.Rank() > 0 || arg.Corank() > 0) {
+  if (arg.Rank() > 0) {
     messages_.Say(arg.name(),
         "Dummy argument '%s' of a defined input/output procedure must be a scalar"_err_en_US,
         arg.name());
@@ -3643,6 +3643,13 @@ void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
       CheckDioArgCount(*specificSubp, ioKind, dummyArgs.size());
       int argCount{0};
       for (auto *arg : dummyArgs) {
+        if (arg && arg->Corank() > 0) {
+          evaluate::AttachDeclaration(
+              messages_.Say(arg->name(),
+                  "Dummy argument '%s' of defined input/output procedure '%s' may not be a coarray"_err_en_US,
+                  arg->name(), ultimate.name()),
+              *arg);
+        }
         switch (argCount++) {
         case 0:
           // dtv-type-spec, INTENT(INOUT) :: dtv
diff --git a/flang/test/Semantics/io11.f90 b/flang/test/Semantics/io11.f90
index 7565d35aeb407..3529929003b01 100644
--- a/flang/test/Semantics/io11.f90
+++ b/flang/test/Semantics/io11.f90
@@ -57,7 +57,7 @@ module m3
   private
 contains
   ! Error bad # of args
-  subroutine unformattedReadProc(dtv, unit, iostat, iomsg, iotype) 
+  subroutine unformattedReadProc(dtv, unit, iostat, iomsg, iotype)
     class(t), intent(inout) :: dtv
     integer, intent(in) :: unit
     integer, intent(out) :: iostat
@@ -119,7 +119,7 @@ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
 end module m5
 
 module m6
-  interface read(formatted) 
+  interface read(formatted)
     procedure :: formattedReadProc
   end interface
 
@@ -169,7 +169,7 @@ module m8
 contains
   subroutine formattedWriteProc(dtv, unit, iotype, vlist, iostat, iomsg)
     !ERROR: Dummy argument 'dtv' of a defined input/output procedure must have intent 'INTENT(IN)'
-    class(t), intent(inout) :: dtv ! Error, must be intent(inout)
+    class(t), intent(inout) :: dtv ! Error, must be intent(in)
     integer, intent(in) :: unit
     character(len=*), intent(in) :: iotype
     integer, intent(in) :: vlist(:)
@@ -195,7 +195,7 @@ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
     !ERROR: Dummy argument 'unit' of a defined input/output procedure may not have any attributes
     integer,  pointer, intent(in) :: unit
     character(len=*), intent(in) :: iotype
-    integer, intent(in) :: vlist(:) 
+    integer, intent(in) :: vlist(:)
     integer, intent(out) :: iostat
     character(len=*), intent(inout) :: iomsg
 
@@ -416,7 +416,7 @@ subroutine formattedReadProc(dtv,unit,iotype,v_list,iostat,iomsg)
 end module
 
 module m19
-  ! Test two different defined input/output procedures specified as a 
+  ! Test two different defined input/output procedures specified as a
   ! type-bound procedure and as a generic for the same derived type
   type t
     integer c
@@ -446,7 +446,7 @@ subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
 end module
 
 module m20
-  ! Test read and write defined input/output procedures specified as a 
+  ! Test read and write defined input/output procedures specified as a
   ! type-bound procedure and as a generic for the same derived type
   type t
     integer c
@@ -744,3 +744,25 @@ subroutine absWrite(dtv, unit, iotype, v_list, iostat, iomsg)
     procedure write2
   end interface
 end
+
+module m29
+  type t
+  end type
+  interface write(formatted)
+    subroutine wf(dtv, unit, iotype, v_list, iostat, iomsg)
+    import t
+    !ERROR: Dummy argument 'dtv' of defined input/output procedure 'wf' may not be a coarray
+    class(t), intent(in) :: dtv[*]
+    !ERROR: Dummy argument 'unit' of defined input/output procedure 'wf' may not be a coarray
+    integer, intent(in) :: unit[*]
+    !ERROR: Dummy argument 'iotype' of defined input/output procedure 'wf' may not be a coarray
+    character(len=*), intent(in) :: iotype[*]
+    !ERROR: Dummy argument 'v_list' of defined input/output procedure 'wf' may not be a coarray
+    integer, intent(in) :: v_list(:)[*]
+    !ERROR: Dummy argument 'iostat' of defined input/output procedure 'wf' may not be a coarray
+    integer, intent(out) :: iostat[*]
+    !ERROR: Dummy argument 'iomsg' of defined input/output procedure 'wf' may not be a coarray
+    character(len=*), intent(inout) :: iomsg[*]
+    end
+  end interface
+end