[flang-commits] [flang] d34f5dd - [flang] Accept ALLOCATED(ARRAY=assumedRank) (#66233)

[via flang-commits]

Author: Peter Klausler
Date: 2023-09-13T15:55:40-07:00
New Revision: d34f5dd07a2197ec91ecc33307eed6435ceda73f

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

LOG: [flang] Accept ALLOCATED(ARRAY=assumedRank) (#66233)

The definitions of the ALLOCATED intrinsic in the intrinsics table did
not allow for an assumed-rank array.

Added: 
    

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

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 030e5b2fd2c6d9d..7213482d9d798f3 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -315,10 +315,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
     {"aint", {{"a", SameReal}, MatchingDefaultKIND}, KINDReal},
     {"all", {{"mask", SameLogical, Rank::array}, OptionalDIM}, SameLogical,
         Rank::dimReduced, IntrinsicClass::transformationalFunction},
-    {"allocated", {{"array", AnyData, Rank::array}}, DefaultLogical,
-        Rank::elemental, IntrinsicClass::inquiryFunction},
     {"allocated", {{"scalar", AnyData, Rank::scalar}}, DefaultLogical,
         Rank::elemental, IntrinsicClass::inquiryFunction},
+    {"allocated", {{"array", AnyData, Rank::anyOrAssumedRank}}, DefaultLogical,
+        Rank::elemental, IntrinsicClass::inquiryFunction},
     {"anint", {{"a", SameReal}, MatchingDefaultKIND}, KINDReal},
     {"any", {{"mask", SameLogical, Rank::array}, OptionalDIM}, SameLogical,
         Rank::dimReduced, IntrinsicClass::transformationalFunction},

diff  --git a/flang/test/Semantics/allocated.f90 b/flang/test/Semantics/allocated.f90
index 82ce7ca7bdb9f80..a2eddaf82784aee 100644
--- a/flang/test/Semantics/allocated.f90
+++ b/flang/test/Semantics/allocated.f90
@@ -1,6 +1,7 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Tests for the ALLOCATED() intrinsic
-subroutine alloc(coarray_alloc, coarray_not_alloc, t2_not_alloc)
+subroutine alloc(coarray_alloc, coarray_not_alloc, t2_not_alloc, &
+                 assumedRank)
 
   interface
     function return_allocatable()
@@ -30,6 +31,7 @@ function return_allocatable()
   real :: coarray_not_alloc(:)[*]
 
   type(t2) :: t2_not_alloc
+  real, allocatable :: assumedRank(..)
 
 
   ! OK
@@ -42,6 +44,13 @@ function return_allocatable()
   print *, allocated(coarray_alloc[2,3])
   print *, allocated(t2_not_alloc%coarray_alloc)
   print *, allocated(t2_not_alloc%coarray_alloc[2])
+  print *, allocated(assumedRank)
+  select rank (assumedRank)
+  rank (0)
+    print *, allocated(scalar=assumedRank)
+  rank default
+    print *, allocated(array=assumedRank)
+  end select
 
   !ERROR: Argument of ALLOCATED() must be an ALLOCATABLE object or component
   print *, allocated(not_alloc)