[flang-dev] [Semantic][Select Rank] Semantic checks fails with fatal internal error

[sameeran joshi via flang-dev]

Hi Community,
I am trying to implement semantic checks for Select Rank (R1148) Construct.
I tried successfully C1150 constraint implementation.

For C1151 I am facing an issue as below,
$ f18 negative_rank.F90 -fdebug-semantics

fatal internal error: CHECK(x) failed at
~/Workspace/tool-chain/F18/f18/lib/semantics/tools.h(213)
Aborted (core dumped)

Debugging with GDB shows core dump in
GetIntValue(*i) Function, where the value of variable i, I suppose is
not an expression, which causes it to fail in
CHECK(x): in lib/semantics/tools.h

1)
Is there somthing fundamental I am missing in below function?
void ConstructVisitor::Post(const parser::SelectRankConstruct &)

2)
Is void ConstructVisitor::Post(const parser::SelectRankCaseStmt::Rank
&) a more appropriate function to do C1151 checks?

Below is the attached patch and program.

Thanks,
Sameeran

+++++++++++++++++++
program
+++++++++++++++++++
$ cat negative_rank.F90
program rank_new
    implicit none
    integer, DIMENSION(3) :: array
   call CALL_ME(array)
   contains
   SUBROUTINE CALL_ME(x)
    integer :: x(..)    !ASSUMED RANK ARRAY should be a dummy argument
for subrotine
   SELECT RANK(x)
         RANK (3)
            print *, "one"
         RANK (2)
            print *, "two"
         rank(*)
            print *, "rank:"
    END SELECT
END SUBROUTINE
end program
+++++++++++++++++++++++
Patch
+++++++++++++++++++++++
diff --git a/lib/semantics/resolve-names.cc b/lib/semantics/resolve-names.cc
index c779a891..fe81f2c6 100644
--- a/lib/semantics/resolve-names.cc
+++ b/lib/semantics/resolve-names.cc
@@ -43,7 +43,7 @@
 #include <ostream>
 #include <set>
 #include <stack>
-
+#include <iostream>
 namespace Fortran::semantics {

 using namespace parser::literals;
@@ -957,6 +957,7 @@ public:
   bool Pre(const parser::SelectTypeConstruct::TypeCase &);
   void Post(const parser::SelectTypeConstruct::TypeCase &);
   void Post(const parser::TypeGuardStmt::Guard &);
+  void Post(const parser::SelectRankCaseStmt::Rank &);
   bool Pre(const parser::ChangeTeamStmt &);
   void Post(const parser::EndChangeTeamStmt &);
   void Post(const parser::CoarrayAssociation &);
@@ -976,6 +977,7 @@ public:
   bool Pre(const parser::SelectRankStmt &x) {
     return CheckDef(std::get<0>(x.t));
   }
+  void Post(const parser::SelectRankStmt &);
   bool Pre(const parser::SelectTypeStmt &x) {
     return CheckDef(std::get<0>(x.t));
   }
@@ -4898,6 +4900,24 @@ bool ConstructVisitor::Pre(const
parser::SelectTypeConstruct &) {
 void ConstructVisitor::Post(const parser::SelectTypeConstruct &) {
   PopAssociation();
 }
+void ConstructVisitor::Post(const parser::SelectRankStmt &x){
+  auto &association{GetCurrentAssociation()};
+  if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) {
+    MakePlaceholder(*name, MiscDetails::Kind::SelectTypeAssociateName);
+    association.name = &*name;
+  }
+  else {
+    if (const Symbol *
+        whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) {
+      ConvertToObjectEntity(const_cast<Symbol &>(*whole));
+      if (!IsAssumedRankArray(*whole)) {
+        Say(association.selector.source,  // C1150
+            "Selector is not an assumed rank variable"_err_en_US);
+        association = {};
+      }
+    }
+  }
+}

 void ConstructVisitor::Post(const parser::SelectTypeStmt &x) {
   auto &association{GetCurrentAssociation()};
@@ -4940,14 +4960,55 @@ void ConstructVisitor::Post(const
parser::TypeGuardStmt::Guard &x) {
     SetAttrsFromAssociation(*symbol);
   }
 }
-
+void ConstructVisitor::Post(const parser::SelectRankCaseStmt::Rank &){
+/*	if (auto *symbol{MakeAssocEntity()}) {
+//		if (std::holds_alternative<parser::ScalarIntConstantExpr>(x.u)) {
+//				      SetTypeFromAssociation(*symbol);
+//			
+//			const auto &i{std::get<parser::ScalarIntConstantExpr>(x.u)};
+//			if (const auto v{GetIntValue(i)}){
+//				std::cout << "\nV is " << *v;
+//			if (*v<0){
+//				Say("-ve values not allowed"_err_en_US);
+//			}
+//			}
+//			else{
+//					std::cout << "\nInelse";
+//
+//			}
+//		}
+//	}
+*/	
+}
 bool ConstructVisitor::Pre(const parser::SelectRankConstruct &) {
   PushAssociation();
   return true;
 }

 void ConstructVisitor::Post(const parser::SelectRankConstruct &) {
+  auto &values{std::get<std::list<parser::SelectRankConstruct::RankCase>>(x.t)};
+  for (const auto &rankcase_:values){
+ const auto &SelectRankCaseStmt_{
+	std::get<parser::Statement<parser::SelectRankCaseStmt>>(rankcase_.t)};
+        const auto
&Rank_{std::get<parser::SelectRankCaseStmt::Rank>(SelectRankCaseStmt_.statement.t)};
+
+// Retriving the construct-name is successful
+//	if (const auto
&name_{std::get<std::optional<parser::Name>>(SelectRankCaseStmt_.statement.t)}){
+//	std::cout << "\nNAME:" <<name_->source;
+//
+//
+	if ( const auto *i{std::get_if<parser::ScalarIntConstantExpr>(&Rank_.u)} ) {
+	                        if (const auto v{GetIntValue(*i)}){
+        	                        std::cout << "\nRANK  is " << *v;
+					//Do negative and beyond max possible permissible range checks
+				}
+	}
+	else{
+		 std::cout << "\nEnter default or *";
+	}
+  }
   PopAssociation();
+
 }

 bool ConstructVisitor::CheckDef(const std::optional<parser::Name> &x) {
diff --git a/lib/semantics/tools.h b/lib/semantics/tools.h
index 2aa94fa7..07169937 100644
--- a/lib/semantics/tools.h
+++ b/lib/semantics/tools.h
@@ -128,6 +128,11 @@ inline bool IsAssumedSizeArray(const Symbol &symbol) {
   const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
   return details && details->IsAssumedSize();
 }
+inline bool IsAssumedRankArray(const Symbol &symbol) {
+  const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
+  return details && details->IsAssumedRank();
+}
+
 bool IsAssumedLengthCharacter(const Symbol &);
 bool IsAssumedLengthCharacterFunction(const Symbol &);
 // Is the symbol modifiable in this scope