[flang-commits] [PATCH] D86961: [flang] Fix integer CASE constant typing

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added reviewers: sscalpone, PeteSteinfeld.
klausler added a project: Flang.
Herald added a reviewer: jdoerfert.
Herald added a reviewer: DavidTruby.
Herald added a project: LLVM.
Herald added a subscriber: llvm-commits.
klausler requested review of this revision.

Don't use just 128-bit integer as the type for integer
CASE statement constants.  Use the actual type of the
literal constants that appeared.


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D86961

Files:
  flang/lib/Semantics/check-case.cpp
  flang/test/Semantics/case01.f90


Index: flang/test/Semantics/case01.f90
===================================================================
--- flang/test/Semantics/case01.f90
+++ flang/test/Semantics/case01.f90
@@ -135,11 +135,11 @@
      case (40)
      case (90)
      case (91:99)
-     !ERROR: CASE (81_16:90_16) conflicts with previous cases
+     !ERROR: CASE (81_4:90_4) conflicts with previous cases
      case (81:90)
-     !ERROR: CASE (:80_16) conflicts with previous cases
+     !ERROR: CASE (:80_4) conflicts with previous cases
      case (:80)
-     !ERROR: CASE (200_16) conflicts with previous cases
+     !ERROR: CASE (200_4) conflicts with previous cases
      case (200)
      case default
   end select
Index: flang/lib/Semantics/check-case.cpp
===================================================================
--- flang/lib/Semantics/check-case.cpp
+++ flang/lib/Semantics/check-case.cpp
@@ -9,6 +9,7 @@
 #include "check-case.h"
 #include "flang/Common/idioms.h"
 #include "flang/Common/reference.h"
+#include "flang/Common/template.h"
 #include "flang/Evaluate/fold.h"
 #include "flang/Evaluate/type.h"
 #include "flang/Parser/parse-tree.h"
@@ -201,6 +202,22 @@
   bool hasErrors_{false};
 };
 
+template <TypeCategory CAT> struct TypeVisitor {
+  using Result = bool;
+  using Types = evaluate::CategoryTypes<CAT>;
+  template <typename T> Result Test() {
+    if (T::kind == exprType.kind()) {
+      CaseValues<T>(context, exprType).Check(caseList);
+      return true;
+    } else {
+      return false;
+    }
+  }
+  SemanticsContext &context;
+  const evaluate::DynamicType &exprType;
+  const std::list<parser::CaseConstruct::Case> &caseList;
+};
+
 void CaseChecker::Enter(const parser::CaseConstruct &construct) {
   const auto &selectCaseStmt{
       std::get<parser::Statement<parser::SelectCaseStmt>>(construct.t)};
@@ -216,32 +233,17 @@
         std::get<std::list<parser::CaseConstruct::Case>>(construct.t)};
     switch (exprType->category()) {
     case TypeCategory::Integer:
-      CaseValues<evaluate::Type<TypeCategory::Integer, 16>>{context_, *exprType}
-          .Check(caseList);
+      common::SearchTypes(
+          TypeVisitor<TypeCategory::Integer>{context_, *exprType, caseList});
       return;
     case TypeCategory::Logical:
       CaseValues<evaluate::Type<TypeCategory::Logical, 1>>{context_, *exprType}
           .Check(caseList);
       return;
     case TypeCategory::Character:
-      switch (exprType->kind()) {
-        SWITCH_COVERS_ALL_CASES
-      case 1:
-        CaseValues<evaluate::Type<TypeCategory::Character, 1>>{
-            context_, *exprType}
-            .Check(caseList);
-        return;
-      case 2:
-        CaseValues<evaluate::Type<TypeCategory::Character, 2>>{
-            context_, *exprType}
-            .Check(caseList);
-        return;
-      case 4:
-        CaseValues<evaluate::Type<TypeCategory::Character, 4>>{
-            context_, *exprType}
-            .Check(caseList);
-        return;
-      }
+      common::SearchTypes(
+          TypeVisitor<TypeCategory::Character>{context_, *exprType, caseList});
+      return;
     default:
       break;
     }


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D86961.289214.patch
Type: text/x-patch
Size: 3135 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20200901/36cd54a5/attachment.bin>