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

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.

Author: klausler

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.

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,

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;
 }

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,

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);

flang/test/Evaluate/transfer-boz.f90

@@ -0,0 +1,19 @@
+!RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | 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