1 | //===-- lib/Semantics/check-stop.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-stop.h" |
10 | #include "flang/Common/Fortran.h" |
11 | #include "flang/Evaluate/expression.h" |
12 | #include "flang/Parser/parse-tree.h" |
13 | #include "flang/Semantics/semantics.h" |
14 | #include "flang/Semantics/tools.h" |
15 | #include <optional> |
16 | |
17 | namespace Fortran::semantics { |
18 | |
19 | void StopChecker::Enter(const parser::StopStmt &stmt) { |
20 | const auto &stopCode{std::get<std::optional<parser::StopCode>>(stmt.t)}; |
21 | if (const auto *expr{GetExpr(context_, stopCode)}) { |
22 | const parser::CharBlock &source{parser::FindSourceLocation(stopCode)}; |
23 | if (ExprHasTypeCategory(*expr, common::TypeCategory::Integer)) { |
24 | // C1171 default kind |
25 | if (!ExprTypeKindIsDefault(*expr, context_)) { |
26 | context_.Say( |
27 | source, "INTEGER stop code must be of default kind"_err_en_US ); |
28 | } |
29 | } else if (ExprHasTypeCategory(*expr, common::TypeCategory::Character)) { |
30 | // R1162 spells scalar-DEFAULT-char-expr |
31 | if (!ExprTypeKindIsDefault(*expr, context_)) { |
32 | context_.Say( |
33 | source, "CHARACTER stop code must be of default kind"_err_en_US ); |
34 | } |
35 | } else { |
36 | context_.Say( |
37 | source, "Stop code must be of INTEGER or CHARACTER type"_err_en_US ); |
38 | } |
39 | } |
40 | } |
41 | |
42 | } // namespace Fortran::semantics |
43 | |