From ec322c9588460893f5fe6f493694b739d27f3d4d Mon Sep 17 00:00:00 2001 From: Paul Osmialowski Date: Thu, 11 Apr 2019 21:25:45 +0100 Subject: [PATCH] [flang] Semantics checker for STOP and ERROR STOP statements - ExprTypeKindIsDefault added to the tools Signed-off-by: Paul Osmialowski Original-commit: flang-compiler/f18@669b05b27d7ad5bee6689507d40199e941838b9a Reviewed-on: https://github.com/flang-compiler/f18/pull/367 Tree-same-pre-rewrite: false --- flang/lib/semantics/check-stop.cc | 8 ++------ flang/lib/semantics/tools.cc | 9 +++++++++ flang/lib/semantics/tools.h | 2 ++ 3 files changed, 13 insertions(+), 6 deletions(-) diff --git a/flang/lib/semantics/check-stop.cc b/flang/lib/semantics/check-stop.cc index cfcfac6..69b7cb9 100644 --- a/flang/lib/semantics/check-stop.cc +++ b/flang/lib/semantics/check-stop.cc @@ -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); } diff --git a/flang/lib/semantics/tools.cc b/flang/lib/semantics/tools.cc index 8c1a2ce..d62d05d 100644 --- a/flang/lib/semantics/tools.cc +++ b/flang/lib/semantics/tools.cc @@ -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); } diff --git a/flang/lib/semantics/tools.h b/flang/lib/semantics/tools.h index 5093301..5dfee2f 100644 --- a/flang/lib/semantics/tools.h +++ b/flang/lib/semantics/tools.h @@ -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_ -- 2.7.4