brintos

brintos / llvm-project-archived public Read only

0
0
Text · 1.6 KiB · aabd520 Raw
43 lines · cpp
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-exception6//7//===----------------------------------------------------------------------===//8 9#include "check-stop.h"10#include "flang/Evaluate/expression.h"11#include "flang/Parser/parse-tree.h"12#include "flang/Semantics/semantics.h"13#include "flang/Semantics/tools.h"14#include "flang/Support/Fortran.h"15#include <optional>16 17namespace Fortran::semantics {18 19void 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 kind25      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-expr31      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::semantics43