diff options
| author | Peter Klausler <pklausler@nvidia.com> | 2022-07-18 14:12:21 -0700 |
|---|---|---|
| committer | Peter Klausler <pklausler@nvidia.com> | 2022-07-23 10:18:28 -0700 |
| commit | b09c8905108c41102d1c2b23dae2faf8ac3a57de (patch) | |
| tree | 0339bd525880bc041bb1c3ba304630a3882b81b1 /flang | |
| parent | ee61dc5f6c57038e1247e048d43d543dd2340cf1 (diff) | |
| download | llvm-b09c8905108c41102d1c2b23dae2faf8ac3a57de.zip llvm-b09c8905108c41102d1c2b23dae2faf8ac3a57de.tar.gz llvm-b09c8905108c41102d1c2b23dae2faf8ac3a57de.tar.bz2 | |
[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
Diffstat (limited to 'flang')
| -rw-r--r-- | flang/lib/Evaluate/characteristics.cpp | 9 | ||||
| -rw-r--r-- | flang/test/Semantics/assign03.f90 | 10 |
2 files changed, 16 insertions, 3 deletions
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp index fa71904..3443866 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 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())) { diff --git a/flang/test/Semantics/assign03.f90 b/flang/test/Semantics/assign03.f90 index cedcb77..58ae7f1 100644 --- a/flang/test/Semantics/assign03.f90 +++ b/flang/test/Semantics/assign03.f90 @@ -100,7 +100,7 @@ contains !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 @@ contains 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 |