[flang] Semantics checker for STOP and ERROR STOP statements - ExprTypeKindIsDefault added to the tools

Signed-off-by: Paul Osmialowski <pawel.osmialowski@arm.com>

Original-commit: flang-compiler/f18@669b05b27d
Reviewed-on: https://github.com/flang-compiler/f18/pull/367
Tree-same-pre-rewrite: false
This commit is contained in:
Paul Osmialowski 2019-04-11 21:25:45 +01:00 committed by GitHub
parent 54068ddbca
commit ec322c9588
3 changed files with 13 additions and 6 deletions

View file

@ -35,17 +35,13 @@ void StopChecker::Enter(const parser::StopStmt &stmt) {
} else {
if (ExprHasTypeCategory(expr, common::TypeCategory::Integer)) {
// C1171 default kind
if (!(ExprHasTypeKind(expr,
context_.defaultKinds().GetDefaultKind(
common::TypeCategory::Integer)))) {
if (!(ExprTypeKindIsDefault(expr, context_))) {
context_.Say(
source, "Integer stop code must be of default kind"_err_en_US);
}
} else if (ExprHasTypeCategory(expr, common::TypeCategory::Character)) {
// R1162 spells scalar-DEFAULT-char-expr
if (!(ExprHasTypeKind(expr,
context_.defaultKinds().GetDefaultKind(
common::TypeCategory::Character)))) {
if (!(ExprTypeKindIsDefault(expr, context_))) {
context_.Say(
source, "Character stop code must be of default kind"_err_en_US);
}

View file

@ -14,6 +14,7 @@
#include "tools.h"
#include "scope.h"
#include "semantics.h"
#include "symbol.h"
#include "type.h"
#include "../common/indirection.h"
@ -285,6 +286,14 @@ bool ExprHasTypeKind(const evaluate::GenericExprWrapper &expr, int kind) {
return dynamicType.has_value() && dynamicType->kind == kind;
}
bool ExprTypeKindIsDefault(
const evaluate::GenericExprWrapper &expr, const SemanticsContext &context) {
auto dynamicType{expr.v.GetType()};
return dynamicType.has_value() &&
dynamicType->kind ==
context.defaultKinds().GetDefaultKind(dynamicType->category);
}
bool ExprIsScalar(const evaluate::GenericExprWrapper &expr) {
return !(expr.v.Rank() > 0);
}

View file

@ -99,6 +99,8 @@ const Symbol *FindExternallyVisibleObject(
bool ExprHasTypeCategory(
const evaluate::GenericExprWrapper &expr, const common::TypeCategory &type);
bool ExprHasTypeKind(const evaluate::GenericExprWrapper &expr, int kind);
bool ExprTypeKindIsDefault(
const evaluate::GenericExprWrapper &expr, const SemanticsContext &context);
bool ExprIsScalar(const evaluate::GenericExprWrapper &expr);
}
#endif // FORTRAN_SEMANTICS_TOOLS_H_