[flang] Allow assumed-shape element pass to dummy arg with ignore_tkr (#78196)

This is allowed by gfortran and ifort with `![GCC|DEC]$ ATTRIBUTES
NO_ARG_CHECK`

Author: tblah

flang/docs/Directives.md

@@ -18,9 +18,10 @@ A list of non-standard directives supported by Flang
   The directive allow actual arguments that would otherwise be diagnosed
   as incompatible in type (T), kind (K), rank (R), CUDA device (D), or
   managed (M) status.  The letter (A) is a shorthand for all of these,
-  and is the default when no letters appear.  The letter (C) is a legacy
-  no-op.  For example, if one wanted to call a "set all bytes to zero"
-  utility that could be applied to arrays of any type or rank:
+  and is the default when no letters appear.  The letter (C) checks for
+  contiguity for example allowing an element of an assumed-shape array to be
+  passed as a dummy argument. For example, if one wanted to call a "set all
+  bytes to zero" utility that could be applied to arrays of any type or rank:
 ```
   interface
     subroutine clear(arr,bytes)

flang/include/flang/Common/Fortran.h

@@ -105,8 +105,8 @@ ENUM_CLASS(IgnoreTKR,
     Rank, // R - don't check ranks
     Device, // D - don't check host/device residence
     Managed, // M - don't check managed storage
-    Contiguous) // C - legacy; disabled NVFORTRAN's convention that leading
-                // dimension of assumed-shape was contiguous
+    Contiguous) // C - don't check for storage sequence association with a
+                // potentially non-contiguous object
 using IgnoreTKRSet = EnumSet<IgnoreTKR, 8>;
 // IGNORE_TKR(A) = IGNORE_TKR(TKRDM)
 static constexpr IgnoreTKRSet ignoreTKRAll{IgnoreTKR::Type, IgnoreTKR::Kind,

flang/lib/Semantics/check-call.cpp

@@ -529,13 +529,15 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
               dummyName);
         }
         if (actualIsArrayElement && actualLastSymbol &&
-            !evaluate::IsContiguous(*actualLastSymbol, foldingContext)) {
+            !evaluate::IsContiguous(*actualLastSymbol, foldingContext) &&
+            !dummy.ignoreTKR.test(common::IgnoreTKR::Contiguous)) {
           if (IsPointer(*actualLastSymbol)) {
             basicError = true;
             messages.Say(
                 "Element of pointer array may not be associated with a %s array"_err_en_US,
                 dummyName);
-          } else if (IsAssumedShape(*actualLastSymbol)) {
+          } else if (IsAssumedShape(*actualLastSymbol) &&
+              !dummy.ignoreTKR.test(common::IgnoreTKR::Contiguous)) {
             basicError = true;
             messages.Say(
                 "Element of assumed-shape array may not be associated with a %s array"_err_en_US,

flang/lib/Semantics/check-declarations.cpp

@@ -746,11 +746,6 @@ void CheckHelper::CheckObjectEntity(
         messages_.Say(
             "!DIR$ IGNORE_TKR may apply only in an interface or a module procedure"_err_en_US);
       }
-      if (ignoreTKR.test(common::IgnoreTKR::Contiguous) &&
-          !IsAssumedShape(symbol)) {
-        messages_.Say(
-            "!DIR$ IGNORE_TKR(C) may apply only to an assumed-shape array"_err_en_US);
-      }
       if (ownerSymbol && ownerSymbol->attrs().test(Attr::ELEMENTAL) &&
           details.ignoreTKR().test(common::IgnoreTKR::Rank)) {
         messages_.Say(

flang/test/Semantics/ignore_tkr01.f90

@@ -138,12 +138,6 @@ subroutine t20(x)
     end block
   end
 
-  subroutine t21(x)
-!dir$ ignore_tkr(c) x
-!ERROR: !DIR$ IGNORE_TKR(C) may apply only to an assumed-shape array
-    real x(1)
-  end
-
   subroutine t22(x)
 !dir$ ignore_tkr(r) x
 !WARNING: !DIR$ IGNORE_TKR(R) is not meaningful for an assumed-rank array

flang/test/Semantics/ignore_tkr03.f90

@@ -0,0 +1,21 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+module library
+contains
+  subroutine lib_sub(buf)
+!dir$ ignore_tkr(c) buf
+    real :: buf(1:*)
+  end subroutine
+end module
+
+module user
+  use library
+contains
+  subroutine sub(var, ptr)
+    real :: var(:,:,:)
+    real, pointer :: ptr(:)
+! CHECK: CALL lib_sub
+    call lib_sub(var(1, 2, 3))
+! CHECK: CALL lib_sub
+    call lib_sub(ptr(1))
+  end subroutine
+end module