[flang-commits] [flang] 848cca6 - [flang] Checks for pointers to intrinsic functions
Emil Kieri via flang-commits
flang-commits at lists.llvm.org
Thu Oct 28 03:47:25 PDT 2021
Author: Emil Kieri
Date: 2021-10-28T12:30:29+02:00
New Revision: 848cca6c5bf0e79c45cf03d4b3fd33be803c30d3
URL: https://github.com/llvm/llvm-project/commit/848cca6c5bf0e79c45cf03d4b3fd33be803c30d3
DIFF: https://github.com/llvm/llvm-project/commit/848cca6c5bf0e79c45cf03d4b3fd33be803c30d3.diff
LOG: [flang] Checks for pointers to intrinsic functions
Check that when a procedure pointer is initialised or assigned with an intrinsic
function, or when its interface is being defined by one, that intrinsic function
is unrestricted specific (listed in Table 16.2 of F'2018).
Mark intrinsics LGE, LGT, LLE, and LLT as restricted specific. Getting their
classifications right helps in designing the tests.
Differential Revision: https://reviews.llvm.org/D112381
Added:
Modified:
flang/lib/Evaluate/characteristics.cpp
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/expression.cpp
flang/test/Semantics/resolve46.f90
Removed:
################################################################################
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index d61ff9b791e46..464c9e9bce0d6 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -418,8 +418,12 @@ static std::optional<Procedure> CharacterizeProcedure(
// attempts to use impermissible intrinsic procedures as the
// interfaces of procedure pointers are caught and flagged in
// declaration checking in Semantics.
- return context.intrinsics().IsSpecificIntrinsicFunction(
- symbol.name().ToString());
+ auto intrinsic{context.intrinsics().IsSpecificIntrinsicFunction(
+ symbol.name().ToString())};
+ if (intrinsic && intrinsic->isRestrictedSpecific) {
+ intrinsic.reset(); // Exclude intrinsics from table 16.3.
+ }
+ return intrinsic;
}
const semantics::ProcInterface &interface{proc.interface()};
if (const semantics::Symbol * interfaceSymbol{interface.symbol()}) {
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 519f0e6424099..20be19e5f109a 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -994,13 +994,17 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
{{"len", {{"string", DefaultChar, Rank::anyOrAssumedRank}}, DefaultInt,
Rank::scalar}},
{{"lge", {{"string_a", DefaultChar}, {"string_b", DefaultChar}},
- DefaultLogical}},
+ DefaultLogical},
+ "lge", true},
{{"lgt", {{"string_a", DefaultChar}, {"string_b", DefaultChar}},
- DefaultLogical}},
+ DefaultLogical},
+ "lgt", true},
{{"lle", {{"string_a", DefaultChar}, {"string_b", DefaultChar}},
- DefaultLogical}},
+ DefaultLogical},
+ "lle", true},
{{"llt", {{"string_a", DefaultChar}, {"string_b", DefaultChar}},
- DefaultLogical}},
+ DefaultLogical},
+ "llt", true},
{{"log", {{"x", DefaultReal}}, DefaultReal}},
{{"log10", {{"x", DefaultReal}}, DefaultReal}},
{{"max0",
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 5a2c05acf002f..6b52de57fc373 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -624,10 +624,14 @@ void CheckHelper::CheckPointerInitialization(const Symbol &symbol) {
// or an unrestricted specific intrinsic function.
const Symbol &ultimate{(*proc->init())->GetUltimate()};
if (ultimate.attrs().test(Attr::INTRINSIC)) {
- if (!context_.intrinsics().IsSpecificIntrinsicFunction(
- ultimate.name().ToString())) { // C1030
+ if (const auto intrinsic{
+ context_.intrinsics().IsSpecificIntrinsicFunction(
+ ultimate.name().ToString())};
+ !intrinsic || intrinsic->isRestrictedSpecific) { // C1030
context_.Say(
- "Intrinsic procedure '%s' is not a specific intrinsic permitted for use as the initializer for procedure pointer '%s'"_err_en_US,
+ "Intrinsic procedure '%s' is not an unrestricted specific "
+ "intrinsic permitted for use as the initializer for procedure "
+ "pointer '%s'"_err_en_US,
ultimate.name(), symbol.name());
}
} else if (!ultimate.attrs().test(Attr::EXTERNAL) &&
@@ -774,10 +778,14 @@ void CheckHelper::CheckProcEntity(
CheckPointerInitialization(symbol);
if (const Symbol * interface{details.interface().symbol()}) {
if (interface->attrs().test(Attr::INTRINSIC)) {
- if (!context_.intrinsics().IsSpecificIntrinsicFunction(
- interface->name().ToString())) { // C1515
+ if (const auto intrinsic{
+ context_.intrinsics().IsSpecificIntrinsicFunction(
+ interface->name().ToString())};
+ !intrinsic || intrinsic->isRestrictedSpecific) { // C1515
messages_.Say(
- "Intrinsic procedure '%s' is not a specific intrinsic permitted for use as the definition of the interface to procedure pointer '%s'"_err_en_US,
+ "Intrinsic procedure '%s' is not an unrestricted specific "
+ "intrinsic permitted for use as the definition of the interface "
+ "to procedure pointer '%s'"_err_en_US,
interface->name(), symbol.name());
}
} else if (interface->attrs().test(Attr::ELEMENTAL)) {
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 9635659c47c60..b217c81f31a37 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -190,13 +190,14 @@ MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) {
return Expr<SomeType>{ProcedureDesignator{symbol}};
}
} else if (auto interface{context_.intrinsics().IsSpecificIntrinsicFunction(
- symbol.name().ToString())}) {
+ symbol.name().ToString())};
+ interface && !interface->isRestrictedSpecific) {
SpecificIntrinsic intrinsic{
symbol.name().ToString(), std::move(*interface)};
intrinsic.isRestrictedSpecific = interface->isRestrictedSpecific;
return Expr<SomeType>{ProcedureDesignator{std::move(intrinsic)}};
} else {
- Say("'%s' is not a specific intrinsic procedure"_err_en_US,
+ Say("'%s' is not an unrestricted specific intrinsic procedure"_err_en_US,
symbol.name());
}
return std::nullopt;
diff --git a/flang/test/Semantics/resolve46.f90 b/flang/test/Semantics/resolve46.f90
index 716d72f835767..981008ae3ea4f 100644
--- a/flang/test/Semantics/resolve46.f90
+++ b/flang/test/Semantics/resolve46.f90
@@ -1,22 +1,45 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
-! C1030 - pointers to intrinsic procedures
+! C1030 - assignment of pointers to intrinsic procedures
+! C1515 - interface definition for procedure pointers
+! C1519 - initialization of pointers to intrinsic procedures
program main
intrinsic :: cos ! a specific & generic intrinsic name
intrinsic :: alog10 ! a specific intrinsic name, not generic
intrinsic :: null ! a weird special case
intrinsic :: bessel_j0 ! generic intrinsic, not specific
intrinsic :: amin0
+ intrinsic :: mod
+ intrinsic :: llt
!ERROR: 'haltandcatchfire' is not a known intrinsic procedure
intrinsic :: haltandcatchfire
- procedure(sin), pointer :: p
+
+ abstract interface
+ logical function chrcmp(a,b)
+ character(*), intent(in) :: a
+ character(*), intent(in) :: b
+ end function chrcmp
+ end interface
+
+ procedure(sin), pointer :: p => cos
+ !ERROR: Intrinsic procedure 'amin0' is not an unrestricted specific intrinsic permitted for use as the definition of the interface to procedure pointer 'q'
+ procedure(amin0), pointer :: q
+ !ERROR: Intrinsic procedure 'bessel_j0' is not an unrestricted specific intrinsic permitted for use as the definition of the interface to procedure pointer 'r'
+ procedure(bessel_j0), pointer :: r
+ !ERROR: Intrinsic procedure 'llt' is not an unrestricted specific intrinsic permitted for use as the initializer for procedure pointer 's'
+ procedure(chrcmp), pointer :: s => llt
+ !ERROR: Intrinsic procedure 'bessel_j0' is not an unrestricted specific intrinsic permitted for use as the initializer for procedure pointer 't'
+ procedure(cos), pointer :: t => bessel_j0
+ procedure(chrcmp), pointer :: u
p => alog ! valid use of an unrestricted specific intrinsic
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 'amin0'
- p => amin0
- !ERROR: Procedure pointer 'p' associated with incompatible procedure designator 'amin1'
- p => amin1
- !ERROR: 'bessel_j0' is not a specific intrinsic procedure
+ !ERROR: Procedure pointer 'p' associated with incompatible procedure designator 'mod'
+ p => mod
+ !ERROR: Procedure pointer 'p' associated with incompatible procedure designator 'index'
+ p => index
+ !ERROR: 'bessel_j0' is not an unrestricted specific intrinsic procedure
p => bessel_j0
+ !ERROR: 'llt' is not an unrestricted specific intrinsic procedure
+ u => llt
end program main
More information about the flang-commits
mailing list