[flang] Support INDEX as a procedure interface (#83073)

The specific intrinsic function INDEX should work as a PROCEDURE
interface in the declaration of a procedure pointer or dummy procedure,
and it should be compatible with a user-defined interface.

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

1 files changed, 12 insertions, 0 deletions

diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 61bf0f2..a8f2e5b 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1120,6 +1120,12 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
     {{"iiabs", {{"a", TypePattern{IntType, KindCode::exactKind, 2}}},
          TypePattern{IntType, KindCode::exactKind, 2}},
         "abs"},
+    // The definition of the unrestricted specific intrinsic function INDEX
+    // in F'77 and F'90 has only two arguments; later standards omit the
+    // argument information for all unrestricted specific intrinsic
+    // procedures.  No compiler supports an implementation that allows
+    // INDEX with BACK= to work when associated as an actual procedure or
+    // procedure pointer target.
     {{"index", {{"string", DefaultChar}, {"substring", DefaultChar}},
         DefaultInt}},
     {{"isign", {{"a", DefaultInt}, {"b", DefaultInt}}, DefaultInt}, "sign"},
@@ -2505,6 +2511,8 @@ private:
   std::multimap<std::string, const IntrinsicInterface *> subroutines_;
   const semantics::Scope *builtinsScope_{nullptr};
   std::map<std::string, std::string> aliases_;
+  semantics::ParamValue assumedLen_{
+      semantics::ParamValue::Assumed(common::TypeParamAttr::Len)};
 };
 
 bool IntrinsicProcTable::Implementation::IsIntrinsicFunction(
@@ -3241,6 +3249,10 @@ DynamicType IntrinsicProcTable::Implementation::GetSpecificType(
   TypeCategory category{set.LeastElement().value()};
   if (pattern.kindCode == KindCode::doublePrecision) {
     return DynamicType{category, defaults_.doublePrecisionKind()};
+  } else if (category == TypeCategory::Character) {
+    // All character arguments to specific intrinsic functions are
+    // assumed-length.
+    return DynamicType{defaults_.GetDefaultKind(category), assumedLen_};
   } else {
     return DynamicType{category, defaults_.GetDefaultKind(category)};
   }