[flang] Fix SELECT TYPE lowering when CLASS DEFAULT is not the last type guard

[clementval]

Summary

CLASS DEFAULT needs to be the last attribute when fir.select_type op is created.
It needs to be at its actual position in the Fortran code when the TypeGuardStmt
are processed. The current lowering was crashing when CLASS DEFAULT was not at
the last position.
This patch fixes the issue by tracking the actual position of the CLASS DEFAULT
type guard and set it at the correct position after the fir.select_type op
is created.

[jeanPerier]

LGTM, I think the bot failure is unrelated.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Lower/Bridge.cpp

   void genFIR(const Fortran::parser::SelectTypeConstruct &selectTypeConstruct) {
     mlir::Location loc = toLocation();
     mlir::MLIRContext *context = builder->getContext();
     Fortran::lower::StatementContext stmtCtx;
     fir::ExtendedValue selector;
     llvm::SmallVector<mlir::Attribute> attrList;
     llvm::SmallVector<mlir::Block *> blockList;
     unsigned typeGuardIdx = 0;
+    std::size_t defaultAttrPos = std::numeric_limits<size_t>::max();
     bool hasLocalScope = false;
 
     for (Fortran::lower::pft::Evaluation &eval :
          getEval().getNestedEvaluations()) {
       if (auto *selectTypeStmt =
               eval.getIf<Fortran::parser::SelectTypeStmt>()) {
         // A genFIR(SelectTypeStmt) call would have unwanted side effects.
         maybeStartBlock(eval.block);
for (Fortran::lower::pft::Evaluation &eval :
           const auto &typeGuardStmt =
               e->getIf<Fortran::parser::TypeGuardStmt>();
           const auto &guard =
               std::get<Fortran::parser::TypeGuardStmt::Guard>(typeGuardStmt->t);
           assert(e->block && "missing TypeGuardStmt block");
           // CLASS DEFAULT
           if (std::holds_alternative<Fortran::parser::Default>(guard.u)) {
             defaultBlock = e->block;
+            // Keep track of the actual position of the CLASS DEFAULT type guard
+            // in the SELECT TYPE construct.
+            defaultAttrPos = attrList.size();
             continue;
           }
 
           blockList.push_back(e->block);
           if (const auto *typeSpec =
                   std::get_if<Fortran::parser::TypeSpec>(&guard.u)) {
             // TYPE IS
             mlir::Type ty;
for (Fortran::lower::pft::Evaluation &eval :
             mlir::Type ty = genType(*(derived->derivedTypeSpec));
             attrList.push_back(fir::SubclassAttr::get(ty));
           }
         }
         attrList.push_back(mlir::UnitAttr::get(context));
         blockList.push_back(defaultBlock);
         builder->create<fir::SelectTypeOp>(loc, fir::getBase(selector),
                                            attrList, blockList);
+
+        // If the actual position of CLASS DEFAULT type guard is not the last
+        // one, it needs to be put back at its correct position for the rest of
+        // the processing. TypeGuardStmt are processed in the same order they
+        // appear in the Fortran code.
+        if (defaultAttrPos < attrList.size() - 1) {
+          auto attrIt = attrList.begin();
+          attrIt = attrIt + defaultAttrPos;
+          auto blockIt = blockList.begin();
+          blockIt = blockIt + defaultAttrPos;
+          attrList.insert(attrIt, mlir::UnitAttr::get(context));
+          blockList.insert(blockIt, defaultBlock);
+          attrList.pop_back();
+          blockList.pop_back();
+        }
       } else if (auto *typeGuardStmt =
                      eval.getIf<Fortran::parser::TypeGuardStmt>()) {
         // Map the type guard local symbol for the selector to a more precise
         // typed entity in the TypeGuardStmt when necessary.
         genFIR(eval);
         const auto &guard =
             std::get<Fortran::parser::TypeGuardStmt::Guard>(typeGuardStmt->t);
         if (hasLocalScope)

flang/test/Lower/select-type.f90

 ! CHECK:  %[[SHIFT:.*]] = fir.shift %[[BOX_DIMS]]#0 : (index) -> !fir.shift<1>
 ! CHECK:  %[[SELECTOR:.*]] = fir.rebox %[[LOAD]](%[[SHIFT]]) : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>, !fir.shift<1>) -> !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>
 ! CHECK:  fir.select_type %[[SELECTOR]] : !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> [#fir.type_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb1, #fir.type_is<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>, ^bb2, #fir.class_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb3, unit, ^bb4]
 ! CHECK: ^bb{{.*}}:
 ! CHECK:  %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>
 ! CHECK: ^bb{{.*}}:  // pred: ^bb0
 ! CHECK:  %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>
 
+
+  ! Test correct lowering when CLASS DEFAULT is not at the last position in the
+  ! SELECT TYPE construct.
+  subroutine select_type13(a)
+    class(p1), pointer :: a(:)
+    select type (a)
+      class default
+        print*, 'default'
+      class is (p1)
+        print*, 'class'
+    end select
+
+    select type (a)
+      type is (p1)
+        print*, 'type'
+      class default
+        print*, 'default'
+      class is (p1)
+        print*, 'class'
+    end select
+
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type13
+! CHECK: fir.select_type %{{.*}} : !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> [#fir.class_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb2, unit, ^bb1]
+! CHECK: ^bb1:
+! CHECK: ^bb2:
+! CHECK: ^bb3:
+! CHECK: fir.select_type %{{.*}} : !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> [#fir.type_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb4, #fir.class_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb6, unit, ^bb5]
+! CHECK: ^bb4:
+! CHECK: ^bb5:
+! CHECK: ^bb6:
+! CHECK: ^bb7:
+
 end module
 
 program test_select_type
   use select_type_lower_test
 
   integer :: a
   integer :: arr(2)
   real :: b