[flang-commits] [flang] [flang] Extension: TRANSFER(boz, integer or real scalar) (PR #147604)

[Peter Klausler via flang-commits]

https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/147604

>From 9dca92c88e565b007e125414086c7c8a8dec8d5b Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Tue, 8 Jul 2025 15:17:16 -0700
Subject: [PATCH] [flang] Extension: TRANSFER(boz, integer or real scalar)

Interpret TRANSFER(SOURCE=BOZ literal, MOLD=integer or real scalar)
as if it had been a reference to the standard INT or REAL intrinsic
functions, for which a BOZ literal is an acceptable argument, with
a warning about non-conformance.  It's a needless extension that
has somehow crept into some other compilers and real applications.
---
 flang/docs/Extensions.md                      |  2 ++
 .../include/flang/Support/Fortran-features.h  |  3 ++-
 flang/lib/Evaluate/fold.cpp                   | 10 ++++++++++
 flang/lib/Evaluate/intrinsics.cpp             |  9 +++++++++
 flang/lib/Support/Fortran-features.cpp        |  1 +
 flang/test/Evaluate/transfer-boz.f90          | 19 +++++++++++++++++++
 6 files changed, 43 insertions(+), 1 deletion(-)
 create mode 100644 flang/test/Evaluate/transfer-boz.f90

diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 37a49f12f9177..72d12cd92600d 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -252,6 +252,8 @@ end
   the type resolution of such BOZ literals usages is highly non portable).
 * BOZ literals can also be used as REAL values in some contexts where the
   type is unambiguous, such as initializations of REAL parameters.
+* `TRANSFER(boz, MOLD=integer or real scalar)` is accepted as an alternate
+  spelling of `INT(boz, KIND=kind(mold))` or `REAL(boz, KIND=kind(mold))`.
 * EQUIVALENCE of numeric and character sequences (a ubiquitous extension),
   as well as of sequences of non-default kinds of numeric types
   with each other.
diff --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h
index 857de9479e4e5..743abf606ab5f 100644
--- a/flang/include/flang/Support/Fortran-features.h
+++ b/flang/include/flang/Support/Fortran-features.h
@@ -55,7 +55,8 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     SavedLocalInSpecExpr, PrintNamelist, AssumedRankPassedToNonAssumedRank,
     IgnoreIrrelevantAttributes, Unsigned, AmbiguousStructureConstructor,
     ContiguousOkForSeqAssociation, ForwardRefExplicitTypeDummy,
-    InaccessibleDeferredOverride, CudaWarpMatchFunction, DoConcurrentOffload)
+    InaccessibleDeferredOverride, CudaWarpMatchFunction, DoConcurrentOffload,
+    TransferBOZ)
 
 // Portability and suspicious usage warnings
 ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp
index 45e842abf589f..71ead1b3afa91 100644
--- a/flang/lib/Evaluate/fold.cpp
+++ b/flang/lib/Evaluate/fold.cpp
@@ -287,6 +287,16 @@ std::optional<Expr<SomeType>> FoldTransfer(
         CHECK(status == InitialImage::NotAConstant);
       }
     }
+  } else if (source && moldType) {
+    if (const auto *boz{std::get_if<BOZLiteralConstant>(&source->u)}) {
+      // TRANSFER(BOZ, MOLD=integer or real) extension
+      if (context.languageFeatures().ShouldWarn(
+              common::LanguageFeature::TransferBOZ)) {
+        context.messages().Say(common::LanguageFeature::TransferBOZ,
+            "TRANSFER(BOZ literal) is not standard"_port_en_US);
+      }
+      return Fold(context, ConvertToType(*moldType, Expr<SomeType>{*boz}));
+    }
   }
   return std::nullopt;
 }
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index e802915945e26..4773e136c41cb 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1015,6 +1015,15 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
             {"mold", SameType, Rank::anyOrAssumedRank},
             {"size", AnyInt, Rank::scalar}},
         SameType, Rank::vector, IntrinsicClass::transformationalFunction},
