[flang-commits] [flang] 39b0433 - [flang] Extend assumed-size array checking in intrinsic functions (#139339)

[via flang-commits]

Author: Peter Klausler
Date: 2025-05-12T12:28:50-07:00
New Revision: 39b04335ef3021399f8c0dc43837a45537b62e54

URL: https://github.com/llvm/llvm-project/commit/39b04335ef3021399f8c0dc43837a45537b62e54
DIFF: https://github.com/llvm/llvm-project/commit/39b04335ef3021399f8c0dc43837a45537b62e54.diff

LOG: [flang] Extend assumed-size array checking in intrinsic functions (#139339)

The array argument of a reference to the intrinsic functions SHAPE can't
be assumed-size; and for SIZE and UBOUND, it can be assumed-size only if
DIM= is present. The checks for thes restrictions don't allow for host
association, or for associate entities (ASSOCIATE, SELECT TYPE) that are
variables.

Fixes https://github.com/llvm/llvm-project/issues/138926.

Added: 
    

Modified: 
    flang/lib/Evaluate/intrinsics.cpp
    flang/test/Semantics/misc-intrinsics.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index d64a008e3db84..e802915945e26 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2340,7 +2340,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
         if (!knownArg) {
           knownArg = arg;
         }
-        if (!dimArg && rank > 0 &&
+        if (rank > 0 &&
             (std::strcmp(name, "shape") == 0 ||
                 std::strcmp(name, "size") == 0 ||
                 std::strcmp(name, "ubound") == 0)) {
@@ -2351,16 +2351,18 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
           // over this one, as this error is caught by the second entry
           // for UBOUND.)
           if (auto named{ExtractNamedEntity(*arg)}) {
-            if (semantics::IsAssumedSizeArray(named->GetLastSymbol())) {
+            if (semantics::IsAssumedSizeArray(ResolveAssociations(
+                    named->GetLastSymbol().GetUltimate()))) {
               if (strcmp(name, "shape") == 0) {
                 messages.Say(arg->sourceLocation(),
                     "The 'source=' argument to the intrinsic function 'shape' may not be assumed-size"_err_en_US);
-              } else {
+                return std::nullopt;
+              } else if (!dimArg) {
                 messages.Say(arg->sourceLocation(),
                     "A dim= argument is required for '%s' when the array is assumed-size"_err_en_US,
                     name);
+                return std::nullopt;
               }
-              return std::nullopt;
             }
           }
         }

diff  --git a/flang/test/Semantics/misc-intrinsics.f90 b/flang/test/Semantics/misc-intrinsics.f90
index 14dcdb05ac6c6..a7895f7b7f16f 100644
--- a/flang/test/Semantics/misc-intrinsics.f90
+++ b/flang/test/Semantics/misc-intrinsics.f90
@@ -3,17 +3,37 @@
 program test_size
   real :: scalar
   real, dimension(5, 5) :: array
-  call test(array, array)
+  call test(array, array, array)
  contains
-  subroutine test(arg, assumedRank)
+  subroutine test(arg, assumedRank, poly)
     real, dimension(5, *) :: arg
     real, dimension(..) :: assumedRank
+    class(*) :: poly(5, *)
     !ERROR: A dim= argument is required for 'size' when the array is assumed-size
     print *, size(arg)
+    print *, size(arg, dim=1) ! ok
+    select type (poly)
+     type is (real)
+      !ERROR: A dim= argument is required for 'size' when the array is assumed-size
+      print *, size(poly)
+      print *, size(poly, dim=1) ! ok
+    end select
     !ERROR: A dim= argument is required for 'ubound' when the array is assumed-size
     print *, ubound(arg)
+    print *, ubound(arg, dim=1) ! ok
+    select type (poly)
+     type is (real)
+      !ERROR: A dim= argument is required for 'ubound' when the array is assumed-size
+      print *, ubound(poly)
+      print *, ubound(poly, dim=1) ! ok
+    end select
     !ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size
     print *, shape(arg)
+    select type (poly)
+     type is (real)
+      !ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size
+      print *, shape(poly)
+    end select
     !ERROR: The 'harvest=' argument to the intrinsic procedure 'random_number' may not be assumed-size
     call random_number(arg)
     !ERROR: 'array=' argument has unacceptable rank 0
@@ -85,5 +105,16 @@ subroutine test(arg, assumedRank)
       print *, lbound(assumedRank, dim=2)
       print *, ubound(assumedRank, dim=2)
     end select
+   contains
+    subroutine inner
+      !ERROR: A dim= argument is required for 'size' when the array is assumed-size
+      print *, size(arg)
+      print *, size(arg, dim=1) ! ok
+      !ERROR: A dim= argument is required for 'ubound' when the array is assumed-size
+      print *, ubound(arg)
+      print *, ubound(arg, dim=1) ! ok
+      !ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size
+      print *, shape(arg)
+    end
   end subroutine
 end