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 *symbol)}) {
41 // Catch problems with non-definability of the
42 // pointer/allocatable
43 context_
44 .Say(name.source,
45 "Name in DEALLOCATE statement is not definable"_err_en_US)
46 .Attach(std::move(*whyNot));
47 } else if (auto whyNot{WhyNotDefinable(name.source,
48 context_.FindScope(name.source),
49 DefinabilityFlags{}, *symbol)}) {
50 // Catch problems with non-definability of the dynamic object
51 context_
52 .Say(name.source,
53 "Object in DEALLOCATE statement is not deallocatable"_err_en_US)
54 .Attach(std::move(*whyNot));
55 } else {
56 context_.CheckIndexVarRedefine(name);
57 }
58 },
59 [&](const parser::StructureComponent &structureComponent) {
60 // Only perform structureComponent checks if it was successfully
61 // analyzed by expression analysis.
62 auto source{structureComponent.component.source};
63 if (const auto *expr{GetExpr(context_, allocateObject)}) {
64 if (const Symbol *
65 symbol{structureComponent.component.symbol
66 ? &structureComponent.component.symbol
67 ->GetUltimate()
68 : nullptr};
69 !IsAllocatableOrObjectPointer(symbol)) { // F'2023 C936
70 context_.Say(source,
71 "Component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
72 } else if (auto whyNot{WhyNotDefinable(source,
73 context_.FindScope(source),
74 {DefinabilityFlag::PointerDefinition,
75 DefinabilityFlag::AcceptAllocatable},
76 *expr)}) {
77 context_
78 .Say(source,
79 "Name in DEALLOCATE statement is not definable"_err_en_US)
80 .Attach(std::move(*whyNot));
81 } else if (auto whyNot{WhyNotDefinable(source,
82 context_.FindScope(source), DefinabilityFlags{},
83 *expr)}) {
84 context_
85 .Say(source,
86 "Object in DEALLOCATE statement is not deallocatable"_err_en_US)
87 .Attach(std::move(*whyNot));
88 }
89 }
90 },
91 },
92 allocateObject.u);
93 }
94 bool gotStat{false}, gotMsg{false};
95 for (const parser::StatOrErrmsg &deallocOpt :
96 std::get<std::list<parser::StatOrErrmsg>>(deallocateStmt.t)) {
97 common::visit(
98 common::visitors{
99 [&](const parser::StatVariable &) {
100 if (gotStat) {
101 context_.Say(
102 "STAT may not be duplicated in a DEALLOCATE statement"_err_en_US);
103 }
104 gotStat = true;
105 },
106 [&](const parser::MsgVariable &var) {
107 WarnOnDeferredLengthCharacterScalar(context_,
108 GetExpr(context_, var), var.v.thing.thing.GetSource(),
109 "ERRMSG=");
110 if (gotMsg) {
111 context_.Say(
112 "ERRMSG may not be duplicated in a DEALLOCATE statement"_err_en_US);
113 }
114 gotMsg = true;
115 },
116 },
117 deallocOpt.u);
118 }
119}
120
121} // namespace Fortran::semantics
122

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