[flang-commits] [flang] b22873b - [flang] Always diagnose incompatible function results when associating function pointers
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Oct 31 10:41:41 PDT 2022
Author: Peter Klausler
Date: 2022-10-31T10:41:27-07:00
New Revision: b22873b18cd81529623566fd13ef90cdb48c6ee7
URL: https://github.com/llvm/llvm-project/commit/b22873b18cd81529623566fd13ef90cdb48c6ee7
DIFF: https://github.com/llvm/llvm-project/commit/b22873b18cd81529623566fd13ef90cdb48c6ee7.diff
LOG: [flang] Always diagnose incompatible function results when associating function pointers
There are some exceptional cases where the compiler permits association of
procedure pointers or dummy arguments with slightly incompatible procedure
targets, but they should not override any incompatibilty of function
result types.
(Includes a second fix to resolve the original motivating test failure, in
which a COMPLEX intrinsic function was getting its result kind divided by
two due to an implicit C++ conversion of the kind to a "*kind" parse tree
node, and those legacy "COMPLEX*size" type designators' values are twice
the type kind value.)
Differential Revision: https://reviews.llvm.org/D136964
Added:
Modified:
flang/include/flang/Semantics/symbol.h
flang/lib/Evaluate/tools.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/symbol.cpp
flang/test/Semantics/assign03.f90
flang/test/Semantics/associated.f90
flang/test/Semantics/resolve46.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index c7bd58c40bd63..9c3c22ca8ad32 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -187,6 +187,7 @@ class ObjectEntityDetails : public EntityDetails {
public:
explicit ObjectEntityDetails(EntityDetails &&);
ObjectEntityDetails(const ObjectEntityDetails &) = default;
+ ObjectEntityDetails(ObjectEntityDetails &&) = default;
ObjectEntityDetails &operator=(const ObjectEntityDetails &) = default;
ObjectEntityDetails(bool isDummy = false) : EntityDetails(isDummy) {}
MaybeExpr &init() { return init_; }
@@ -247,7 +248,10 @@ class WithPassArg {
class ProcEntityDetails : public EntityDetails, public WithPassArg {
public:
ProcEntityDetails() = default;
- explicit ProcEntityDetails(EntityDetails &&d);
+ explicit ProcEntityDetails(EntityDetails &&);
+ ProcEntityDetails(const ProcEntityDetails &) = default;
+ ProcEntityDetails(ProcEntityDetails &&) = default;
+ ProcEntityDetails &operator=(const ProcEntityDetails &) = default;
const ProcInterface &interface() const { return interface_; }
ProcInterface &interface() { return interface_; }
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 9d148ba198a60..dce5dda275e2d 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1004,6 +1004,12 @@ std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
} else if (!rhsProcedure) {
msg = "In assignment to procedure %s, the characteristics of the target"
" procedure '%s' could not be determined"_err_en_US;
+ } else if (!isCall && lhsProcedure->functionResult &&
+ rhsProcedure->functionResult &&
+ !lhsProcedure->functionResult->IsCompatibleWith(
+ *rhsProcedure->functionResult, &whyNotCompatible)) {
+ msg =
+ "Function %s associated with incompatible function designator '%s': %s"_err_en_US;
} else if (lhsProcedure->IsCompatibleWith(
*rhsProcedure, &whyNotCompatible, specificIntrinsic)) {
// OK
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 5612f1f642c13..4daf87518c26d 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -671,8 +671,10 @@ class ScopeHandler : public ImplicitRulesVisitor {
const DeclTypeSpec &MakeNumericType(
TypeCategory, const std::optional<parser::KindSelector> &);
+ const DeclTypeSpec &MakeNumericType(TypeCategory, int);
const DeclTypeSpec &MakeLogicalType(
const std::optional<parser::KindSelector> &);
+ const DeclTypeSpec &MakeLogicalType(int);
void NotePossibleBadForwardRef(const parser::Name &);
std::optional<SourceName> HadForwardRef(const Symbol &) const;
bool CheckPossibleBadForwardRef(const Symbol &);
@@ -2535,22 +2537,31 @@ const DeclTypeSpec &ScopeHandler::MakeNumericType(
TypeCategory category, const std::optional<parser::KindSelector> &kind) {
KindExpr value{GetKindParamExpr(category, kind)};
if (auto known{evaluate::ToInt64(value)}) {
- return context().MakeNumericType(category, static_cast<int>(*known));
+ return MakeNumericType(category, static_cast<int>(*known));
} else {
return currScope_->MakeNumericType(category, std::move(value));
}
}
+const DeclTypeSpec &ScopeHandler::MakeNumericType(
+ TypeCategory category, int kind) {
+ return context().MakeNumericType(category, kind);
+}
+
const DeclTypeSpec &ScopeHandler::MakeLogicalType(
const std::optional<parser::KindSelector> &kind) {
KindExpr value{GetKindParamExpr(TypeCategory::Logical, kind)};
if (auto known{evaluate::ToInt64(value)}) {
- return context().MakeLogicalType(static_cast<int>(*known));
+ return MakeLogicalType(static_cast<int>(*known));
} else {
return currScope_->MakeLogicalType(std::move(value));
}
}
+const DeclTypeSpec &ScopeHandler::MakeLogicalType(int kind) {
+ return context().MakeLogicalType(kind);
+}
+
void ScopeHandler::NotePossibleBadForwardRef(const parser::Name &name) {
if (inSpecificationPart_ && name.symbol) {
auto kind{currScope().kind()};
diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index 432db3429ecd9..fe7942bbb7d79 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/lib/Semantics/symbol.cpp
@@ -136,6 +136,9 @@ void EntityDetails::set_type(const DeclTypeSpec &type) {
void AssocEntityDetails::set_rank(int rank) { rank_ = rank; }
void EntityDetails::ReplaceType(const DeclTypeSpec &type) { type_ = &type; }
+ObjectEntityDetails::ObjectEntityDetails(EntityDetails &&d)
+ : EntityDetails(d) {}
+
void ObjectEntityDetails::set_shape(const ArraySpec &shape) {
CHECK(shape_.empty());
for (const auto &shapeSpec : shape) {
@@ -363,9 +366,6 @@ bool Symbol::IsFromModFile() const {
(!owner_->IsTopLevel() && owner_->symbol()->IsFromModFile());
}
-ObjectEntityDetails::ObjectEntityDetails(EntityDetails &&d)
- : EntityDetails(d) {}
-
llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const EntityDetails &x) {
DumpBool(os, "dummy", x.isDummy());
DumpBool(os, "funcResult", x.isFuncResult());
diff --git a/flang/test/Semantics/assign03.f90 b/flang/test/Semantics/assign03.f90
index a5d12be487856..07e2c49008700 100644
--- a/flang/test/Semantics/assign03.f90
+++ b/flang/test/Semantics/assign03.f90
@@ -100,8 +100,10 @@ subroutine s5
!ERROR: Procedure pointer 'p_impure' associated with incompatible procedure designator 'f_impure2': incompatible dummy argument #1: incompatible dummy data object intents
p_impure => f_impure2
- !ERROR: Procedure pointer 'p_pure' associated with incompatible procedure designator 'f_pure2': function results have incompatible types: INTEGER(4) vs REAL(4)
+ !ERROR: Function pointer 'p_pure' associated with incompatible function designator 'f_pure2': function results have incompatible types: INTEGER(4) vs REAL(4)
p_pure => f_pure2
+ !ERROR: Function pointer 'p_pure' associated with incompatible function designator 'ccos': function results have incompatible types: INTEGER(4) vs COMPLEX(4)
+ p_pure => ccos
!ERROR: Procedure pointer 'p_impure' associated with incompatible procedure designator 'f_elemental2': incompatible procedure attributes: Elemental
p_impure => f_elemental2
diff --git a/flang/test/Semantics/associated.f90 b/flang/test/Semantics/associated.f90
index 09639ad409e6a..6774a6447bfc0 100644
--- a/flang/test/Semantics/associated.f90
+++ b/flang/test/Semantics/associated.f90
@@ -155,9 +155,9 @@ subroutine test()
pureFuncPointer => intProc
!WARNING: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
lvar = associated(pureFuncPointer, intProc)
- !ERROR: Procedure pointer 'realprocpointer1' associated with incompatible procedure designator 'intproc': function results have incompatible types: REAL(4) vs INTEGER(4)
+ !ERROR: Function pointer 'realprocpointer1' associated with incompatible function designator 'intproc': function results have incompatible types: REAL(4) vs INTEGER(4)
realProcPointer1 => intProc
- !WARNING: Procedure pointer 'realprocpointer1' associated with incompatible procedure designator 'intproc': function results have incompatible types: REAL(4) vs INTEGER(4)
+ !WARNING: Function pointer 'realprocpointer1' associated with incompatible function designator 'intproc': function results have incompatible types: REAL(4) vs INTEGER(4)
lvar = associated(realProcPointer1, intProc)
subProcPointer => externalProc ! OK to associate a procedure pointer with an explicit interface to a procedure with an implicit interface
lvar = associated(subProcPointer, externalProc) ! OK to associate a procedure pointer with an explicit interface to a procedure with an implicit interface
diff --git a/flang/test/Semantics/resolve46.f90 b/flang/test/Semantics/resolve46.f90
index e50caaf8836ef..56b7fd996dec9 100644
--- a/flang/test/Semantics/resolve46.f90
+++ b/flang/test/Semantics/resolve46.f90
@@ -34,9 +34,9 @@ end function chrcmp
p => alog10 ! ditto, but already declared intrinsic
p => cos ! ditto, but also generic
p => tan ! a generic & an unrestricted specific, not already declared
- !ERROR: Procedure pointer 'p' associated with incompatible procedure designator 'mod': function results have incompatible types: REAL(4) vs INTEGER(4)
+ !ERROR: Function pointer 'p' associated with incompatible function designator 'mod': function results have incompatible types: REAL(4) vs INTEGER(4)
p => mod
- !ERROR: Procedure pointer 'p' associated with incompatible procedure designator 'index': function results have incompatible types: REAL(4) vs INTEGER(4)
+ !ERROR: Function pointer 'p' associated with incompatible function designator 'index': function results have incompatible types: REAL(4) vs INTEGER(4)
p => index
!ERROR: 'bessel_j0' is not an unrestricted specific intrinsic procedure
p => bessel_j0
More information about the flang-commits
mailing list