[PATCH] D85792: [flang] Fix interpretation of intrinsic names as arguments

[Tim Keith via Phabricator via llvm-commits]

tskeith created this revision.
tskeith added reviewers: klausler, PeteSteinfeld, sscalpone.
tskeith added a project: Flang.
Herald added a reviewer: jdoerfert.
Herald added a reviewer: DavidTruby.
Herald added a project: LLVM.
Herald added a subscriber: llvm-commits.
tskeith requested review of this revision.

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.


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D85792

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


Index: flang/test/Semantics/call09.f90
===================================================================
--- flang/test/Semantics/call09.f90
+++ flang/test/Semantics/call09.f90
@@ -43,6 +43,7 @@
   end function
 
   subroutine test1 ! 15.5.2.9(5)
+    intrinsic :: sin
     procedure(realfunc), pointer :: p
     procedure(intfunc), pointer :: ip
     p => realfunc
Index: flang/test/Semantics/call02.f90
===================================================================
--- flang/test/Semantics/call02.f90
+++ flang/test/Semantics/call02.f90
@@ -15,6 +15,7 @@
       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 @@
     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 @@
     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
Index: flang/lib/Semantics/resolve-names.cpp
===================================================================
--- flang/lib/Semantics/resolve-names.cpp
+++ flang/lib/Semantics/resolve-names.cpp
@@ -1290,7 +1290,6 @@
     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 @@
 
 // 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;


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D85792.284915.patch
Type: text/x-patch
Size: 2951 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20200811/2bcb26b0/attachment.bin>