diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp
index 49d711f69f413..5ca04cbcc633e 100644
--- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp
+++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp
@@ -1568,6 +1568,26 @@ struct EmboxCommonConversion : public FIROpConversion<OP> {
     // information.
     auto [eleSize, cfiTy] = getSizeAndTypeCode(
         loc, rewriter, useInputType ? inputType : boxTy.getEleTy(), typeparams);
+
+    // When emboxing a fir.ref<none> to an unlimited polymorphic box, get the
+    // type code and element size from the box used to extract the type desc.
+    if (fir::isUnlimitedPolymorphicType(boxTy) &&
+        inputType.isa<mlir::NoneType>() && typeDesc) {
+      if (auto *typeDescOp = typeDesc.getDefiningOp()) {
+        if (auto loadOp = mlir::dyn_cast<mlir::LLVM::LoadOp>(typeDescOp)) {
+          if (auto *gepOp = loadOp.getAddr().getDefiningOp()) {
+            if (auto gep = mlir::dyn_cast<mlir::LLVM::GEPOp>(gepOp)) {
+              mlir::Type idxTy = this->lowerTy().indexType();
+              eleSize = this->loadElementSizeFromBox(loc, idxTy, gep.getBase(),
+                                                     rewriter);
+              cfiTy = this->getValueFromBox(loc, gep.getBase(), cfiTy.getType(),
+                                            rewriter, kTypePosInBox);
+            }
+          }
+        }
+      }
+    }
+
     auto mod = box->template getParentOfType<mlir::ModuleOp>();
     mlir::Value descriptor = populateDescriptor(
         loc, mod, boxTy, inputType, rewriter, rank, eleSize, cfiTy, typeDesc);
diff --git a/flang/test/Fir/polymorphic.fir b/flang/test/Fir/polymorphic.fir
index 68b4cbbfc9cf1..d85fd6daa1cbd 100644
--- a/flang/test/Fir/polymorphic.fir
+++ b/flang/test/Fir/polymorphic.fir
@@ -68,6 +68,40 @@ func.func @_QMpolymorphic_testPtest_embox() {
 // CHECK: %[[LOADED_DESC:.*]] = load { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] }, ptr %[[ALLOCA_DESC]], align 8
 // CHECK: store { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] } %[[LOADED_DESC]], ptr @_QFEx, align 8
 
+// Test emboxing of an array element from an unlimited polymorphic array.
+
+func.func @_QMunlimitedPsub1(%arg0: !fir.class<!fir.array<?xnone>> {fir.bindc_name = "a"}) {
+  %c1_i64 = arith.constant 1 : i64
+  %c1_i64_0 = arith.constant 1 : i64
+  %0 = arith.subi %c1_i64, %c1_i64_0 : i64
+  %1 = fir.coordinate_of %arg0, %0 : (!fir.class<!fir.array<?xnone>>, i64) -> !fir.ref<none>
+  %2 = fir.box_tdesc %arg0 : (!fir.class<!fir.array<?xnone>>) -> !fir.tdesc<none>
+  %3 = fir.embox %1 tdesc %2 : (!fir.ref<none>, !fir.tdesc<none>) -> !fir.class<none>
+  fir.select_type %3 : !fir.class<none> [#fir.type_is<i32>, ^bb1, unit, ^bb2]
+^bb1:
+  %4 = fir.box_addr %3 : (!fir.class<none>) -> !fir.ref<i32>
+  %c10_i32 = arith.constant 10 : i32
+  fir.store %c10_i32 to %4 : !fir.ref<i32>
+  cf.br ^bb2
+^bb2:  // 2 preds: ^bb0, ^bb1
+  return
+}
+
+// CHECK-LABEL: define void @_QMunlimitedPsub1(
+// CHECK-SAME: ptr %[[ARRAY:.*]]) {
+// CHECK: %[[BOX:.*]] = alloca { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }
+// CHECK: %[[TYPE_DESC_GEP:.*]] = getelementptr { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] }, ptr %[[ARRAY]], i32 0, i32 8
+// CHECK: %[[TYPE_DESC:.*]] = load ptr, ptr %[[TYPE_DESC_GEP]]
+// CHECK: %[[ELE_SIZE_GEP:.*]] = getelementptr { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] }, ptr %0, i32 0, i32 1
+// CHECK: %[[ELE_SIZE:.*]] = load i64, ptr %[[ELE_SIZE_GEP]]
+// CHECK: %[[TYPE_CODE_GEP:.*]] = getelementptr { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] }, ptr %0, i32 0, i32 4
+// CHECK: %[[TYPE_CODE:.*]] = load i32, ptr %[[TYPE_CODE_GEP]]
+// CHECK: %{{.*}} = insertvalue { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } undef, i64 %[[ELE_SIZE]], 1
+// CHECK: %[[TYPE_CODE_TRUNC:.*]] = trunc i32 %[[TYPE_CODE]] to i8
+// CHECK: %{{.*}} = insertvalue { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %{{.*}}, i8 %[[TYPE_CODE_TRUNC]], 4
+// CHECK: %{{.*}} = insertvalue { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %{{.*}}, ptr %[[TYPE_DESC]], 7
+// CHECK: store { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %24, ptr %[[BOX]]
+
 
 fir.global internal @_QFEx : !fir.class<!fir.ptr<!fir.array<?xnone>>> {
   %0 = fir.zero_bits !fir.ptr<!fir.array<?xnone>>
@@ -89,3 +123,4 @@ fir.global linkonce @_QQcl.2E2F64756D6D792E66393000 constant : !fir.char<1,12> {
   %0 = fir.string_lit "./dummy.f90\00"(12) : !fir.char<1,12>
   fir.has_value %0 : !fir.char<1,12>
 }
+