[flang-commits] [flang] [flang] Fix IsDescriptor() to fix SMP compatibility checking (PR #70676)

[Peter Klausler via flang-commits]

https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/70676

>From 0ad825289e4b1566ff0e164b93e6983c21ae680b Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Mon, 30 Oct 2023 08:59:44 -0700
Subject: [PATCH] [flang] Fix IsDescriptor() to fix SMP compatibility checking

Fix IsDescriptor() so that it doesn't return a false negative result
that messes up compatibility checking between a separate module
procedure's interface and its redundant definition (without
MODULE PROCEDURE).  Specifically, lower bounds just don't matter,
and any upper bound that's not explicit is dispositive.
---
 flang/lib/Evaluate/type.cpp            | 8 +-------
 flang/test/Semantics/separate-mp02.f90 | 6 ++++++
 2 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index dbadc07fdbbc59b..f3350d68104d7dd 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -40,18 +40,12 @@ static bool IsDescriptor(const ObjectEntityDetails &details) {
   std::size_t j{0};
   for (const ShapeSpec &shapeSpec : details.shape()) {
     ++j;
-    if (const auto &lb{shapeSpec.lbound().GetExplicit()};
-        !lb || !IsConstantExpr(*lb)) {
-      return true;
-    }
     if (const auto &ub{shapeSpec.ubound().GetExplicit()}) {
       if (!IsConstantExpr(*ub)) {
         return true;
       }
-    } else if (j == details.shape().size() && details.isDummy()) {
-      // assumed size array
     } else {
-      return true;
+      return shapeSpec.ubound().isColon();
     }
   }
   return false;
diff --git a/flang/test/Semantics/separate-mp02.f90 b/flang/test/Semantics/separate-mp02.f90
index fd9c4c3cc18f98b..a776e070f746415 100644
--- a/flang/test/Semantics/separate-mp02.f90
+++ b/flang/test/Semantics/separate-mp02.f90
@@ -35,6 +35,9 @@ module subroutine s9(x, y, z, w)
       character(len=*) :: z
       character(len=*) :: w
     end
+    module subroutine s10(x, y, z, w)
+      real x(0:), y(:), z(0:*), w(*)
+    end
   end interface
 end
 
@@ -78,6 +81,9 @@ module subroutine s9(x, y, z, w)
     !ERROR: Dummy argument 'w' has type CHARACTER(KIND=1,LEN=4_8); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=*)
     character(len=4) :: w
   end
+  module subroutine s10(x, y, z, w)
+    real x(:), y(0:), z(*), w(0:*) ! all ok, lower bounds don't matter
+  end
 end
 
 module m2