[flang-commits] [flang] f5e4451 - [flang] Fix interpretation of intrinsic names as arguments

[Tim Keith via flang-commits]

Author: Tim Keith
Date: 2020-08-11T16:52:50-07:00
New Revision: f5e4451e1f27e87d30c4eb0c3c99f2f8d07039e1

URL: https://github.com/llvm/llvm-project/commit/f5e4451e1f27e87d30c4eb0c3c99f2f8d07039e1
DIFF: https://github.com/llvm/llvm-project/commit/f5e4451e1f27e87d30c4eb0c3c99f2f8d07039e1.diff

LOG: [flang] Fix interpretation of intrinsic names as arguments

If an unrestricted specific intrinsic function name is first encountered
as an actual argument, it should be interpreted as an object entity,
not a procedure entity.

Fix some tests that depended on the previous interpretation by adding
explicit INTRINSIC statements.

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

Added: 
    

Modified: 
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/call02.f90
    flang/test/Semantics/call09.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 48d0e9315d54..5806058d7e05 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1290,7 +1290,6 @@ class ResolveNamesVisitor : public virtual ScopeHandler,
     ResolveName(*parser::Unwrap<parser::Name>(x.name));
   }
   void Post(const parser::ProcComponentRef &);
-  bool Pre(const parser::ActualArg &);
   bool Pre(const parser::FunctionReference &);
   bool Pre(const parser::CallStmt &);
   bool Pre(const parser::ImportStmt &);
@@ -5317,23 +5316,6 @@ const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(
 
 // ResolveNamesVisitor implementation
 
-// Ensures that bare undeclared intrinsic procedure names passed as actual
-// arguments get recognized as being intrinsics.
-bool ResolveNamesVisitor::Pre(const parser::ActualArg &arg) {
-  if (const auto *expr{std::get_if<Indirection<parser::Expr>>(&arg.u)}) {
-    if (const auto *designator{
-            std::get_if<Indirection<parser::Designator>>(&expr->value().u)}) {
-      if (const auto *dataRef{
-              std::get_if<parser::DataRef>(&designator->value().u)}) {
-        if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
-          NameIsKnownOrIntrinsic(*name);
-        }
-      }
-    }
-  }
-  return true;
-}
-
 bool ResolveNamesVisitor::Pre(const parser::FunctionReference &x) {
   HandleCall(Symbol::Flag::Function, x.v);
   return false;

diff  --git a/flang/test/Semantics/call02.f90 b/flang/test/Semantics/call02.f90
index 6475f98d9b66..2012544894f4 100644
--- a/flang/test/Semantics/call02.f90
+++ b/flang/test/Semantics/call02.f90
@@ -15,6 +15,7 @@ subroutine badsubr(dummy)
       procedure(elem) :: dummy
     end subroutine
   end interface
+  intrinsic :: cos
   call subr(cos) ! not an error
   !ERROR: Non-intrinsic ELEMENTAL procedure 'elem' may not be passed as an actual argument
   call subr(elem) ! C1533
@@ -35,6 +36,7 @@ elemental real function elem03(x)
     real, value :: x
   end function
   subroutine test
+    intrinsic :: cos
     call callme(cos) ! not an error
     !ERROR: Non-intrinsic ELEMENTAL procedure 'elem01' may not be passed as an actual argument
     call callme(elem01) ! C1533
@@ -65,3 +67,25 @@ subroutine test
     call callee(coarray[1]) ! C1537
   end subroutine
 end module
+
+program p03
+  logical :: l
+  call s1(index)
+  l = index .eq. 0  ! index is an object entity, not an intrinsic
+  call s2(sin)
+  !ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure
+  call s3(cos)
+contains
+  subroutine s2(x)
+    real :: x
+  end
+  subroutine s3(p)
+    procedure(real) :: p
+  end
+end
+
+program p04
+  implicit none
+  !ERROR: No explicit type declared for 'index'
+  call s1(index)
+end

diff  --git a/flang/test/Semantics/call09.f90 b/flang/test/Semantics/call09.f90
index 282ae2ec33e4..577867aaa333 100644
--- a/flang/test/Semantics/call09.f90
+++ b/flang/test/Semantics/call09.f90
@@ -43,6 +43,7 @@ function intprocptr()
   end function
 
   subroutine test1 ! 15.5.2.9(5)
+    intrinsic :: sin
     procedure(realfunc), pointer :: p
     procedure(intfunc), pointer :: ip
     p => realfunc