031b4e5e79
Unlike other executable constructs with associating selectors, the selector of a SELECT RANK construct can have the ALLOCATABLE or POINTER attribute, and will work as an allocatable or object pointer within each rank case, so long as there is no RANK(*) case. Getting this right exposed a correctness risk with the popular predicate IsAllocatableOrPointer() -- it will be true for procedure pointers as well as object pointers, and in many contexts, a procedure pointer should not be acceptable. So this patch adds the new predicate IsAllocatableOrObjectPointer(), and updates some call sites of the original function to use the new one. Differential Revision: https://reviews.llvm.org/D159043
122 lines
5.4 KiB
C++
122 lines
5.4 KiB
C++
//===-- lib/Semantics/check-deallocate.cpp --------------------------------===//
|
|
//
|
|
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
|
|
// See https://llvm.org/LICENSE.txt for license information.
|
|
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
|
|
//
|
|
//===----------------------------------------------------------------------===//
|
|
|
|
#include "check-deallocate.h"
|
|
#include "definable.h"
|
|
#include "flang/Evaluate/type.h"
|
|
#include "flang/Parser/message.h"
|
|
#include "flang/Parser/parse-tree.h"
|
|
#include "flang/Semantics/expression.h"
|
|
#include "flang/Semantics/tools.h"
|
|
|
|
namespace Fortran::semantics {
|
|
|
|
void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
|
|
for (const parser::AllocateObject &allocateObject :
|
|
std::get<std::list<parser::AllocateObject>>(deallocateStmt.t)) {
|
|
common::visit(
|
|
common::visitors{
|
|
[&](const parser::Name &name) {
|
|
const Symbol *symbol{
|
|
name.symbol ? &name.symbol->GetUltimate() : nullptr};
|
|
;
|
|
if (context_.HasError(symbol)) {
|
|
// already reported an error
|
|
} else if (!IsVariableName(*symbol)) {
|
|
context_.Say(name.source,
|
|
"Name in DEALLOCATE statement must be a variable name"_err_en_US);
|
|
} else if (!IsAllocatableOrObjectPointer(symbol)) { // C936
|
|
context_.Say(name.source,
|
|
"Name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
|
|
} else if (auto whyNot{WhyNotDefinable(name.source,
|
|
context_.FindScope(name.source),
|
|
{DefinabilityFlag::PointerDefinition,
|
|
DefinabilityFlag::AcceptAllocatable},
|
|
*symbol)}) {
|
|
// Catch problems with non-definability of the
|
|
// pointer/allocatable
|
|
context_
|
|
.Say(name.source,
|
|
"Name in DEALLOCATE statement is not definable"_err_en_US)
|
|
.Attach(std::move(*whyNot));
|
|
} else if (auto whyNot{WhyNotDefinable(name.source,
|
|
context_.FindScope(name.source),
|
|
DefinabilityFlags{}, *symbol)}) {
|
|
// Catch problems with non-definability of the dynamic object
|
|
context_
|
|
.Say(name.source,
|
|
"Object in DEALLOCATE statement is not deallocatable"_err_en_US)
|
|
.Attach(std::move(*whyNot));
|
|
} else {
|
|
context_.CheckIndexVarRedefine(name);
|
|
}
|
|
},
|
|
[&](const parser::StructureComponent &structureComponent) {
|
|
// Only perform structureComponent checks if it was successfully
|
|
// analyzed by expression analysis.
|
|
auto source{structureComponent.component.source};
|
|
if (const auto *expr{GetExpr(context_, allocateObject)}) {
|
|
if (const Symbol *
|
|
symbol{structureComponent.component.symbol
|
|
? &structureComponent.component.symbol
|
|
->GetUltimate()
|
|
: nullptr};
|
|
!IsAllocatableOrObjectPointer(symbol)) { // F'2023 C936
|
|
context_.Say(source,
|
|
"Component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
|
|
} else if (auto whyNot{WhyNotDefinable(source,
|
|
context_.FindScope(source),
|
|
{DefinabilityFlag::PointerDefinition,
|
|
DefinabilityFlag::AcceptAllocatable},
|
|
*expr)}) {
|
|
context_
|
|
.Say(source,
|
|
"Name in DEALLOCATE statement is not definable"_err_en_US)
|
|
.Attach(std::move(*whyNot));
|
|
} else if (auto whyNot{WhyNotDefinable(source,
|
|
context_.FindScope(source), DefinabilityFlags{},
|
|
*expr)}) {
|
|
context_
|
|
.Say(source,
|
|
"Object in DEALLOCATE statement is not deallocatable"_err_en_US)
|
|
.Attach(std::move(*whyNot));
|
|
}
|
|
}
|
|
},
|
|
},
|
|
allocateObject.u);
|
|
}
|
|
bool gotStat{false}, gotMsg{false};
|
|
for (const parser::StatOrErrmsg &deallocOpt :
|
|
std::get<std::list<parser::StatOrErrmsg>>(deallocateStmt.t)) {
|
|
common::visit(
|
|
common::visitors{
|
|
[&](const parser::StatVariable &) {
|
|
if (gotStat) {
|
|
context_.Say(
|
|
"STAT may not be duplicated in a DEALLOCATE statement"_err_en_US);
|
|
}
|
|
gotStat = true;
|
|
},
|
|
[&](const parser::MsgVariable &var) {
|
|
WarnOnDeferredLengthCharacterScalar(context_,
|
|
GetExpr(context_, var), var.v.thing.thing.GetSource(),
|
|
"ERRMSG=");
|
|
if (gotMsg) {
|
|
context_.Say(
|
|
"ERRMSG may not be duplicated in a DEALLOCATE statement"_err_en_US);
|
|
}
|
|
gotMsg = true;
|
|
},
|
|
},
|
|
deallocOpt.u);
|
|
}
|
|
}
|
|
|
|
} // namespace Fortran::semantics
|