From f5cca3c5ce7a1a6d9934e22c60e47ccd1834cf99 Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval@gmail.com>
Date: Thu, 16 Feb 2023 20:59:54 +0100
Subject: [PATCH] [flang] Handle expression in SELECT TYPE selector

Expression in selector were raising an error. In some
cases expression can be found in selector. This patch
updates the code to accept expression and adds a lowering
test.

Reviewed By: PeteSteinfeld, vdonaldson

Differential Revision: https://reviews.llvm.org/D144185
---
 flang/lib/Lower/Bridge.cpp       |  5 ++---
 flang/test/Lower/select-type.f90 | 33 ++++++++++++++++++++++++++++++++-
 2 files changed, 34 insertions(+), 4 deletions(-)

diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 717bdec..0a2cf3c 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -2203,9 +2203,8 @@ private:
         const auto &s = std::get<Fortran::parser::Selector>(selectTypeStmt->t);
         if (const auto *v = std::get_if<Fortran::parser::Variable>(&s.u))
           selector = genExprBox(loc, *Fortran::semantics::GetExpr(*v), stmtCtx);
-        else
-          fir::emitFatalError(
-              loc, "selector with expr not expected in select type statement");
+        else if (const auto *e = std::get_if<Fortran::parser::Expr>(&s.u))
+          selector = genExprBox(loc, *Fortran::semantics::GetExpr(*e), stmtCtx);
 
         // Going through the controlSuccessor first to create the
         // fir.select_type operation.
diff --git a/flang/test/Lower/select-type.f90 b/flang/test/Lower/select-type.f90
index b585185..3463cda 100644
--- a/flang/test/Lower/select-type.f90
+++ b/flang/test/Lower/select-type.f90
@@ -19,11 +19,25 @@ module select_type_lower_test
     integer :: d
   end type
 
+  type :: p5
+    integer :: a
+  contains
+    procedure :: negate
+    generic :: operator(-) => negate
+  end type
+
 contains
 
   function get_class()
     class(p1), pointer :: get_class
   end function
+
+  function negate(this)
+    class(p5), intent(in) :: this
+    class(p5), allocatable :: negate
+    allocate(negate, source=this)
+    negate%a = -this%a
+  end function
   
   subroutine select_type1(a)
     class(p1), intent(in) :: a
@@ -772,7 +786,24 @@ contains
 
   ! Just makes sure the example can be lowered.
   ! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type14
-   
+
+  subroutine select_type15(a)
+    class(p5) :: a
+
+    select type(x => -a)
+      type is (p5)
+        print*, x%a
+    end select
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type15(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMselect_type_lower_testTp5{a:i32}>> {fir.bindc_name = "a"}) {
+! CHECK: %[[RES:.*]] = fir.alloca !fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>> {bindc_name = ".result"}
+! CHECK: %[[TMP_RES:.*]] = fir.dispatch "negate"(%[[ARG0]] : !fir.class<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>) (%[[ARG0]] : !fir.class<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>) -> !fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>> {pass_arg_pos = 0 : i32}
+! CHECK: fir.save_result %[[TMP_RES]] to %[[RES]] : !fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>>, !fir.ref<!fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>>>
+! CHECK: %[[LOAD_RES:.*]] = fir.load %[[RES]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>>>
+! CHECK: fir.select_type %[[LOAD_RES]] : !fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>> [#fir.type_is<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>, ^bb1, unit, ^bb2]
+
 end module
 
 program test_select_type
-- 
2.7.4