[flang] Extension: unrestricted intrinsics as specifics in generics

At least one other Fortran compiler supports the use of unrestricted intrinsic
functions as specific procedures in generic interfaces, and the usage seems
to be both useful and unambiguous.  Support it with a portability warning.

Fixes llvm-test-suite/Fortran/gfortran/regression/pr95500.f90.

Differential Revision: https://reviews.llvm.org/D157333

flang/docs/Extensions.md

@@ -295,6 +295,9 @@ end
   by a line continuation in free form, the second quotation mark
   may appear at the beginning of the continuation line without an
   ampersand, althought one is required by the standard.
+* Unrestricted `INTRINSIC` functions are accepted for use in
+  `PROCEDURE` statements in generic interfaces, as in some other
+  compilers.
 
 ### Extensions supported when enabled by options
 

flang/lib/Semantics/check-declarations.cpp

@@ -1726,12 +1726,25 @@ void CheckHelper::CheckSpecifics(
       continue;
     }
     if (specific.attrs().test(Attr::INTRINSIC)) {
-      if (auto *msg{messages_.Say(specific.name(),
-              "Specific procedure '%s' of generic interface '%s' may not be INTRINSIC"_err_en_US,
-              specific.name(), generic.name())}) {
-        msg->Attach(generic.name(), "Definition of '%s'"_en_US, generic.name());
+      // GNU Fortran allows INTRINSIC procedures in generics.
+      auto intrinsic{context_.intrinsics().IsSpecificIntrinsicFunction(
+          specific.name().ToString())};
+      if (intrinsic && !intrinsic->isRestrictedSpecific) {
+        if (auto *msg{messages_.Say(specific.name(),
+                "Specific procedure '%s' of generic interface '%s' should not be INTRINSIC"_port_en_US,
+                specific.name(), generic.name())}) {
+          msg->Attach(
+              generic.name(), "Definition of '%s'"_en_US, generic.name());
+        }
+      } else {
+        if (auto *msg{messages_.Say(specific.name(),
+                "Procedure '%s' of generic interface '%s' is INTRINSIC but not an unrestricted specific intrinsic function"_port_en_US,
+                specific.name(), generic.name())}) {
+          msg->Attach(
+              generic.name(), "Definition of '%s'"_en_US, generic.name());
+        }
+        continue;
       }
-      continue;
     }
     if (IsStmtFunction(specific)) {
       if (auto *msg{messages_.Say(specific.name(),

flang/lib/Semantics/expression.cpp

@@ -2608,10 +2608,10 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
     resolution = symbol;
   }
   if (!resolution || resolution->attrs().test(semantics::Attr::INTRINSIC)) {
-    // Not generic, or no resolution; may be intrinsic
+    auto name{resolution ? resolution->name() : ultimate.name()};
     if (std::optional<SpecificCall> specificCall{context_.intrinsics().Probe(
-            CallCharacteristics{ultimate.name().ToString(), isSubroutine},
-            arguments, GetFoldingContext())}) {
+            CallCharacteristics{name.ToString(), isSubroutine}, arguments,
+            GetFoldingContext())}) {
       CheckBadExplicitType(*specificCall, *symbol);
       return CalleeAndArguments{
           ProcedureDesignator{std::move(specificCall->specificIntrinsic)},

flang/lib/Semantics/resolve-names.cpp

@@ -4619,15 +4619,27 @@ bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) {
       Say(symbol.name(),
           "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
           symbol.name());
-    } else if (symbol.GetType()) {
-      // These warnings are worded so that they should make sense in either
-      // order.
-      Say(symbol.name(),
-          "Explicit type declaration ignored for intrinsic function '%s'"_warn_en_US,
-          symbol.name())
-          .Attach(name.source,
-              "INTRINSIC statement for explicitly-typed '%s'"_en_US,
-              name.source);
+    } else {
+      if (symbol.GetType()) {
+        // These warnings are worded so that they should make sense in either
+        // order.
+        Say(symbol.name(),
+            "Explicit type declaration ignored for intrinsic function '%s'"_warn_en_US,
+            symbol.name())
+            .Attach(name.source,
+                "INTRINSIC statement for explicitly-typed '%s'"_en_US,
+                name.source);
+      }
+      if (!symbol.test(Symbol::Flag::Function) &&
+          !symbol.test(Symbol::Flag::Subroutine)) {
+        if (context().intrinsics().IsIntrinsicFunction(
+                name.source.ToString())) {
+          symbol.set(Symbol::Flag::Function);
+        } else if (context().intrinsics().IsIntrinsicSubroutine(
+                       name.source.ToString())) {
+          symbol.set(Symbol::Flag::Subroutine);
+        }
+      }
     }
   }
   return false;

flang/test/Semantics/call16.f90

@@ -4,9 +4,9 @@
 
 subroutine test(x, t)
  intrinsic :: sin, cpu_time
- !ERROR: Cannot use intrinsic function 'sin' as a subroutine
+ !ERROR: Cannot call function 'sin' like a subroutine
  call sin(x)
- !ERROR: Cannot use intrinsic subroutine 'cpu_time' as a function
+ !ERROR: Cannot call subroutine 'cpu_time' like a function
  x = cpu_time(t)
 end subroutine
 

flang/test/Semantics/generic06.f90

@@ -1,11 +1,11 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1
 module m
-  !ERROR: Specific procedure 'sin' of generic interface 'yintercept' may not be INTRINSIC
+  !PORTABILITY: Specific procedure 'sin' of generic interface 'yintercept' should not be INTRINSIC
   intrinsic sin
   interface yIntercept
     procedure sin
   end interface
-  !ERROR: Specific procedure 'cos' of generic interface 'xintercept' may not be INTRINSIC
+  !PORTABILITY: Specific procedure 'cos' of generic interface 'xintercept' should not be INTRINSIC
   intrinsic cos
   generic :: xIntercept => cos
 end module