+    // TRANSFER(BOZ, MOLD=integer or real scalar) extension
+    {"transfer",
+        {{"source", AnyNumeric, Rank::elementalOrBOZ},
+            {"mold", SameInt, Rank::scalar}},
+        SameInt, Rank::scalar, IntrinsicClass::transformationalFunction},
+    {"transfer",
+        {{"source", AnyNumeric, Rank::elementalOrBOZ},
+            {"mold", SameReal, Rank::scalar}},
+        SameReal, Rank::scalar, IntrinsicClass::transformationalFunction},
     {"transpose", {{"matrix", SameType, Rank::matrix}}, SameType, Rank::matrix,
         IntrinsicClass::transformationalFunction},
     {"trim", {{"string", SameCharNoLen, Rank::scalar}}, SameCharNoLen,
diff --git a/flang/lib/Support/Fortran-features.cpp b/flang/lib/Support/Fortran-features.cpp
index fc69fc638eda1..df51b3c577125 100644
--- a/flang/lib/Support/Fortran-features.cpp
+++ b/flang/lib/Support/Fortran-features.cpp
@@ -103,6 +103,7 @@ LanguageFeatureControl::LanguageFeatureControl() {
   warnLanguage_.set(LanguageFeature::ListDirectedSize);
   warnLanguage_.set(LanguageFeature::IgnoreIrrelevantAttributes);
   warnLanguage_.set(LanguageFeature::AmbiguousStructureConstructor);
+  warnLanguage_.set(LanguageFeature::TransferBOZ);
   warnUsage_.set(UsageWarning::ShortArrayActual);
   warnUsage_.set(UsageWarning::FoldingException);
   warnUsage_.set(UsageWarning::FoldingAvoidsRuntimeCrash);
diff --git a/flang/test/Evaluate/transfer-boz.f90 b/flang/test/Evaluate/transfer-boz.f90
new file mode 100644
index 0000000000000..584cf318a2818
--- /dev/null
+++ b/flang/test/Evaluate/transfer-boz.f90
@@ -0,0 +1,19 @@
+!RUN: %flang_fc1 -fdebug-unparse %s | FileCheck %s
+
+!CHECK: portability: TRANSFER(BOZ literal) is not standard [-Wtransfer-boz]
+!CHECK: portability: TRANSFER(BOZ literal) is not standard [-Wtransfer-boz]
+!CHECK: portability: TRANSFER(BOZ literal) is not standard [-Wtransfer-boz]
+!CHECK: portability: TRANSFER(BOZ literal) is not standard [-Wtransfer-boz]
+!CHECK: portability: TRANSFER(BOZ literal) is not standard [-Wtransfer-boz]
+!CHECK: PRINT *, -17_1
+!CHECK: PRINT *, -16657_2
+!CHECK: PRINT *, -559038737_4
+!CHECK: PRINT *, -6.259853398707798016e18_4
+!CHECK: PRINT *, 1.8457939563190925445492984919045437485528002903297587499184927815557801644025850059853181797614625558939883606558067941052215743386077465406508281130260792904117042434297523782789810991060595088402505831985608687099349932384478542748214418349497866218005870896526832696740683567118136284392505567470522678176873737470272665943917715636680452977840047387616237048162886116765806372690690621665407240253312632381089695794498069551496558727944808752442655077077609749137334421734380446229972733723471196114034171513283476953482396960122117078210644171413215132537631249069125441199719426016512325803207900875869312966829207468856964517085119314095898691593840972164432952065765882286023532502465793032567186884340163939544586513274992967126308940351009368896484375e-314_8
+
+print *, transfer(z'deadbeef', 1_1)
+print *, transfer(z'deadbeef', 1_2)
+print *, transfer(z'deadbeef', 1_4)
+print *, transfer(z'deadbeef', 1._4)
+print *, transfer(z'deadbeef', 1._8)
+end