forked from OSchip/llvm-project
[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:
parent
54068ddbca
commit
ec322c9588
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -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_
|
||||
|
|
Loading…
Reference in New Issue