[flang] Fix volatile attribute propagation on allocatables

flang/lib/Lower/Bridge.cpp

@@ -3842,6 +3842,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     bool hasLocalScope = false;
     llvm::SmallVector<const Fortran::semantics::Scope *> typeCaseScopes;
 
+    const auto selectorIsVolatile = [&selector]() {
+      return fir::isa_volatile_type(fir::getBase(selector).getType());
+    };
+
     const auto &typeCaseList =
         std::get<std::list<Fortran::parser::SelectTypeConstruct::TypeCase>>(
             selectTypeConstruct.t);
@@ -3995,7 +3999,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
             addrTy = fir::HeapType::get(addrTy);
           if (std::holds_alternative<Fortran::parser::IntrinsicTypeSpec>(
                   typeSpec->u)) {
-            mlir::Type refTy = fir::ReferenceType::get(addrTy);
+            mlir::Type refTy =
+                fir::ReferenceType::get(addrTy, selectorIsVolatile());
             if (isPointer || isAllocatable)
               refTy = addrTy;
             exactValue = builder->create<fir::BoxAddrOp>(
@@ -4004,7 +4009,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
                 typeSpec->declTypeSpec->AsIntrinsic();
             if (isArray) {
               mlir::Value exact = builder->create<fir::ConvertOp>(
-                  loc, fir::BoxType::get(addrTy), fir::getBase(selector));
+                  loc, fir::BoxType::get(addrTy, selectorIsVolatile()),
+                  fir::getBase(selector));
               addAssocEntitySymbol(selectorBox->clone(exact));
             } else if (intrinsic->category() ==
                        Fortran::common::TypeCategory::Character) {
@@ -4019,7 +4025,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
           } else if (std::holds_alternative<Fortran::parser::DerivedTypeSpec>(
                          typeSpec->u)) {
             exactValue = builder->create<fir::ConvertOp>(
-                loc, fir::BoxType::get(addrTy), fir::getBase(selector));
+                loc, fir::BoxType::get(addrTy, selectorIsVolatile()),
+                fir::getBase(selector));
             addAssocEntitySymbol(selectorBox->clone(exactValue));
           }
         } else if (std::holds_alternative<Fortran::parser::DerivedTypeSpec>(
@@ -4037,7 +4044,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
             addrTy = fir::PointerType::get(addrTy);
           if (isAllocatable)
             addrTy = fir::HeapType::get(addrTy);
-          mlir::Type classTy = fir::ClassType::get(addrTy);
+          mlir::Type classTy =
+              fir::ClassType::get(addrTy, selectorIsVolatile());
           if (classTy == baseTy) {
             addAssocEntitySymbol(selector);
           } else {

flang/lib/Optimizer/Dialect/FIROps.cpp

@@ -1536,20 +1536,50 @@ bool fir::ConvertOp::canBeConverted(mlir::Type inType, mlir::Type outType) {
          areRecordsCompatible(inType, outType);
 }
 
+// In general, ptrtoint-like conversions are allowed to lose volatility
+// information because they are either:
+//
+// 1. passing an entity to an external function and there's nothing we can do
+//    about volatility after that happens, or
+// 2. for code generation, at which point we represent volatility with
+//    attributes on the LLVM instructions and intrinsics.
+//
+// For all other cases, volatility ought to match exactly.
+static mlir::LogicalResult verifyVolatility(mlir::Type inType,
+                                            mlir::Type outType) {
+  const bool toLLVMPointer = mlir::isa<mlir::LLVM::LLVMPointerType>(outType);
+  const bool toInteger = fir::isa_integer(outType);
+
+  // When converting references to classes or allocatables into boxes for
+  // runtime arguments, we cast away all the volatility information and pass a
+  // box<none>. This is allowed.
+  const bool isBoxNoneLike = [&]() {
+    if (fir::isBoxNone(outType))
+      return true;
+    if (auto referenceType = mlir::dyn_cast<fir::ReferenceType>(outType)) {
+      if (fir::isBoxNone(referenceType.getElementType())) {
+        return true;
+      }
+    }
+    return false;
+  }();
+
+  const bool isPtrToIntLike = toLLVMPointer || toInteger || isBoxNoneLike;
+  if (isPtrToIntLike) {
+    return mlir::success();
+  }
+
+  // In all other cases, we need to check for an exact volatility match.
+  return mlir::success(fir::isa_volatile_type(inType) ==
+                       fir::isa_volatile_type(outType));
+}
+
 llvm::LogicalResult fir::ConvertOp::verify() {
   mlir::Type inType = getValue().getType();
   mlir::Type outType = getType();
-  // If we're converting to an LLVM pointer type or an integer, we don't
-  // need to check for volatility mismatch - volatility will be handled by the
-  // memory operations themselves in llvm code generation and ptr-to-int can't
-  // represent volatility.
-  const bool toLLVMPointer = mlir::isa<mlir::LLVM::LLVMPointerType>(outType);
-  const bool toInteger = fir::isa_integer(outType);
   if (fir::useStrictVolatileVerification()) {
-    if (fir::isa_volatile_type(inType) != fir::isa_volatile_type(outType) &&
-        !toLLVMPointer && !toInteger) {
-      return emitOpError("cannot convert between volatile and non-volatile "
-                         "types, use fir.volatile_cast instead ")
+    if (failed(verifyVolatility(inType, outType))) {
+      return emitOpError("this conversion does not preserve volatility: ")
              << inType << " / " << outType;
     }
   }

flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp

@@ -207,29 +207,37 @@ static bool hasExplicitLowerBounds(mlir::Value shape) {
          mlir::isa<fir::ShapeShiftType, fir::ShiftType>(shape.getType());
 }
 
-static std::pair<mlir::Type, mlir::Value> updateDeclareInputTypeWithVolatility(
-    mlir::Type inputType, mlir::Value memref, mlir::OpBuilder &builder,
-    fir::FortranVariableFlagsAttr fortran_attrs) {
-  if (fortran_attrs &&
-      bitEnumContainsAny(fortran_attrs.getFlags(),
-                         fir::FortranVariableFlagsEnum::fortran_volatile)) {
-    const bool isPointer = bitEnumContainsAny(
-        fortran_attrs.getFlags(), fir::FortranVariableFlagsEnum::pointer);
-    auto updateType = [&](auto t) {
-      using FIRT = decltype(t);
-      // A volatile pointer's pointee is volatile.
-      auto elementType = t.getEleTy();
-      const bool elementTypeIsVolatile =
-          isPointer || fir::isa_volatile_type(elementType);
-      auto newEleTy =
-          fir::updateTypeWithVolatility(elementType, elementTypeIsVolatile);
-      inputType = FIRT::get(newEleTy, true);
-    };
-    llvm::TypeSwitch<mlir::Type>(inputType)
-        .Case<fir::ReferenceType, fir::BoxType, fir::ClassType>(updateType);
-    memref =
-        builder.create<fir::VolatileCastOp>(memref.getLoc(), inputType, memref);
+static std::pair<mlir::Type, mlir::Value>
+updateDeclaredInputTypeWithVolatility(mlir::Type inputType, mlir::Value memref,
+                                      mlir::OpBuilder &builder,
+                                      fir::FortranVariableFlagsEnum flags) {
+  if (!bitEnumContainsAny(flags,
+                          fir::FortranVariableFlagsEnum::fortran_volatile)) {
+    return std::make_pair(inputType, memref);
   }
+
+  // A volatile pointer's pointee is volatile.
+  const bool isPointer =
+      bitEnumContainsAny(flags, fir::FortranVariableFlagsEnum::pointer);
+  // An allocatable's inner type's volatility matches that of the reference.
+  const bool isAllocatable =
+      bitEnumContainsAny(flags, fir::FortranVariableFlagsEnum::allocatable);
+
+  auto updateType = [&](auto t) {
+    using FIRT = decltype(t);
+    auto elementType = t.getEleTy();
+    const bool elementTypeIsBox = mlir::isa<fir::BaseBoxType>(elementType);
+    const bool elementTypeIsVolatile = isPointer || isAllocatable ||
+                                       elementTypeIsBox ||
+                                       fir::isa_volatile_type(elementType);
+    auto newEleTy =
+        fir::updateTypeWithVolatility(elementType, elementTypeIsVolatile);
+    inputType = FIRT::get(newEleTy, true);
+  };
+  llvm::TypeSwitch<mlir::Type>(inputType)
+      .Case<fir::ReferenceType, fir::BoxType, fir::ClassType>(updateType);
+  memref =
+      builder.create<fir::VolatileCastOp>(memref.getLoc(), inputType, memref);
   return std::make_pair(inputType, memref);
 }
 
@@ -243,8 +251,11 @@ void hlfir::DeclareOp::build(mlir::OpBuilder &builder,
   auto nameAttr = builder.getStringAttr(uniq_name);
   mlir::Type inputType = memref.getType();
   bool hasExplicitLbs = hasExplicitLowerBounds(shape);
-  std::tie(inputType, memref) = updateDeclareInputTypeWithVolatility(
-      inputType, memref, builder, fortran_attrs);
+  if (fortran_attrs) {
+    const auto flags = fortran_attrs.getFlags();
+    std::tie(inputType, memref) = updateDeclaredInputTypeWithVolatility(
+        inputType, memref, builder, flags);
+  }
   mlir::Type hlfirVariableType =
       getHLFIRVariableType(inputType, hasExplicitLbs);
   build(builder, result, {hlfirVariableType, inputType}, memref, shape,

flang/lib/Optimizer/Transforms/PolymorphicOpConversion.cpp

@@ -401,10 +401,14 @@ llvm::LogicalResult SelectTypeConv::genTypeLadderStep(
     {
       // Since conversion is done in parallel for each fir.select_type
       // operation, the runtime function insertion must be threadsafe.
+      auto runtimeAttr =
+          mlir::NamedAttribute(fir::FIROpsDialect::getFirRuntimeAttrName(),
+                               mlir::UnitAttr::get(rewriter.getContext()));
       callee =
           fir::createFuncOp(rewriter.getUnknownLoc(), mod, fctName,
                             rewriter.getFunctionType({descNoneTy, typeDescTy},
-                                                     rewriter.getI1Type()));
+                                                     rewriter.getI1Type()),
+                            {runtimeAttr});
     }
     cmp = rewriter
               .create<fir::CallOp>(loc, callee,

flang/test/Fir/invalid.fir

@@ -1260,7 +1260,7 @@ func.func @dc_invalid_reduction(%arg0: index, %arg1: index) {
 
 // Should fail when volatility changes from a fir.convert
 func.func @bad_convert_volatile(%arg0: !fir.ref<i32>) -> !fir.ref<i32, volatile> {
-  // expected-error@+1 {{'fir.convert' op cannot convert between volatile and non-volatile types, use fir.volatile_cast instead}}
+  // expected-error@+1 {{op this conversion does not preserve volatility}}
   %0 = fir.convert %arg0 : (!fir.ref<i32>) -> !fir.ref<i32, volatile>
   return %0 : !fir.ref<i32, volatile>
 }
@@ -1269,7 +1269,7 @@ func.func @bad_convert_volatile(%arg0: !fir.ref<i32>) -> !fir.ref<i32, volatile>
 
 // Should fail when volatility changes from a fir.convert
 func.func @bad_convert_volatile2(%arg0: !fir.ref<i32, volatile>) -> !fir.ref<i32> {
-  // expected-error@+1 {{'fir.convert' op cannot convert between volatile and non-volatile types, use fir.volatile_cast instead}}
+  // expected-error@+1 {{op this conversion does not preserve volatility}}
   %0 = fir.convert %arg0 : (!fir.ref<i32, volatile>) -> !fir.ref<i32>
   return %0 : !fir.ref<i32>
 }