[flang-commits] [flang] [Flang][OpenMP] Support declare reduction without initializer (PR #196211)

[Tom Eccles via flang-commits]

================
@@ -4119,18 +4119,95 @@ static ReductionProcessor::GenCombinerCBTy processReductionCombiner(
   return genCombinerCB;
 }
 
-// Checks that the reduction type is either a trivial type or a derived type of
-// trivial types.
+/// Recursively initialize components of a derived type variable inline.
+/// For each component:
+///   - If it has an explicit default initializer, use that value.
+///   - If it is itself a derived type with default component initialization,
+///     recurse into its sub-components.
+///   - Otherwise, zero-initialize.
+/// This avoids calling _FortranAInitialize (which is not fully supported  on
+/// GPU)
+static void initializeRecordTypeComponents(
+    lower::AbstractConverter &converter, fir::FirOpBuilder &builder,
+    mlir::Location loc, const semantics::DerivedTypeSpec *derivedTypeSpec,
+    mlir::Type type, mlir::Value baseRef, lower::StatementContext &stmtCtx) {
+  mlir::Type derivedTy = fir::unwrapRefType(type);
+  if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(derivedTy))
+    derivedTy = seqTy.getEleTy();
+  auto recTy = mlir::dyn_cast<fir::RecordType>(derivedTy);
+  assert(recTy && "expected RecordType after unwrapping derived type");
+
+  const semantics::Scope *scope = derivedTypeSpec->GetScope();
+  const auto &typeDetails =
+      derivedTypeSpec->typeSymbol().get<semantics::DerivedTypeDetails>();
+
+  for (const auto &compName : typeDetails.componentNames()) {
+    auto it = scope->find(compName);
+    if (it == scope->end())
+      continue;
+    const semantics::Symbol &comp = it->second.get();
+    std::string name = converter.getRecordTypeFieldName(comp);
+    mlir::Type compType = recTy.getType(name);
+    if (!compType)
+      continue;
+
+    auto fieldTy = fir::FieldType::get(builder.getContext());
+    auto field = fir::FieldIndexOp::create(builder, loc, fieldTy, name, recTy,
+                                           /*typeParams=*/mlir::ValueRange{});
+    auto compRef = fir::CoordinateOp::create(
+        builder, loc, builder.getRefType(compType), baseRef, field.getResult());
+
+    mlir::Value initVal;
+    if (const auto *obj = comp.detailsIf<semantics::ObjectEntityDetails>()) {
+      if (const auto &init = obj->init()) {
+        initVal = fir::getBase(converter.genExprValue(loc, *init, stmtCtx));
+        if (auto refTy = mlir::dyn_cast<fir::ReferenceType>(initVal.getType()))
+          if (refTy.getEleTy() == compType)
+            initVal = fir::LoadOp::create(builder, loc, initVal);
+      } else if (const auto *compDeclType = comp.GetType()) {
+        // Component has no explicit initializer, but its type may have
+        // default component initialization (e.g., type(Point):: center
+        // where Point has x=0.0, y=5.0). Recurse.
+        if (const auto *compDerivedSpec = compDeclType->AsDerived()) {
+          if (compDerivedSpec->HasDefaultInitialization(
+                  /*ignoreAllocatable=*/false, /*ignorePointer=*/true)) {
+            initializeRecordTypeComponents(converter, builder, loc,
+                                           compDerivedSpec, compType, compRef,
+                                           stmtCtx);
+            continue;
+          }
+        }
+      }
+    }
+    // Components without explicit default initialization are technically
+    // undefined in Fortran.  We zero-initialize them rather than leaving
+    // them uninitialized, which is safer for GPU reduction private copies
+    // and consistent with common Fortran implementation practice.
+    if (!initVal)
+      initVal = fir::ZeroOp::create(builder, loc, compType);
+
+    initVal = builder.createConvert(loc, compType, initVal);
+    fir::StoreOp::create(builder, loc, initVal, compRef);
+  }
+}
+
+// Checks that the reduction type is either a trivial type, a fixed-length
+// character type, or a derived type composed of such types.
 static bool isSimpleReductionType(mlir::Type reductionType) {
   if (fir::isa_trivial(reductionType))
     return true;
+  // Fixed-length CHARACTER is not trivial but can be zero-initialized.
+  if (mlir::isa<fir::CharacterType>(reductionType))
+    return true;
----------------
tblah wrote:

Dynamic CHARACTER is not handled correctly. This reproducer leads to an assertion failure:
```
subroutine dyn_char(s, n)
  integer, intent(in) :: n
  character(len=n) :: s
  integer :: i

  !$omp declare reduction(char_max: character(len=n): omp_out = max(omp_out, omp_in))

  !$omp parallel do reduction(char_max: s)
  do i = 1, 4
    s = s
  end do
end subroutine
```

If it is not going to be supported for now then it should be a TODO message

https://github.com/llvm/llvm-project/pull/196211