xref: /llvm-project/flang/lib/Semantics/check-arithmeticif.cpp (revision fc97d2e68b03bc2979395e84b645e5b3ba35aecd)
1 //===-- lib/Semantics/check-arithmeticif.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-arithmeticif.h"
10 #include "flang/Parser/message.h"
11 #include "flang/Parser/parse-tree.h"
12 #include "flang/Semantics/tools.h"
13 
14 namespace Fortran::semantics {
15 
16 bool IsNumericExpr(const SomeExpr &expr) {
17   auto dynamicType{expr.GetType()};
18   return dynamicType && common::IsNumericTypeCategory(dynamicType->category());
19 }
20 
21 void ArithmeticIfStmtChecker::Leave(
22     const parser::ArithmeticIfStmt &arithmeticIfStmt) {
23   // Arithmetic IF statements have been removed from Fortran 2018.
24   // The constraints and requirements here refer to the 2008 spec.
25   // R853 Check for a scalar-numeric-expr
26   // C849 that shall not be of type complex.
27   auto &parsedExpr{std::get<parser::Expr>(arithmeticIfStmt.t)};
28   if (const auto *expr{GetExpr(context_, parsedExpr)}) {
29     if (expr->Rank() > 0) {
30       context_.Say(parsedExpr.source,
31           "ARITHMETIC IF expression must be a scalar expression"_err_en_US);
32     } else if (ExprHasTypeCategory(*expr, common::TypeCategory::Complex)) {
33       context_.Say(parsedExpr.source,
34           "ARITHMETIC IF expression must not be a COMPLEX expression"_err_en_US);
35     } else if (ExprHasTypeCategory(*expr, common::TypeCategory::Unsigned)) {
36       context_.Say(parsedExpr.source,
37           "ARITHMETIC IF expression must not be an UNSIGNED expression"_err_en_US);
38     } else if (!IsNumericExpr(*expr)) {
39       context_.Say(parsedExpr.source,
40           "ARITHMETIC IF expression must be a numeric expression"_err_en_US);
41     }
42   }
43   // The labels have already been checked in resolve-labels.
44   // TODO: Really?  Check that they are really branch target
45   // statements and in the same inclusive scope.
46 }
47 
48 } // namespace Fortran::semantics
49