[flang-commits] [PATCH] D130385: [flang] Clean up bogus semantic error on procedure pointer assignment

[Peter Klausler via Phabricator via flang-commits]

This revision was automatically updated to reflect the committed changes.
Closed by commit rGb09c8905108c: [flang] Clean up bogus semantic error on procedure pointer assignment (authored by klausler).

Repository:
  rG LLVM Github Monorepo

CHANGES SINCE LAST ACTION
  https://reviews.llvm.org/D130385/new/

https://reviews.llvm.org/D130385

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


Index: flang/test/Semantics/assign03.f90
===================================================================
--- flang/test/Semantics/assign03.f90
+++ flang/test/Semantics/assign03.f90
@@ -100,7 +100,7 @@
     !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 @@
     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
Index: flang/lib/Evaluate/characteristics.cpp
===================================================================
--- flang/lib/Evaluate/characteristics.cpp
+++ flang/lib/Evaluate/characteristics.cpp
@@ -949,9 +949,16 @@
   if (!attrs.test(Attr::Elemental)) {
     actualAttrs.reset(Attr::Elemental);
   }
-  if (attrs != actualAttrs) {
+  Attrs differences{attrs ^ actualAttrs};
+  differences.reset(Attr::Subroutine); // dealt with specifically later
+  if (!differences.empty()) {
     if (whyNot) {
+      auto sep{": "s};
       *whyNot = "incompatible procedure attributes";
+      differences.IterateOverMembers([&](Attr x) {
+        *whyNot += sep + EnumToString(x);
+        sep = ", ";
+      });
     }
   } else if ((IsFunction() && actual.IsSubroutine()) ||
       (IsSubroutine() && actual.IsFunction())) {


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D130385.447088.patch
Type: text/x-patch
Size: 2049 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20220723/73ddd379/attachment-0001.bin>