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

[via flang-commits]

Author: Peter Klausler
Date: 2023-10-31T12:29:30-07:00
New Revision: 2d4ada215ebb3062947c399cf20d386aa78619a6

URL: https://github.com/llvm/llvm-project/commit/2d4ada215ebb3062947c399cf20d386aa78619a6
DIFF: https://github.com/llvm/llvm-project/commit/2d4ada215ebb3062947c399cf20d386aa78619a6.diff

LOG: [flang] Fix IsDescriptor() to fix SMP compatibility checking (#70676)

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.

Added: 
    

Modified: 
    flang/lib/Evaluate/type.cpp
    flang/test/Semantics/separate-mp02.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index 82b8f28f961dd51..72e385104cd6412 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 c39f18064796bb3..5d13b6b693c8f79 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 distinct 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