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