[flang-commits] [flang] 51dc526 - [flang] Catch more defined I/O conflicts (#129115)

via flang-commits flang-commits at lists.llvm.org
Thu Feb 27 16:16:36 PST 2025


Author: Peter Klausler
Date: 2025-02-27T16:16:34-08:00
New Revision: 51dc52631c7b0f69f84ff558ce872f1e080d338a

URL: https://github.com/llvm/llvm-project/commit/51dc52631c7b0f69f84ff558ce872f1e080d338a
DIFF: https://github.com/llvm/llvm-project/commit/51dc52631c7b0f69f84ff558ce872f1e080d338a.diff

LOG: [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.

Added: 
    

Modified: 
    flang/lib/Semantics/check-declarations.cpp
    flang/test/Lower/io-derived-type.f90
    flang/test/Semantics/io11.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 914d891cd9aa9..c30c15a290b84 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -165,8 +165,8 @@ class CheckHelper {
   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:;
         }

diff  --git a/flang/test/Lower/io-derived-type.f90 b/flang/test/Lower/io-derived-type.f90
index 8ac995739afd7..f96feca77c485 100644
--- a/flang/test/Lower/io-derived-type.f90
+++ b/flang/test/Lower/io-derived-type.f90
@@ -22,7 +22,7 @@ subroutine wft(dtv, unit, iotype, v_list, iostat, iomsg)
 
   ! 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 @@ subroutine test3(p, x)
     ! 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

diff  --git a/flang/test/Semantics/io11.f90 b/flang/test/Semantics/io11.f90
index 5d3d90271c0a8..7565d35aeb407 100644
--- a/flang/test/Semantics/io11.f90
+++ b/flang/test/Semantics/io11.f90
@@ -720,3 +720,27 @@ subroutine ur2(dtv,unit,iostat,iomsg)
     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


        


More information about the flang-commits mailing list