1//===-- lib/Semantics/check-deallocate.cpp --------------------------------===//
2//
3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4// See https://llvm.org/LICENSE.txt for license information.
5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6//
7//===----------------------------------------------------------------------===//
8
9#include "check-deallocate.h"
10#include "definable.h"
11#include "flang/Evaluate/type.h"
12#include "flang/Parser/message.h"
13#include "flang/Parser/parse-tree.h"
14#include "flang/Semantics/expression.h"
15#include "flang/Semantics/tools.h"
16
17namespace Fortran::semantics {
18
19void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
20 for (const parser::AllocateObject &allocateObject :
21 std::get<std::list<parser::AllocateObject>>(deallocateStmt.t)) {
22 common::visit(
23 common::visitors{
24 [&](const parser::Name &name) {
25 const Symbol *symbol{
26 name.symbol ? &name.symbol->GetUltimate() : nullptr};
27 ;
28 if (context_.HasError(symbol)) {
29 // already reported an error
30 } else if (!IsVariableName(*symbol)) {
31 context_.Say(name.source,
32 "Name in DEALLOCATE statement must be a variable name"_err_en_US);
33 } else if (!IsAllocatableOrObjectPointer(symbol)) { // C936
34 context_.Say(name.source,
35 "Name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
36 } else if (auto whyNot{WhyNotDefinable(name.source,
37 context_.FindScope(name.source),
38 {DefinabilityFlag::PointerDefinition,
39 DefinabilityFlag::AcceptAllocatable,
40 DefinabilityFlag::PotentialDeallocation},
41 *symbol)}) {
42 // Catch problems with non-definability of the
43 // pointer/allocatable
44 context_
45 .Say(name.source,
46 "Name in DEALLOCATE statement is not definable"_err_en_US)
47 .Attach(std::move(
48 whyNot->set_severity(parser::Severity::Because)));
49 } else if (auto whyNot{WhyNotDefinable(name.source,
50 context_.FindScope(name.source),
51 DefinabilityFlags{}, *symbol)}) {
52 // Catch problems with non-definability of the dynamic object
53 context_
54 .Say(name.source,
55 "Object in DEALLOCATE statement is not deallocatable"_err_en_US)
56 .Attach(std::move(
57 whyNot->set_severity(parser::Severity::Because)));
58 } else {
59 context_.CheckIndexVarRedefine(name);
60 }
61 },
62 [&](const parser::StructureComponent &structureComponent) {
63 // Only perform structureComponent checks if it was successfully
64 // analyzed by expression analysis.
65 auto source{structureComponent.component.source};
66 if (const auto *expr{GetExpr(context_, allocateObject)}) {
67 if (const Symbol *
68 symbol{structureComponent.component.symbol
69 ? &structureComponent.component.symbol
70 ->GetUltimate()
71 : nullptr};
72 !IsAllocatableOrObjectPointer(symbol)) { // F'2023 C936
73 context_.Say(source,
74 "Component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
75 } else if (auto whyNot{WhyNotDefinable(source,
76 context_.FindScope(source),
77 {DefinabilityFlag::PointerDefinition,
78 DefinabilityFlag::AcceptAllocatable,
79 DefinabilityFlag::PotentialDeallocation},
80 *expr)}) {
81 context_
82 .Say(source,
83 "Name in DEALLOCATE statement is not definable"_err_en_US)
84 .Attach(std::move(
85 whyNot->set_severity(parser::Severity::Because)));
86 } else if (auto whyNot{WhyNotDefinable(source,
87 context_.FindScope(source), DefinabilityFlags{},
88 *expr)}) {
89 context_
90 .Say(source,
91 "Object in DEALLOCATE statement is not deallocatable"_err_en_US)
92 .Attach(std::move(
93 whyNot->set_severity(parser::Severity::Because)));
94 } else if (evaluate::ExtractCoarrayRef(*expr)) { // F'2023 C955
95 context_.Say(source,
96 "Component in DEALLOCATE statement may not be coindexed"_err_en_US);
97 }
98 }
99 },
100 },
101 allocateObject.u);
102 }
103 bool gotStat{false}, gotMsg{false};
104 for (const parser::StatOrErrmsg &deallocOpt :
105 std::get<std::list<parser::StatOrErrmsg>>(deallocateStmt.t)) {
106 common::visit(
107 common::visitors{
108 [&](const parser::StatVariable &) {
109 if (gotStat) {
110 context_.Say(
111 "STAT may not be duplicated in a DEALLOCATE statement"_err_en_US);
112 }
113 gotStat = true;
114 },
115 [&](const parser::MsgVariable &var) {
116 WarnOnDeferredLengthCharacterScalar(context_,
117 GetExpr(context_, var), var.v.thing.thing.GetSource(),
118 "ERRMSG=");
119 if (gotMsg) {
120 context_.Say(
121 "ERRMSG may not be duplicated in a DEALLOCATE statement"_err_en_US);
122 }
123 gotMsg = true;
124 },
125 },
126 deallocOpt.u);
127 }
128}
129
130} // namespace Fortran::semantics
131

source code of flang/lib/Semantics/check-deallocate.cpp