[flang] Silence errors on C_LOC/C_FUNLOC in specification expressions

Transformational functions from the intrinsic module ISO_C_BINDING are allowed
in specification expressions, so tweak some general checks that would otherwise
trigger error messages about inadmissible targets, dummy procedures in specification
expressions, and pure procedures with impure dummy procedures.

Author: klausler

flang/lib/Evaluate/check-expression.cpp

@@ -649,7 +649,8 @@ class CheckSpecificationExprHelper
               return std::holds_alternative<characteristics::DummyProcedure>(
                   dummy.u);
             })};
-        if (iter != procChars->dummyArguments.end()) {
+        if (iter != procChars->dummyArguments.end() &&
+            ultimate.name().ToString() != "__builtin_c_funloc") {
           return "reference to function '"s + ultimate.name().ToString() +
               "' with dummy procedure argument '" + iter->name + '\'';
         }

flang/lib/Evaluate/tools.cpp

@@ -82,6 +82,8 @@ auto IsVariableHelper::operator()(const Symbol &symbol) const -> Result {
   const Symbol &ultimate{symbol.GetUltimate()};
   return !IsNamedConstant(ultimate) &&
       (ultimate.has<semantics::ObjectEntityDetails>() ||
+          (ultimate.has<semantics::EntityDetails>() &&
+              ultimate.attrs().test(semantics::Attr::TARGET)) ||
           ultimate.has<semantics::AssocEntityDetails>());
 }
 auto IsVariableHelper::operator()(const Component &x) const -> Result {

flang/lib/Semantics/check-declarations.cpp

@@ -354,7 +354,10 @@ void CheckHelper::Check(const Symbol &symbol) {
       messages_.Say(
           "A pure subprogram may not have a variable with the VOLATILE attribute"_err_en_US);
     }
-    if (IsProcedure(symbol) && !IsPureProcedure(symbol) && IsDummy(symbol)) {
+    if (innermostSymbol_ && innermostSymbol_->name() == "__builtin_c_funloc") {
+      // The intrinsic procedure C_FUNLOC() gets a pass on this check.
+    } else if (IsProcedure(symbol) && !IsPureProcedure(symbol) &&
+        IsDummy(symbol)) {
       messages_.Say(
           "A dummy procedure of a pure subprogram must be pure"_err_en_US);
     }

flang/module/__fortran_builtins.f90

@@ -182,7 +182,10 @@
     __builtin_c_ptr_ne = x%__address /= y%__address
   end function
 
-  function __builtin_c_funloc(x)
+  ! Semantics has some special-case code that allows c_funloc()
+  ! to appear in a specification expression and exempts it
+  ! from the requirement that "x" be a pure dummy procedure.
+  pure function __builtin_c_funloc(x)
     type(__builtin_c_funptr) :: __builtin_c_funloc
     external :: x
     __builtin_c_funloc = __builtin_c_funptr(loc(x))

flang/test/Semantics/c_loc01.f90

@@ -4,7 +4,10 @@ module m
   type haslen(L)
     integer, len :: L
   end type
+  integer, target :: targ
  contains
+  subroutine subr
+  end
   subroutine test(assumedType, poly, nclen)
     type(*), target :: assumedType
     class(*), target ::  poly
@@ -17,6 +20,8 @@ subroutine test(assumedType, poly, nclen)
     type(hasLen(1)), target :: clen
     type(hasLen(*)), target :: nclen
     character(2), target :: ch
+    real :: arr1(purefun1(c_loc(targ))) ! ok
+    real :: arr2(purefun2(c_funloc(subr))) ! ok
     !ERROR: C_LOC() argument must be a data pointer or target
     cp = c_loc(notATarget)
     !ERROR: C_LOC() argument must be a data pointer or target
@@ -44,4 +49,12 @@ subroutine test(assumedType, poly, nclen)
     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(c_funptr) and TYPE(c_ptr)
     cfp = cp
   end
+  pure integer function purefun1(p)
+    type(c_ptr), intent(in) :: p
+    purefun1 = 1
+  end
+  pure integer function purefun2(p)
+    type(c_funptr), intent(in) :: p
+    purefun2 = 1
+  end
 end module