Merge branch 'main' into common_interface_dunder

Author: DanBlackwell

flang-rt/lib/runtime/type-code.cpp

@@ -92,7 +92,7 @@ RT_API_ATTRS TypeCode::TypeCode(TypeCategory f, int kind) {
       raw_ = CFI_type_extended_double_Complex;
       break;
     case 16:
-      raw_ = CFI_type_long_double_Complex;
+      raw_ = CFI_type_float128_Complex;
       break;
     }
     break;

flang-rt/unittests/Runtime/CMakeLists.txt

@@ -40,6 +40,7 @@ add_flangrt_unittest(RuntimeTests
   Time.cpp
   TemporaryStack.cpp
   Transformational.cpp
+  TypeCode.cpp
 
   LINK_LIBS
     flang_rt.runtime.unittest

flang-rt/unittests/Runtime/TypeCode.cpp

@@ -0,0 +1,43 @@
+//===-- unittests/Runtime/TypeCode.cpp --------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "gtest/gtest.h"
+#include "flang-rt/runtime/type-code.h"
+
+using namespace Fortran::runtime;
+using namespace Fortran::common;
+
+TEST(TypeCode, ComplexTypes) {
+  // Test all Complex type kinds to ensure they map correctly
+  struct ComplexTypeMapping {
+    int kind;
+    Fortran::ISO::CFI_type_t expectedType;
+  };
+
+  ComplexTypeMapping mappings[] = {
+      {2, CFI_type_half_float_Complex},
+      {3, CFI_type_bfloat_Complex},
+      {4, CFI_type_float_Complex},
+      {8, CFI_type_double_Complex},
+      {10, CFI_type_extended_double_Complex},
+      {16, CFI_type_float128_Complex},
+  };
+
+  for (const auto &mapping : mappings) {
+    TypeCode tc(TypeCategory::Complex, mapping.kind);
+    EXPECT_EQ(tc.raw(), mapping.expectedType)
+        << "Complex kind " << mapping.kind << " should map to CFI type "
+        << mapping.expectedType;
+    EXPECT_TRUE(tc.IsComplex());
+
+    auto categoryAndKind = tc.GetCategoryAndKind();
+    ASSERT_TRUE(categoryAndKind.has_value());
+    EXPECT_EQ(categoryAndKind->first, TypeCategory::Complex);
+    EXPECT_EQ(categoryAndKind->second, mapping.kind);
+  }
+}

flang/lib/Lower/Bridge.cpp

@@ -4813,40 +4813,22 @@ class FirConverter : public Fortran::lower::AbstractConverter {
 
   // Generate pointer assignment with possibly empty bounds-spec. R1035: a
   // bounds-spec is a lower bound value.
-  void genPointerAssignment(
+  void genNoHLFIRPointerAssignment(
       mlir::Location loc, const Fortran::evaluate::Assignment &assign,
       const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
     Fortran::lower::StatementContext stmtCtx;
 
-    if (!lowerToHighLevelFIR() &&
-        Fortran::evaluate::IsProcedureDesignator(assign.rhs))
+    assert(!lowerToHighLevelFIR() && "code should not be called with HFLIR");
+    if (Fortran::evaluate::IsProcedureDesignator(assign.rhs))
       TODO(loc, "procedure pointer assignment");
-    if (Fortran::evaluate::IsProcedurePointer(assign.lhs)) {
-      hlfir::Entity lhs = Fortran::lower::convertExprToHLFIR(
-          loc, *this, assign.lhs, localSymbols, stmtCtx);
-      if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
-              assign.rhs)) {
-        // rhs is null(). rhs being null(pptr) is handled in genNull.
-        auto boxTy{
-            Fortran::lower::getUntypedBoxProcType(builder->getContext())};
-        hlfir::Entity rhs(
-            fir::factory::createNullBoxProc(*builder, loc, boxTy));
-        builder->createStoreWithConvert(loc, rhs, lhs);
-        return;
-      }
-      hlfir::Entity rhs(getBase(Fortran::lower::convertExprToAddress(
-          loc, *this, assign.rhs, localSymbols, stmtCtx)));
-      builder->createStoreWithConvert(loc, rhs, lhs);
-      return;
-    }
 
     std::optional<Fortran::evaluate::DynamicType> lhsType =
         assign.lhs.GetType();
     // Delegate pointer association to unlimited polymorphic pointer
     // to the runtime. element size, type code, attribute and of
     // course base_addr might need to be updated.
     if (lhsType && lhsType->IsPolymorphic()) {
-      if (!lowerToHighLevelFIR() && explicitIterationSpace())
+      if (explicitIterationSpace())
         TODO(loc, "polymorphic pointer assignment in FORALL");
       llvm::SmallVector<mlir::Value> lbounds;
       for (const Fortran::evaluate::ExtentExpr &lbExpr : lbExprs)
@@ -4873,7 +4855,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     llvm::SmallVector<mlir::Value> lbounds;
     for (const Fortran::evaluate::ExtentExpr &lbExpr : lbExprs)
       lbounds.push_back(fir::getBase(genExprValue(toEvExpr(lbExpr), stmtCtx)));
-    if (!lowerToHighLevelFIR() && explicitIterationSpace()) {
+    if (explicitIterationSpace()) {
       // Pointer assignment in FORALL context. Copy the rhs box value
       // into the lhs box variable.
       genArrayAssignment(assign, stmtCtx, lbounds);
@@ -4884,6 +4866,21 @@ class FirConverter : public Fortran::lower::AbstractConverter {
                                         stmtCtx);
   }
 
+  void genPointerAssignment(mlir::Location loc,
+                            const Fortran::evaluate::Assignment &assign) {
+    if (isInsideHlfirForallOrWhere()) {
+      // Generate Pointer assignment as hlfir.region_assign.
+      genForallPointerAssignment(loc, assign);
+      return;
+    }
+    Fortran::lower::StatementContext stmtCtx;
+    hlfir::Entity lhs = Fortran::lower::convertExprToHLFIR(
+        loc, *this, assign.lhs, localSymbols, stmtCtx);
+    mlir::Value rhs = genPointerAssignmentRhs(loc, lhs, assign, stmtCtx);
+    builder->createStoreWithConvert(loc, rhs, lhs);
+    cuf::genPointerSync(lhs, *builder);
+  }
+
   void genForallPointerAssignment(mlir::Location loc,
                                   const Fortran::evaluate::Assignment &assign) {
     // Lower pointer assignment inside forall with hlfir.region_assign with
@@ -4904,8 +4901,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     // Lower RHS in its own region.
     builder->createBlock(&regionAssignOp.getRhsRegion());
     Fortran::lower::StatementContext rhsContext;
-    mlir::Value rhs =
-        genForallPointerAssignmentRhs(loc, lhs, assign, rhsContext);
+    mlir::Value rhs = genPointerAssignmentRhs(loc, lhs, assign, rhsContext);
     auto rhsYieldOp = hlfir::YieldOp::create(*builder, loc, rhs);
     Fortran::lower::genCleanUpInRegionIfAny(
         loc, *builder, rhsYieldOp.getCleanup(), rhsContext);
@@ -4921,9 +4917,9 @@ class FirConverter : public Fortran::lower::AbstractConverter {
   }
 
   mlir::Value
-  genForallPointerAssignmentRhs(mlir::Location loc, mlir::Value lhs,
-                                const Fortran::evaluate::Assignment &assign,
-                                Fortran::lower::StatementContext &rhsContext) {
+  genPointerAssignmentRhs(mlir::Location loc, hlfir::Entity lhs,
+                          const Fortran::evaluate::Assignment &assign,
+                          Fortran::lower::StatementContext &rhsContext) {
     if (Fortran::evaluate::IsProcedureDesignator(assign.lhs)) {
       if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
               assign.rhs))
@@ -4935,11 +4931,34 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     // Data target.
     auto lhsBoxType =
         llvm::cast<fir::BaseBoxType>(fir::unwrapRefType(lhs.getType()));
-    // For NULL, create disassociated descriptor whose dynamic type is
-    // the static type of the LHS.
+    // For NULL, create disassociated descriptor whose dynamic type is the
+    // static type of the LHS (fulfills 7.3.2.3 requirements that the dynamic
+    // type of a deallocated polymorphic pointer is its static type).
     if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
-            assign.rhs))
-      return fir::factory::createUnallocatedBox(*builder, loc, lhsBoxType, {});
+            assign.rhs)) {
+      llvm::SmallVector<mlir::Value, 1> nonDeferredLenParams;
+      if (auto lhsVar =
+              llvm::dyn_cast_if_present<fir::FortranVariableOpInterface>(
+                  lhs.getDefiningOp()))
+        nonDeferredLenParams = lhsVar.getExplicitTypeParams();
+      if (isInsideHlfirForallOrWhere()) {
+        // Inside FORALL, the non deferred type parameters may only be
+        // accessible in the hlfir.region_assign lhs region if they were
+        // computed there.
+        for (mlir::Value &param : nonDeferredLenParams)
+          if (!param.getParentRegion()->isAncestor(
+                  builder->getBlock()->getParent())) {
+            if (llvm::isa_and_nonnull<mlir::arith::ConstantOp>(
+                    param.getDefiningOp()))
+              param = builder->clone(*param.getDefiningOp())->getResult(0);
+            else
+              TODO(loc, "Pointer assignment with non deferred type parameter "
+                        "inside FORALL");
+          }
+      }
+      return fir::factory::createUnallocatedBox(*builder, loc, lhsBoxType,
+                                                nonDeferredLenParams);
+    }
     hlfir::Entity rhs = Fortran::lower::convertExprToHLFIR(
         loc, *this, assign.rhs, localSymbols, rhsContext);
     auto rhsBoxType = rhs.getBoxType();
@@ -5032,9 +5051,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
 
   // Pointer assignment with bounds-remapping. R1036: a bounds-remapping is a
   // pair, lower bound and upper bound.
-  void genPointerAssignment(
+  void genNoHLFIRPointerAssignment(
       mlir::Location loc, const Fortran::evaluate::Assignment &assign,
       const Fortran::evaluate::Assignment::BoundsRemapping &boundExprs) {
+    assert(!lowerToHighLevelFIR() && "code should not be called with HFLIR");
     Fortran::lower::StatementContext stmtCtx;
     llvm::SmallVector<mlir::Value> lbounds;
     llvm::SmallVector<mlir::Value> ubounds;
@@ -5053,7 +5073,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     // Polymorphic lhs/rhs need more care. See F2018 10.2.2.3.
     if ((lhsType && lhsType->IsPolymorphic()) ||
         (rhsType && rhsType->IsPolymorphic())) {
-      if (!lowerToHighLevelFIR() && explicitIterationSpace())
+      if (explicitIterationSpace())
         TODO(loc, "polymorphic pointer assignment in FORALL");
 
       fir::MutableBoxValue lhsMutableBox = genExprMutableBox(loc, assign.lhs);
@@ -5071,7 +5091,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
               rhsType->IsPolymorphic());
       return;
     }
-    if (!lowerToHighLevelFIR() && explicitIterationSpace()) {
+    if (explicitIterationSpace()) {
       // Pointer assignment in FORALL context. Copy the rhs box value
       // into the lhs box variable.
       genArrayAssignment(assign, stmtCtx, lbounds, ubounds);
@@ -5083,13 +5103,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       fir::factory::disassociateMutableBox(*builder, loc, lhs);
       return;
     }
-    if (lowerToHighLevelFIR()) {
-      fir::ExtendedValue rhs = genExprAddr(assign.rhs, stmtCtx);
-      fir::factory::associateMutableBoxWithRemap(*builder, loc, lhs, rhs,
-                                                 lbounds, ubounds);
-      return;
-    }
-    // Legacy lowering below.
     // Do not generate a temp in case rhs is an array section.
     fir::ExtendedValue rhs =
         Fortran::lower::isArraySectionWithoutVectorSubscript(assign.rhs)
@@ -5479,18 +5492,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
                                   dirs);
               },
               [&](const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
-                if (isInsideHlfirForallOrWhere())
-                  genForallPointerAssignment(loc, assign);
-                else
-                  genPointerAssignment(loc, assign, lbExprs);
+                genPointerAssignment(loc, assign);
               },
               [&](const Fortran::evaluate::Assignment::BoundsRemapping
-                      &boundExprs) {
-                if (isInsideHlfirForallOrWhere())
-                  genForallPointerAssignment(loc, assign);
-                else
-                  genPointerAssignment(loc, assign, boundExprs);
-              },
+                      &boundExprs) { genPointerAssignment(loc, assign); },
           },
           assign.u);
       return;
