[flang-commits] [flang] b09c890 - [flang] Clean up bogus semantic error on procedure pointer assignment

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-07-23T10:18:28-07:00
New Revision: b09c8905108c41102d1c2b23dae2faf8ac3a57de

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

LOG: [flang] Clean up bogus semantic error on procedure pointer assignment

When a procedure pointer with no interface is associated with
an EXTERNAL name with no interface information, but it is later
inferred that the procedure pointer must be a subroutine because it
appears in a CALL statement, don't complain that the EXTERNAL name
is not also known to be a subroutine.

Subroutine vs. function errors are still caught in procedure pointer
assignment compatibility checking; this fix simply ensures that those
more nuanced tests are not overridded by the attribute set equality test.

Also, leave in some code for dumping the differing attributes in legitimate
error cases that was added in the coures of debugging the specific problem.

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

Added: 
    

Modified: 
    flang/lib/Evaluate/characteristics.cpp
    flang/test/Semantics/assign03.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index fa7190420c8d..3443866a31e8 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -949,9 +949,16 @@ bool Procedure::IsCompatibleWith(
   if (!attrs.test(Attr::Elemental)) {
     actualAttrs.reset(Attr::Elemental);
   }
-  if (attrs != actualAttrs) {
+  Attrs 
diff erences{attrs ^ actualAttrs};
+  
diff erences.reset(Attr::Subroutine); // dealt with specifically later
+  if (!
diff erences.empty()) {
     if (whyNot) {
+      auto sep{": "s};
       *whyNot = "incompatible procedure attributes";
+      
diff erences.IterateOverMembers([&](Attr x) {
+        *whyNot += sep + EnumToString(x);
+        sep = ", ";
+      });
     }
   } else if ((IsFunction() && actual.IsSubroutine()) ||
       (IsSubroutine() && actual.IsFunction())) {

diff  --git a/flang/test/Semantics/assign03.f90 b/flang/test/Semantics/assign03.f90
index cedcb775ca4e..58ae7f193483 100644
--- a/flang/test/Semantics/assign03.f90
+++ b/flang/test/Semantics/assign03.f90
@@ -100,7 +100,7 @@ subroutine s5
     !ERROR: Procedure pointer 'p_impure' associated with incompatible procedure designator 'f_elemental2': incompatible dummy argument #1: incompatible dummy data object attributes
     p_impure => f_elemental2
 
-    !ERROR: Procedure pointer 'sp_impure' associated with incompatible procedure designator 's_impure2': incompatible procedure attributes
+    !ERROR: Procedure pointer 'sp_impure' associated with incompatible procedure designator 's_impure2': incompatible procedure attributes: BindC
     sp_impure => s_impure2
     !ERROR: Procedure pointer 'sp_impure' associated with incompatible procedure designator 's_pure2': incompatible dummy argument #1: incompatible dummy data object intents
     sp_impure => s_pure2
@@ -292,5 +292,11 @@ subroutine test3(b)
     integer, parameter :: i = rank(b)
   end subroutine
 
-
+  subroutine s13
+    external :: s_external
+    procedure(), pointer :: ptr
+    !Ok - don't emit an error about incompatible Subroutine attribute
+    ptr => s_external
+    call ptr
+  end subroutine
 end