[flang-commits] [PATCH] D120750: [flang] Check constraint C711 correctly

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: PeteSteinfeld.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
klausler requested review of this revision.

An assumed-type actual argument that corresponds to an assumed-rank dummy
argument shall be assumed-shape or assumed-rank.


https://reviews.llvm.org/D120750

Files:
  flang/lib/Evaluate/shape.cpp
  flang/lib/Semantics/check-call.cpp
  flang/test/Semantics/call15.f90


Index: flang/test/Semantics/call15.f90
===================================================================
--- flang/test/Semantics/call15.f90
+++ flang/test/Semantics/call15.f90
@@ -1,5 +1,5 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1
-! C711 An assumed-type actual argument that corresponds to an assumed-rank 
+! C711 An assumed-type actual argument that corresponds to an assumed-rank
 ! dummy argument shall be assumed-shape or assumed-rank.
 subroutine s(arg1, arg2, arg3)
   type(*), dimension(..) :: arg1 ! assumed rank
@@ -8,7 +8,7 @@
 
   call inner(arg1) ! OK, assumed rank
   call inner(arg2) ! OK, assumed shape
-  !ERROR: Assumed-type 'arg3' must be either assumed shape or assumed rank to be associated with assumed-type dummy argument 'dummy='
+  !ERROR: Assumed-type 'arg3' must be either assumed shape or assumed rank to be associated with assumed rank dummy argument 'dummy='
   call inner(arg3)
 
     contains
Index: flang/lib/Semantics/check-call.cpp
===================================================================
--- flang/lib/Semantics/check-call.cpp
+++ flang/lib/Semantics/check-call.cpp
@@ -699,14 +699,13 @@
                 messages.Say(
                     "Assumed-type '%s' may be associated only with an assumed-type %s"_err_en_US,
                     assumed.name(), dummyName);
-              } else {
-                const auto *details{assumed.detailsIf<ObjectEntityDetails>()};
-                if (!(IsAssumedShape(assumed) ||
-                        (details && details->IsAssumedRank()))) {
-                  messages.Say( // C711
-                      "Assumed-type '%s' must be either assumed shape or assumed rank to be associated with assumed-type %s"_err_en_US,
-                      assumed.name(), dummyName);
-                }
+              } else if (object.type.attrs().test(evaluate::characteristics::
+                                 TypeAndShape::Attr::AssumedRank) &&
+                  !IsAssumedShape(assumed) &&
+                  !evaluate::IsAssumedRank(assumed)) {
+                messages.Say( // C711
+                    "Assumed-type '%s' must be either assumed shape or assumed rank to be associated with assumed rank %s"_err_en_US,
+                    assumed.name(), dummyName);
               }
             }
           },
Index: flang/lib/Evaluate/shape.cpp
===================================================================
--- flang/lib/Evaluate/shape.cpp
+++ flang/lib/Evaluate/shape.cpp
@@ -654,10 +654,11 @@
   } else if (const auto *intrinsic{call.proc().GetSpecificIntrinsic()}) {
     if (intrinsic->name == "shape" || intrinsic->name == "lbound" ||
         intrinsic->name == "ubound") {
-      // These are the array-valued cases for LBOUND and UBOUND (no DIM=).
-      const auto *expr{call.arguments().front().value().UnwrapExpr()};
-      CHECK(expr);
-      return Shape{MaybeExtentExpr{ExtentExpr{expr->Rank()}}};
+      // For LBOUND/UBOUND, these are the array-valued cases (no DIM=)
+      if (!call.arguments().empty() && call.arguments().front()) {
+        return Shape{
+            MaybeExtentExpr{ExtentExpr{call.arguments().front()->Rank()}}};
+      }
     } else if (intrinsic->name == "all" || intrinsic->name == "any" ||
         intrinsic->name == "count" || intrinsic->name == "iall" ||
         intrinsic->name == "iany" || intrinsic->name == "iparity" ||


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D120750.412151.patch
Type: text/x-patch
Size: 3385 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20220301/8f13a97b/attachment.bin>