@@ -5692,11 +5697,11 @@ class FirConverter : public Fortran::lower::AbstractConverter {
             },
 
             [&](const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
-              return genPointerAssignment(loc, assign, lbExprs);
+              return genNoHLFIRPointerAssignment(loc, assign, lbExprs);
             },
             [&](const Fortran::evaluate::Assignment::BoundsRemapping
                     &boundExprs) {
-              return genPointerAssignment(loc, assign, boundExprs);
+              return genNoHLFIRPointerAssignment(loc, assign, boundExprs);
             },
         },
         assign.u);

flang/lib/Optimizer/Builder/HLFIRTools.cpp

@@ -402,9 +402,9 @@ hlfir::Entity hlfir::genVariableBox(mlir::Location loc,
       fir::BoxType::get(var.getElementOrSequenceType(), isVolatile);
   if (forceBoxType) {
     boxType = forceBoxType;
-    mlir::Type baseType =
-        fir::ReferenceType::get(fir::unwrapRefType(forceBoxType.getEleTy()));
-    addr = builder.createConvert(loc, baseType, addr);
+    mlir::Type baseType = fir::ReferenceType::get(
+        fir::unwrapRefType(forceBoxType.getEleTy()), forceBoxType.isVolatile());
+    addr = builder.createConvertWithVolatileCast(loc, baseType, addr);
   }
   auto embox = fir::EmboxOp::create(builder, loc, boxType, addr, shape,
                                     /*slice=*/mlir::Value{}, typeParams);

flang/test/Lower/HLFIR/allocatable-and-pointer-status-change.f90

@@ -34,7 +34,7 @@ subroutine pointer_assignment(p, ziel)
 ! CHECK:  %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_5:[a-z0-9]*]]) dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {fortran_attrs = #fir.var_attrs<target>,  {{.*}}Eziel
   p => ziel
 ! CHECK:  %[[VAL_7:.*]] = fir.shift %[[VAL_4:.*]] : (index) -> !fir.shift<1>
-! CHECK:  %[[VAL_8:.*]] = fir.rebox %[[VAL_6]]#1(%[[VAL_7]]) : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK:  %[[VAL_8:.*]] = fir.rebox %[[VAL_6]]#0(%[[VAL_7]]) : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
 ! CHECK:  fir.store %[[VAL_8]] to %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
   p => ziel(42:77:3)
 ! CHECK:  %[[VAL_14:.*]] = hlfir.designate %{{.*}}#0 (%{{.*}}:%{{.*}}:%{{.*}})  shape %{{.*}} : (!fir.box<!fir.array<?xf32>>, index, index, index, !fir.shape<1>) -> !fir.box<!fir.array<12xf32>>
@@ -49,27 +49,29 @@ subroutine pointer_remapping(p, ziel)
 ! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {fortran_attrs = #fir.var_attrs<pointer>,  {{.*}}Ep
 ! CHECK:  %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_6:[a-z0-9]*]]) dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {fortran_attrs = #fir.var_attrs<target>,  {{.*}}Eziel
   p(2:7, 3:102) => ziel
-! CHECK:  %[[VAL_8:.*]] = arith.constant 2 : i64
-! CHECK:  %[[VAL_9:.*]] = arith.constant 7 : i64
-! CHECK:  %[[VAL_10:.*]] = arith.constant 3 : i64
-! CHECK:  %[[VAL_11:.*]] = arith.constant 102 : i64
-! CHECK:  %[[VAL_12:.*]] = arith.constant 1 : index
-! CHECK:  %[[VAL_13:.*]] = fir.convert %[[VAL_8]] : (i64) -> index
-! CHECK:  %[[VAL_14:.*]] = fir.convert %[[VAL_9]] : (i64) -> index
-! CHECK:  %[[VAL_15:.*]] = arith.subi %[[VAL_14]], %[[VAL_13]] : index
-! CHECK:  %[[VAL_16:.*]] = arith.addi %[[VAL_15]], %[[VAL_12]] : index
-! CHECK:  %[[cmp0:.*]] = arith.cmpi sgt, %[[VAL_16]], %c0{{.*}} : index
-! CHECK:  %[[ext0:.*]] = arith.select %[[cmp0]], %[[VAL_16]], %c0{{.*}} : index
-! CHECK:  %[[VAL_17:.*]] = fir.convert %[[VAL_10]] : (i64) -> index
-! CHECK:  %[[VAL_18:.*]] = fir.convert %[[VAL_11]] : (i64) -> index
-! CHECK:  %[[VAL_19:.*]] = arith.subi %[[VAL_18]], %[[VAL_17]] : index
-! CHECK:  %[[VAL_20:.*]] = arith.addi %[[VAL_19]], %[[VAL_12]] : index
-! CHECK:  %[[cmp1:.*]] = arith.cmpi sgt, %[[VAL_20]], %c0{{.*}} : index
-! CHECK:  %[[ext1:.*]] = arith.select %[[cmp1]], %[[VAL_20]], %c0{{.*}} : index
-! CHECK:  %[[VAL_21:.*]] = fir.convert %[[VAL_7]]#0 : (!fir.ref<!fir.array<10x20x30xf32>>) -> !fir.ref<!fir.array<?x?xf32>>
-! CHECK:  %[[VAL_22:.*]] = fir.shape_shift %[[VAL_8]], %[[ext0]], %[[VAL_10]], %[[ext1]] : (i64, index, i64, index) -> !fir.shapeshift<2>
-! CHECK:  %[[VAL_23:.*]] = fir.embox %[[VAL_21]](%[[VAL_22]]) : (!fir.ref<!fir.array<?x?xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
-! CHECK:  fir.store %[[VAL_23]] to %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+! CHECK:  %[[CONVERT_0:.*]] = fir.convert %[[VAL_7]]#0 : (!fir.ref<!fir.array<10x20x30xf32>>) -> !fir.ref<!fir.array<?x?x?xf32>>
+! CHECK:  %[[EMBOX_0:.*]] = fir.embox %[[CONVERT_0]](%[[VAL_6]]) : (!fir.ref<!fir.array<?x?x?xf32>>, !fir.shape<3>) -> !fir.box<!fir.ptr<!fir.array<?x?x?xf32>>>
+! CHECK:  %[[CONSTANT_3:.*]] = arith.constant 0 : index
+! CHECK:  %[[CONSTANT_4:.*]] = arith.constant 1 : index
+! CHECK:  %[[CONSTANT_5:.*]] = arith.constant 2 : i64
+! CHECK:  %[[CONVERT_1:.*]] = fir.convert %[[CONSTANT_5]] : (i64) -> index
+! CHECK:  %[[CONSTANT_6:.*]] = arith.constant 7 : i64
+! CHECK:  %[[CONVERT_2:.*]] = fir.convert %[[CONSTANT_6]] : (i64) -> index
+! CHECK:  %[[SUBI_0:.*]] = arith.subi %[[CONVERT_2]], %[[CONVERT_1]] : index
+! CHECK:  %[[ADDI_0:.*]] = arith.addi %[[SUBI_0]], %[[CONSTANT_4]] : index
+! CHECK:  %[[CMPI_0:.*]] = arith.cmpi sgt, %[[ADDI_0]], %[[CONSTANT_3]] : index
+! CHECK:  %[[SELECT_0:.*]] = arith.select %[[CMPI_0]], %[[ADDI_0]], %[[CONSTANT_3]] : index
+! CHECK:  %[[CONSTANT_7:.*]] = arith.constant 3 : i64
+! CHECK:  %[[CONVERT_3:.*]] = fir.convert %[[CONSTANT_7]] : (i64) -> index
+! CHECK:  %[[CONSTANT_8:.*]] = arith.constant 102 : i64
+! CHECK:  %[[CONVERT_4:.*]] = fir.convert %[[CONSTANT_8]] : (i64) -> index
+! CHECK:  %[[SUBI_1:.*]] = arith.subi %[[CONVERT_4]], %[[CONVERT_3]] : index
+! CHECK:  %[[ADDI_1:.*]] = arith.addi %[[SUBI_1]], %[[CONSTANT_4]] : index
+! CHECK:  %[[CMPI_1:.*]] = arith.cmpi sgt, %[[ADDI_1]], %[[CONSTANT_3]] : index
+! CHECK:  %[[SELECT_1:.*]] = arith.select %[[CMPI_1]], %[[ADDI_1]], %[[CONSTANT_3]] : index
+! CHECK:  %[[SHAPE_SHIFT_0:.*]] = fir.shape_shift %[[CONVERT_1]], %[[SELECT_0]], %[[CONVERT_3]], %[[SELECT_1]] : (index, index, index, index) -> !fir.shapeshift<2>
+! CHECK:  %[[REBOX_0:.*]] = fir.rebox %[[EMBOX_0]](%[[SHAPE_SHIFT_0]]) : (!fir.box<!fir.ptr<!fir.array<?x?x?xf32>>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+! CHECK:  fir.store %[[REBOX_0]] to %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
 end subroutine
 
 subroutine alloc_comp(x)
@@ -109,7 +111,7 @@ subroutine ptr_comp_assign(x, ziel)
 ! CHECK:  %[[VAL_8:.*]] = arith.constant 9 : index
 ! CHECK:  %[[VAL_9:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_8]])  : (!fir.ref<!fir.array<10x!fir.type<_QFptr_comp_assignTt{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>, index) -> !fir.ref<!fir.type<_QFptr_comp_assignTt{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>
 ! CHECK:  %[[VAL_10:.*]] = hlfir.designate %[[VAL_9]]{"p"}   {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QFptr_comp_assignTt{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
-! CHECK:  %[[VAL_11:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
-! CHECK:  %[[VAL_12:.*]] = fir.embox %[[VAL_7]]#0(%[[VAL_11]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK:  %[[CAST:.*]] = fir.convert %[[VAL_7]]#0 : (!fir.ref<!fir.array<100xf32>>) -> !fir.ref<!fir.array<?xf32>>
+! CHECK:  %[[VAL_12:.*]] = fir.embox %[[CAST]](%[[VAL_6]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
 ! CHECK:  fir.store %[[VAL_12]] to %[[VAL_10]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
 end subroutine