[flang] Fix issue: Enforce specific intrinsic characteristics

Fix issue flang-compiler/f18#661.
The issue was that when probing a specific intrinsic, the
constraints of the related generic intrinsic were tested instead
of the more restrictive constraints of the specific intrinsic.

Original-commit: flang-compiler/f18@dd971e9
Reviewed-on: flang-compiler/f18#680
Tree-same-pre-rewrite: false

flang/lib/evaluate/intrinsics.cc

@@ -1618,40 +1618,34 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
        ++specIter) {
     // We only need to check the cases with distinct generic names.
     if (const char *genericName{specIter->second->generic}) {
-      auto genericRange{genericFuncs_.equal_range(genericName)};
-      for (auto genIter{genericRange.first}; genIter != genericRange.second;
-           ++genIter) {
-        if (auto specificCall{genIter->second->Match(
-                call, defaults_, arguments, localContext)}) {
-          specificCall->specificIntrinsic.name = genericName;
-          specificCall->specificIntrinsic.isRestrictedSpecific =
-              specIter->second->isRestrictedSpecific;
-          if (finalBuffer != nullptr) {
-            finalBuffer->Annex(std::move(localBuffer));
-          }
-          if (specIter->second->forceResultType) {
-            // Force the result type on AMAX0/1, MIN0/1, &c.
-            TypeCategory category{TypeCategory::Integer};
-            switch (specIter->second->result.kindCode) {
-            case KindCode::defaultIntegerKind: break;
-            case KindCode::defaultRealKind:
-              category = TypeCategory::Real;
-              break;
-            default: CRASH_NO_CASE;
-            }
-            DynamicType newType{category, defaults_.GetDefaultKind(category)};
-            specificCall->specificIntrinsic.characteristics.value()
-                .functionResult.value()
-                .SetType(newType);
+      if (auto specificCall{specIter->second->Match(
+              call, defaults_, arguments, localContext)}) {
+        specificCall->specificIntrinsic.name = genericName;
+        specificCall->specificIntrinsic.isRestrictedSpecific =
+            specIter->second->isRestrictedSpecific;
+        if (finalBuffer != nullptr) {
+          finalBuffer->Annex(std::move(localBuffer));
+        }
+        if (specIter->second->forceResultType) {
+          // Force the result type on AMAX0/1, MIN0/1, &c.
+          TypeCategory category{TypeCategory::Integer};
+          switch (specIter->second->result.kindCode) {
+          case KindCode::defaultIntegerKind: break;
+          case KindCode::defaultRealKind: category = TypeCategory::Real; break;
+          default: CRASH_NO_CASE;
           }
-          // TODO test feature AdditionalIntrinsics, warn on nonstandard
-          // specifics with DoublePrecisionComplex arguments.
-          return specificCall;
-        } else if (specificBuffer.empty()) {
-          specificBuffer.Annex(std::move(localBuffer));
-        } else {
-          specificBuffer.clear();
+          DynamicType newType{category, defaults_.GetDefaultKind(category)};
+          specificCall->specificIntrinsic.characteristics.value()
+              .functionResult.value()
+              .SetType(newType);
         }
+        // TODO test feature AdditionalIntrinsics, warn on nonstandard
+        // specifics with DoublePrecisionComplex arguments.
+        return specificCall;
+      } else if (specificBuffer.empty()) {
+        specificBuffer.Annex(std::move(localBuffer));
+      } else {
+        specificBuffer.clear();
       }
     }
   }

flang/test/evaluate/intrinsics.cc

@@ -119,19 +119,21 @@ struct TestCall {
     if (resultType.has_value()) {
       TEST(si.has_value());
       TEST(buffer.empty());
-      const auto &proc{si->specificIntrinsic.characteristics.value()};
-      const auto &fr{proc.functionResult};
-      TEST(fr.has_value());
-      if (fr) {
-        const auto *ts{fr->GetTypeAndShape()};
-        TEST(ts != nullptr);
-        if (ts) {
-          TEST(*resultType == ts->type());
-          MATCH(rank, ts->Rank());
+      if (si) {
+        const auto &proc{si->specificIntrinsic.characteristics.value()};
+        const auto &fr{proc.functionResult};
+        TEST(fr.has_value());
+        if (fr) {
+          const auto *ts{fr->GetTypeAndShape()};
+          TEST(ts != nullptr);
+          if (ts) {
+            TEST(*resultType == ts->type());
+            MATCH(rank, ts->Rank());
+          }
         }
+        MATCH(isElemental,
+            proc.attrs.test(characteristics::Procedure::Attr::Elemental));
       }
-      MATCH(isElemental,
-          proc.attrs.test(characteristics::Procedure::Attr::Elemental));
     } else {
       TEST(!si.has_value());
       TEST(!buffer.empty() || name == "bad");
@@ -203,21 +205,26 @@ void TestIntrinsics() {
 
   TestCall maxCallR{table, "max"}, maxCallI{table, "min"},
       max0Call{table, "max0"}, max1Call{table, "max1"},
-      amin0Call{table, "amin0"}, amin1Call{table, "amin1"};
+      amin0Call{table, "amin0"}, amin1Call{table, "amin1"},
+      max0WrongCall{table, "max0"}, amin1WrongCall{table, "amin1"};
   for (int j{0}; j < 10; ++j) {
     maxCallR.Push(Const(Scalar<Real4>{}));
     maxCallI.Push(Const(Scalar<Int4>{}));
-    max0Call.Push(Const(Scalar<Real4>{}));
+    max0Call.Push(Const(Scalar<Int4>{}));
+    max0WrongCall.Push(Const(Scalar<Real4>{}));
     max1Call.Push(Const(Scalar<Real4>{}));
     amin0Call.Push(Const(Scalar<Int4>{}));
-    amin1Call.Push(Const(Scalar<Int4>{}));
+    amin1WrongCall.Push(Const(Scalar<Int4>{}));
+    amin1Call.Push(Const(Scalar<Real4>{}));
   }
   maxCallR.DoCall(Real4::GetType());
   maxCallI.DoCall(Int4::GetType());
   max0Call.DoCall(Int4::GetType());
+  max0WrongCall.DoCall();
   max1Call.DoCall(Int4::GetType());
   amin0Call.DoCall(Real4::GetType());
   amin1Call.DoCall(Real4::GetType());
+  amin1WrongCall.DoCall();
 
   // TODO: test other intrinsics
 }