[flang] Semantics checker for STOP and ERROR STOP statements - ExprTypeKindIsDefault...

Signed-off-by: Paul Osmialowski <pawel.osmialowski@arm.com>
Original-commit: flang-compiler/f18@669b05b27d7ad5bee6689507d40199e941838b9a
Reviewed-on: https://github.com/flang-compiler/f18/pull/367
Tree-same-pre-rewrite: false

diff --git a/flang/lib/semantics/check-stop.cc b/flang/lib/semantics/check-stop.cc
index cfcfac6..69b7cb9 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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_