[flang] Catch more defined I/O conflicts (#129115)

The code that checks for conflicts between type-bound defined I/O generic procedures and non-type-bound defined I/O interfaces only works when then procedures are defined in the same module as subroutines. It doesn't catch conflicts when either are external procedures, procedure pointers, dummy procedures, &c. Extend the checking to cover those cases as well. Fixes https://github.com/llvm/llvm-project/issues/128752.
2026-01-24 08:30:34 +08:00 · 2025-02-27 16:16:34 -08:00
parent abe1ecff54
commit 51dc52631c
3 changed files with 61 additions and 24 deletions
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -165,8 +165,8 @@ private:
  void CheckDioDummyIsDefaultInteger(const Symbol &, const Symbol &);
  void CheckDioDummyIsScalar(const Symbol &, const Symbol &);
  void CheckDioDummyAttrs(const Symbol &, const Symbol &, Attr);
-  void CheckDioDtvArg(
-      const Symbol &, const Symbol *, common::DefinedIo, const Symbol &);
+  void CheckDioDtvArg(const Symbol &proc, const Symbol &subp, const Symbol *arg,
+      common::DefinedIo, const Symbol &generic);
  void CheckGenericVsIntrinsic(const Symbol &, const GenericDetails &);
  void CheckDefaultIntegerArg(const Symbol &, const Symbol *, Attr);
  void CheckDioAssumedLenCharacterArg(
@@ -3428,11 +3428,17 @@ void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType,
    if (auto iter{dtScope->find(generic.name())}; iter != dtScope->end() &&
        IsAccessible(*iter->second, generic.owner())) {
      for (auto specRef : iter->second->get<GenericDetails>().specificProcs()) {
-        const Symbol &specific{specRef->get<ProcBindingDetails>().symbol()};
-        if (specific == proc) {
+        const Symbol *specific{&specRef->get<ProcBindingDetails>().symbol()};
+        if (specific == &proc) {
          continue; // unambiguous, accept
        }
-        if (const auto *specDT{GetDtvArgDerivedType(specific)};
+        if (const auto *peDetails{specific->detailsIf<ProcEntityDetails>()}) {
+          specific = peDetails->procInterface();
+          if (!specific) {
+            continue;
+          }
+        }
+        if (const auto *specDT{GetDtvArgDerivedType(*specific)};
            specDT && evaluate::AreSameDerivedType(derivedType, *specDT)) {
          SayWithDeclaration(*specRef, proc.name(),
              "Derived type '%s' has conflicting type-bound input/output procedure '%s'"_err_en_US,
@@ -3444,11 +3450,11 @@ void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType,
  }
 }

-void CheckHelper::CheckDioDummyIsDerived(const Symbol &subp, const Symbol &arg,
+void CheckHelper::CheckDioDummyIsDerived(const Symbol &proc, const Symbol &arg,
    common::DefinedIo ioKind, const Symbol &generic) {
  if (const DeclTypeSpec *type{arg.GetType()}) {
    if (const DerivedTypeSpec *derivedType{type->AsDerived()}) {
-      CheckAlreadySeenDefinedIo(*derivedType, ioKind, subp, generic);
+      CheckAlreadySeenDefinedIo(*derivedType, ioKind, proc, generic);
      bool isPolymorphic{type->IsPolymorphic()};
      if (isPolymorphic != IsExtensibleType(derivedType)) {
        messages_.Say(arg.name(),
@@ -3486,11 +3492,11 @@ void CheckHelper::CheckDioDummyIsScalar(const Symbol &subp, const Symbol &arg) {
  }
 }

-void CheckHelper::CheckDioDtvArg(const Symbol &subp, const Symbol *arg,
-    common::DefinedIo ioKind, const Symbol &generic) {
+void CheckHelper::CheckDioDtvArg(const Symbol &proc, const Symbol &subp,
+    const Symbol *arg, common::DefinedIo ioKind, const Symbol &generic) {
  // Dtv argument looks like: dtv-type-spec, INTENT(INOUT) :: dtv
  if (CheckDioDummyIsData(subp, arg, 0)) {
-    CheckDioDummyIsDerived(subp, *arg, ioKind, generic);
+    CheckDioDummyIsDerived(proc, *arg, ioKind, generic);
    CheckDioDummyAttrs(subp, *arg,
        ioKind == common::DefinedIo::ReadFormatted ||
                ioKind == common::DefinedIo::ReadUnformatted
@@ -3617,57 +3623,64 @@ void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
  for (auto ref : details.specificProcs()) {
    const Symbol &ultimate{ref->GetUltimate()};
    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,
          ultimate.name());
      context_.SetError(ultimate);
    }
-    if (const auto *subpDetails{specific.detailsIf<SubprogramDetails>()}) {
+    const Symbol *specificProc{binding ? &binding->symbol() : &ultimate};
+    const Symbol *specificSubp{specificProc};
+    if (const auto *peDetails{specificSubp->detailsIf<ProcEntityDetails>()}) {
+      specificSubp = peDetails->procInterface();
+      if (!specificSubp) {
+        continue;
+      }
+    }
+    if (const auto *subpDetails{specificSubp->detailsIf<SubprogramDetails>()}) {
      const std::vector<Symbol *> &dummyArgs{subpDetails->dummyArgs()};
-      CheckDioArgCount(specific, ioKind, dummyArgs.size());
+      CheckDioArgCount(*specificSubp, ioKind, dummyArgs.size());
      int argCount{0};
      for (auto *arg : dummyArgs) {
        switch (argCount++) {
        case 0:
          // dtv-type-spec, INTENT(INOUT) :: dtv
-          CheckDioDtvArg(specific, arg, ioKind, symbol);
+          CheckDioDtvArg(*specificProc, *specificSubp, arg, ioKind, symbol);
          break;
        case 1:
          // INTEGER, INTENT(IN) :: unit
-          CheckDefaultIntegerArg(specific, arg, Attr::INTENT_IN);
+          CheckDefaultIntegerArg(*specificSubp, arg, Attr::INTENT_IN);
          break;
        case 2:
          if (ioKind == common::DefinedIo::ReadFormatted ||
              ioKind == common::DefinedIo::WriteFormatted) {
            // CHARACTER (LEN=*), INTENT(IN) :: iotype
            CheckDioAssumedLenCharacterArg(
-                specific, arg, argCount, Attr::INTENT_IN);
+                *specificSubp, arg, argCount, Attr::INTENT_IN);
          } else {
            // INTEGER, INTENT(OUT) :: iostat
-            CheckDefaultIntegerArg(specific, arg, Attr::INTENT_OUT);
+            CheckDefaultIntegerArg(*specificSubp, arg, Attr::INTENT_OUT);
          }
          break;
        case 3:
          if (ioKind == common::DefinedIo::ReadFormatted ||
              ioKind == common::DefinedIo::WriteFormatted) {
            // INTEGER, INTENT(IN) :: v_list(:)
-            CheckDioVlistArg(specific, arg, argCount);
+            CheckDioVlistArg(*specificSubp, arg, argCount);
          } else {
            // CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
            CheckDioAssumedLenCharacterArg(
-                specific, arg, argCount, Attr::INTENT_INOUT);
+                *specificSubp, arg, argCount, Attr::INTENT_INOUT);
          }
          break;
        case 4:
          // INTEGER, INTENT(OUT) :: iostat
-          CheckDefaultIntegerArg(specific, arg, Attr::INTENT_OUT);
+          CheckDefaultIntegerArg(*specificSubp, arg, Attr::INTENT_OUT);
          break;
        case 5:
          // CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
          CheckDioAssumedLenCharacterArg(
-              specific, arg, argCount, Attr::INTENT_INOUT);
+              *specificSubp, arg, argCount, Attr::INTENT_INOUT);
          break;
        default:;
        }
--- a/flang/test/Lower/io-derived-type.f90
+++ b/flang/test/Lower/io-derived-type.f90
@@ -22,7 +22,7 @@ module m

  ! CHECK-LABEL: @_QMmPwftd
  subroutine wftd(dtv, unit, iotype, v_list, iostat, iomsg)
-    type(t), intent(in) :: dtv
+    class(t), intent(in) :: dtv
    integer, intent(in) :: unit
    character(*), intent(in) :: iotype
    integer, intent(in) :: v_list(:)
@@ -91,13 +91,13 @@ module m
    ! CHECK:     %[[V_10:[0-9]+]] = fir.box_addr %arg0 : (!fir.boxproc<() -> ()>) -> !fir.ref<none>
    ! CHECK:     %[[V_11:[0-9]+]] = fir.insert_value %[[V_9]], %[[V_10]], [0 : index, 1 : index] : (!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>, !fir.ref<none>) -> !fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>
    ! CHECK:     %[[V_12:[0-9]+]] = fir.insert_value %[[V_11]], %c2{{.*}}, [0 : index, 2 : index] : (!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>, i32) -> !fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>
-    ! CHECK:     %[[V_13:[0-9]+]] = fir.insert_value %[[V_12]], %false, [0 : index, 3 : index] : (!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>, i1) -> !fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>
+    ! CHECK:     %[[V_13:[0-9]+]] = fir.insert_value %[[V_12]], %true, [0 : index, 3 : index] : (!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>, i1) -> !fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>
    ! CHECK:     fir.store %[[V_13]] to %[[V_5]] : !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>
    ! CHECK:     %[[V_14:[0-9]+]] = fir.alloca tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>
    ! CHECK:     %[[V_15:[0-9]+]] = fir.undefined tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>
    ! CHECK:     %[[V_16:[0-9]+]] = fir.insert_value %[[V_15]], %c1{{.*}}, [0 : index] : (tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>, i64) -> tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>
    ! CHECK:     %[[V_17:[0-9]+]] = fir.insert_value %[[V_16]], %[[V_5]], [1 : index] : (tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>) -> tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>
-    ! CHECK:     %[[V_18:[0-9]+]] = fir.insert_value %[[V_17]], %true, [2 : index] : (tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>, i1) -> tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>
+    ! CHECK:     %[[V_18:[0-9]+]] = fir.insert_value %[[V_17]], %true_0, [2 : index] : (tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>, i1) -> tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>
    ! CHECK:     fir.store %[[V_18]] to %[[V_14]] : !fir.ref<tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>>
    ! CHECK:     %[[V_19:[0-9]+]] = fir.convert %[[V_14]] : (!fir.ref<tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>>) -> !fir.ref<none>
    ! CHECK:     %[[V_20:[0-9]+]] = fir.call @_FortranAioOutputDerivedType(%{{.*}}, %[[V_4]], %[[V_19]]) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>, !fir.ref<none>) -> i1
--- a/flang/test/Semantics/io11.f90
+++ b/flang/test/Semantics/io11.f90
@@ -720,3 +720,27 @@ module m27b
    read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
  end
 end
+
+module m28
+  type t
+   contains
+    procedure, private :: write1
+    generic :: write(formatted) => write1
+  end type
+  abstract interface
+    subroutine absWrite(dtv, unit, iotype, v_list, iostat, iomsg)
+      import t
+      class(t), intent(in) :: dtv
+      integer, intent(in) :: unit
+      character(*), intent(in) :: iotype
+      integer, intent(in)  :: v_list(:)
+      integer, intent(out) :: iostat
+      character(*), intent(inout) :: iomsg
+    end
+  end interface
+  !ERROR: Derived type 't' has conflicting type-bound input/output procedure 'write(formatted)'
+  procedure(absWrite) write1, write2
+  interface write(formatted)
+    procedure write2
+  end interface
+end