[flang-commits] [flang] c81fe7f - [flang] Fix GENERIC, PUBLIC/PRIVATE

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-08-29T08:35:11-07:00
New Revision: c81fe7f6ce33c974e3bcb7a96c1bf6fbc3ddf2b1

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

LOG: [flang] Fix GENERIC, PUBLIC/PRIVATE

The handling of accessibility attributes on GENERIC statements outside
derived type definitions is incorrect in name resolution.  Change it to
use the usual BeginAttrs()/EndAttrs() infrastructure.

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

Added: 
    flang/test/Semantics/resolve120.f90

Modified: 
    flang/lib/Semantics/resolve-names.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index dcd9a8d2ab2d8e..92798993348aab 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1763,7 +1763,6 @@ void AttrsVisitor::SetBindNameOn(Symbol &symbol) {
 }
 
 void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) {
-  CHECK(attrs_);
   if (CheckAndSet(Attr::BIND_C)) {
     if (x.v) {
       bindName_ = EvaluateExpr(*x.v);
@@ -1771,7 +1770,6 @@ void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) {
   }
 }
 bool AttrsVisitor::Pre(const parser::IntentSpec &x) {
-  CHECK(attrs_);
   CheckAndSet(IntentSpecToAttr(x));
   return false;
 }
@@ -1787,6 +1785,7 @@ bool AttrsVisitor::Pre(const parser::Pass &x) {
 
 // C730, C743, C755, C778, C1543 say no attribute or prefix repetitions
 bool AttrsVisitor::IsDuplicateAttr(Attr attrName) {
+  CHECK(attrs_);
   if (attrs_->test(attrName)) {
     Say(currStmtSource().value(),
         "Attribute '%s' cannot be used more than once"_warn_en_US,
@@ -1799,6 +1798,7 @@ bool AttrsVisitor::IsDuplicateAttr(Attr attrName) {
 // See if attrName violates a constraint cause by a conflict.  attr1 and attr2
 // name attributes that cannot be used on the same declaration
 bool AttrsVisitor::HaveAttrConflict(Attr attrName, Attr attr1, Attr attr2) {
+  CHECK(attrs_);
   if ((attrName == attr1 && attrs_->test(attr2)) ||
       (attrName == attr2 && attrs_->test(attr1))) {
     Say(currStmtSource().value(),
@@ -1819,7 +1819,6 @@ bool AttrsVisitor::IsConflictingAttr(Attr attrName) {
       HaveAttrConflict(attrName, Attr::RECURSIVE, Attr::NON_RECURSIVE);
 }
 bool AttrsVisitor::CheckAndSet(Attr attrName) {
-  CHECK(attrs_);
   if (IsConflictingAttr(attrName) || IsDuplicateAttr(attrName)) {
     return false;
   }
@@ -3285,11 +3284,12 @@ bool InterfaceVisitor::Pre(const parser::ProcedureStmt &x) {
 
 bool InterfaceVisitor::Pre(const parser::GenericStmt &) {
   genericInfo_.emplace(/*isInterface*/ false);
-  return true;
+  return BeginAttrs();
 }
 void InterfaceVisitor::Post(const parser::GenericStmt &x) {
-  if (auto &accessSpec{std::get<std::optional<parser::AccessSpec>>(x.t)}) {
-    SetExplicitAttr(*GetGenericInfo().symbol, AccessSpecToAttr(*accessSpec));
+  auto attrs{EndAttrs()};
+  if (Symbol * symbol{GetGenericInfo().symbol}) {
+    SetExplicitAttrs(*symbol, attrs);
   }
   const auto &names{std::get<std::list<parser::Name>>(x.t)};
   AddSpecificProcs(names, ProcedureKind::Procedure);

diff  --git a/flang/test/Semantics/resolve120.f90 b/flang/test/Semantics/resolve120.f90
new file mode 100644
index 00000000000000..e1ec58724f00c4
--- /dev/null
+++ b/flang/test/Semantics/resolve120.f90
@@ -0,0 +1,22 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Ensure that accessibility works on GENERIC statement
+module m
+  generic, public :: public => specific
+  generic, private :: private => specific
+ contains
+  subroutine specific
+  end
+end
+program main
+  use m
+  generic :: public => internal
+  generic :: private => internal
+  call public
+  call public(1)
+  !ERROR: No specific subroutine of generic 'private' matches the actual arguments
+  call private
+  call private(1)
+ contains
+  subroutine internal(n)
+  end
+end