[flang] Semantics checker for STOP and ERROR STOP statements - remove overhead checks...

Signed-off-by: Paul Osmialowski <pawel.osmialowski@arm.com>
Original-commit: flang-compiler/f18@6ce6234acc5dbed42fbacc111be075810f65c554
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 575b63a..5021d6b 100644 (file)
--- a/flang/lib/semantics/check-stop.cc
+++ b/flang/lib/semantics/check-stop.cc
@@ -24,48 +24,26 @@ namespace Fortran::semantics {
 
 void StopChecker::Enter(const parser::StopStmt &stmt) {
   const auto &stopCode{std::get<std::optional<parser::StopCode>>(stmt.t)};
-  const auto &scalarLogicalExpr{
-      std::get<std::optional<parser::ScalarLogicalExpr>>(stmt.t)};
 
   if (stopCode.has_value()) {
     const parser::CharBlock &source{stopCode.value().v.thing.source};
     const auto &expr{*(stopCode.value().v.thing.typedExpr)};
 
-    if (!(ExprIsScalar(expr))) {
-      context_.Say(source, "Stop code must be a scalar"_err_en_US);
-    } else {
-      if (ExprHasTypeCategory(expr, common::TypeCategory::Integer)) {
-        // C1171 default kind
-        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 (!(ExprTypeKindIsDefault(expr, context_))) {
-          context_.Say(
-              source, "Character stop code must be of default kind"_err_en_US);
-        }
-      } else {
+    if (ExprHasTypeCategory(expr, common::TypeCategory::Integer)) {
+      // C1171 default kind
+      if (!(ExprTypeKindIsDefault(expr, context_))) {
         context_.Say(
-            source, "Stop code must be of INTEGER or CHARACTER type"_err_en_US);
+            source, "Integer stop code must be of default kind"_err_en_US);
       }
-    }
-  }
-  if (scalarLogicalExpr.has_value()) {
-    const parser::CharBlock &source{
-        scalarLogicalExpr.value().thing.thing.value().source};
-    const auto &expr{
-        *(scalarLogicalExpr.value().thing.thing.value().typedExpr)};
-
-    if (!(ExprIsScalar(expr))) {
-      context_.Say(source,
-          "The optional QUIET parameter value must be a scalar"_err_en_US);
-    } else {
-      if (!(ExprHasTypeCategory(expr, common::TypeCategory::Logical))) {
-        context_.Say(source,
-            "The optional QUIET parameter value must be of LOGICAL type"_err_en_US);
+    } else if (ExprHasTypeCategory(expr, common::TypeCategory::Character)) {
+      // R1162 spells scalar-DEFAULT-char-expr
+      if (!(ExprTypeKindIsDefault(expr, context_))) {
+        context_.Say(
+            source, "Character stop code must be of default kind"_err_en_US);
       }
+    } else {
+      context_.Say(
+          source, "Stop code must be of INTEGER or CHARACTER type"_err_en_US);
     }
   }
 }

diff --git a/flang/test/semantics/stop01.f90 b/flang/test/semantics/stop01.f90
index 6027e91..51b9c57 100644 (file)
--- a/flang/test/semantics/stop01.f90
+++ b/flang/test/semantics/stop01.f90
@@ -36,21 +36,9 @@ program main
   if (i .eq. 0) stop 1 + 2
   if (i .eq. 0) stop i
   if (i .eq. 0) stop p_i
-!ERROR: Stop code must be a scalar
-  if (i .eq. 0) stop p_iarray
   if (i .eq. 0) stop p_iarray(1)
-!ERROR: Stop code must be a scalar
-  if (i .eq. 0) stop p_iarray(1:4)
-!ERROR: Stop code must be a scalar
-  if (i .eq. 0) stop iarray
   if (i .eq. 0) stop iarray(1)
-!ERROR: Stop code must be a scalar
-  if (i .eq. 0) stop iarray(1:4)
-!ERROR: Stop code must be a scalar
-  if (i .eq. 0) stop aiarray
   if (i .eq. 0) stop aiarray(1)
-!ERROR: Stop code must be a scalar
-  if (i .eq. 0) stop aiarray(1:4)
   if (i .eq. 0) stop 1 + i
 !ERROR: Integer stop code must be of default kind
   if (i .eq. 0) stop invalid
@@ -60,17 +48,7 @@ program main
   if (i .eq. 0) stop 2, quiet = .false.
   if (i .eq. 0) stop 3, quiet = l
   if (i .eq. 0) stop 3, quiet = .not. l
-!ERROR: The optional QUIET parameter value must be a scalar
-  if (i .eq. 0) stop 3, quiet = larray
   if (i .eq. 0) stop 3, quiet = larray(1)
-!ERROR: The optional QUIET parameter value must be a scalar
-  if (i .eq. 0) stop 3, quiet = larray(1:4)
-!ERROR: The optional QUIET parameter value must be a scalar
-  if (i .eq. 0) stop 3, quiet = alarray
-!ERROR: The optional QUIET parameter value must be of LOGICAL type
-  if (i .eq. 0) stop 1, quiet = "Quiet."
-!ERROR: The optional QUIET parameter value must be of LOGICAL type
-  if (i .eq. 0) stop 1, quiet = "Quiet."(1:4)
   if (i .eq. 0) stop , quiet = .false.
   if (i .eq. 0) error stop "Error."
   if (i .eq. 0) error stop chr1
@@ -79,21 +57,9 @@ program main
   if (i .eq. 0) error stop 1
   if (i .eq. 0) error stop i
   if (i .eq. 0) error stop p_i
-!ERROR: Stop code must be a scalar
-  if (i .eq. 0) error stop p_iarray
   if (i .eq. 0) error stop p_iarray(1)
-!ERROR: Stop code must be a scalar
-  if (i .eq. 0) error stop p_iarray(1:4)
-!ERROR: Stop code must be a scalar
-  if (i .eq. 0) error stop iarray
   if (i .eq. 0) error stop iarray(1)
-!ERROR: Stop code must be a scalar
-  if (i .eq. 0) error stop iarray(1:4)
-!ERROR: Stop code must be a scalar
-  if (i .eq. 0) error stop aiarray
   if (i .eq. 0) error stop aiarray(1)
-!ERROR: Stop code must be a scalar
-  if (i .eq. 0) error stop aiarray(1:4)
   if (i .eq. 0) error stop 1 + i
 !ERROR: Integer stop code must be of default kind
   if (i .eq. 0) error stop invalid
@@ -103,17 +69,7 @@ program main
   if (i .eq. 0) error stop 2, quiet = .false.
   if (i .eq. 0) error stop 3, quiet = l
   if (i .eq. 0) error stop 3, quiet = .not. l
-!ERROR: The optional QUIET parameter value must be a scalar
-  if (i .eq. 0) error stop 3, quiet = larray
   if (i .eq. 0) error stop 3, quiet = larray(1)
-!ERROR: The optional QUIET parameter value must be a scalar
-  if (i .eq. 0) error stop 3, quiet = larray(1:4)
-!ERROR: The optional QUIET parameter value must be a scalar
-  if (i .eq. 0) error stop 3, quiet = alarray
-!ERROR: The optional QUIET parameter value must be of LOGICAL type
-  if (i .eq. 0) error stop 1, quiet = "Quiet."
-!ERROR: The optional QUIET parameter value must be of LOGICAL type
-  if (i .eq. 0) error stop 1, quiet = "Quiet."(1:4)
   if (i .eq. 0) error stop , quiet = .false.
   stop
 end program