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 8a2b7b29a5233..1fb4ebc9d9a4b 100644 --- a/flang/include/flang/Support/Fortran-features.h +++ b/flang/include/flang/Support/Fortran-features.h @@ -55,7 +55,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines, SavedLocalInSpecExpr, PrintNamelist, AssumedRankPassedToNonAssumedRank, IgnoreIrrelevantAttributes, Unsigned, AmbiguousStructureConstructor, ContiguousOkForSeqAssociation, ForwardRefExplicitTypeDummy, - InaccessibleDeferredOverride, CudaWarpMatchFunction) + InaccessibleDeferredOverride, CudaWarpMatchFunction, 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> FoldTransfer( CHECK(status == InitialImage::NotAConstant); } } + } else if (source && moldType) { + if (const auto *boz{std::get_if(&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{*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