maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[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
This commit is contained in:
Emil Kieri 2021-10-25 21:43:17 +02:00
parent f9201c70ad
commit 848cca6c5b
5 changed files with 61 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
flang/lib/Evaluate/characteristics.cpp
View File

@ -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()}) {

12
flang/lib/Evaluate/intrinsics.cpp
View File

@ -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",

20
flang/lib/Semantics/check-declarations.cpp
View File

@ -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)) {

5
flang/lib/Semantics/expression.cpp
View File

@ -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;

37
flang/test/Semantics/resolve46.f90
View File

@ -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