[flang-commits] [PATCH] D159032: [flang] Fix GENERIC, PUBLIC/PRIVATE

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: vdonaldson.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a reviewer: sscalpone.
Herald added a project: All.
klausler requested review of this revision.

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.


https://reviews.llvm.org/D159032

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


Index: flang/test/Semantics/resolve120.f90
===================================================================
--- /dev/null
+++ 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
Index: flang/lib/Semantics/resolve-names.cpp
===================================================================
--- flang/lib/Semantics/resolve-names.cpp
+++ flang/lib/Semantics/resolve-names.cpp
@@ -1763,7 +1763,6 @@
 }
 
 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 @@
   }
 }
 bool AttrsVisitor::Pre(const parser::IntentSpec &x) {
-  CHECK(attrs_);
   CheckAndSet(IntentSpecToAttr(x));
   return false;
 }
@@ -1787,6 +1785,7 @@
 
 // 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 @@
 // 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 @@
       HaveAttrConflict(attrName, Attr::RECURSIVE, Attr::NON_RECURSIVE);
 }
 bool AttrsVisitor::CheckAndSet(Attr attrName) {
-  CHECK(attrs_);
   if (IsConflictingAttr(attrName) || IsDuplicateAttr(attrName)) {
     return false;
   }
@@ -3290,11 +3289,12 @@
 
 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);


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D159032.554084.patch
Type: text/x-patch
Size: 2869 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230828/7fba97ca/attachment-0001.bin>