[flang-commits] [flang] 9d33874 - [flang] Support -f[no-]realloc-lhs. (#120165)
via flang-commits
flang-commits at lists.llvm.org
Tue Dec 17 09:06:09 PST 2024
Author: Slava Zakharin
Date: 2024-12-17T09:06:05-08:00
New Revision: 9d33874936d83b8ddf5d028d313d810214f00f20
URL: https://github.com/llvm/llvm-project/commit/9d33874936d83b8ddf5d028d313d810214f00f20
DIFF: https://github.com/llvm/llvm-project/commit/9d33874936d83b8ddf5d028d313d810214f00f20.diff
LOG: [flang] Support -f[no-]realloc-lhs. (#120165)
-frealloc-lhs is the default.
If -fno-realloc-lhs is specified, then an allocatable on the left
side of an intrinsic assignment is not implicitly (re)allocated
to conform with the right hand side. Fortran runtime will issue
an error if there is a mismatch in shape/type/allocation-status.
Added:
flang/test/Driver/frealloc-lhs.f90
flang/test/Lower/reallocate-lhs.f90
Modified:
clang/include/clang/Driver/Options.td
clang/lib/Driver/ToolChains/Flang.cpp
flang/include/flang/Lower/LoweringOptions.def
flang/lib/Frontend/CompilerInvocation.cpp
flang/lib/Lower/Bridge.cpp
flang/tools/bbc/bbc.cpp
Removed:
################################################################################
diff --git a/clang/include/clang/Driver/Options.td b/clang/include/clang/Driver/Options.td
index bed2a56b003512..7b544d2534d469 100644
--- a/clang/include/clang/Driver/Options.td
+++ b/clang/include/clang/Driver/Options.td
@@ -3463,6 +3463,9 @@ defm diagnostics_show_line_numbers : BoolFOption<"diagnostics-show-line-numbers"
NegFlag<SetFalse, [], [ClangOption, CC1Option],
"Show line numbers in diagnostic code snippets">,
PosFlag<SetTrue>>;
+def fno_realloc_lhs : Flag<["-"], "fno-realloc-lhs">, Group<f_Group>,
+ HelpText<"An allocatable left-hand side of an intrinsic assignment is assumed to be allocated and match the shape/type of the right-hand side">,
+ Visibility<[FlangOption, FC1Option]>;
def fno_stack_protector : Flag<["-"], "fno-stack-protector">, Group<f_Group>,
HelpText<"Disable the use of stack protectors">;
def fno_strict_aliasing : Flag<["-"], "fno-strict-aliasing">, Group<f_Group>,
@@ -4296,6 +4299,9 @@ defm stack_size_section : BoolFOption<"stack-size-section",
PosFlag<SetTrue, [], [ClangOption, CC1Option],
"Emit section containing metadata on function stack sizes">,
NegFlag<SetFalse>>;
+def frealloc_lhs : Flag<["-"], "frealloc-lhs">, Group<f_Group>,
+ Visibility<[FlangOption, FC1Option]>,
+ HelpText<"If an allocatable left-hand side of an intrinsic assignment is unallocated or its shape/type does not match the right-hand side, then it is automatically (re)allocated">;
def fstack_usage : Flag<["-"], "fstack-usage">, Group<f_Group>,
HelpText<"Emit .su file containing information on function stack sizes">;
def stack_usage_file : Separate<["-"], "stack-usage-file">,
@@ -6775,7 +6781,6 @@ defm real_4_real_8 : BooleanFFlag<"real-4-real-8">, Group<gfortran_Group>;
defm real_8_real_10 : BooleanFFlag<"real-8-real-10">, Group<gfortran_Group>;
defm real_8_real_16 : BooleanFFlag<"real-8-real-16">, Group<gfortran_Group>;
defm real_8_real_4 : BooleanFFlag<"real-8-real-4">, Group<gfortran_Group>;
-defm realloc_lhs : BooleanFFlag<"realloc-lhs">, Group<gfortran_Group>;
defm recursive : BooleanFFlag<"recursive">, Group<gfortran_Group>;
defm repack_arrays : BooleanFFlag<"repack-arrays">, Group<gfortran_Group>;
defm second_underscore : BooleanFFlag<"second-underscore">, Group<gfortran_Group>;
diff --git a/clang/lib/Driver/ToolChains/Flang.cpp b/clang/lib/Driver/ToolChains/Flang.cpp
index c98fdbd157bac8..8cffa20c4a2d36 100644
--- a/clang/lib/Driver/ToolChains/Flang.cpp
+++ b/clang/lib/Driver/ToolChains/Flang.cpp
@@ -55,7 +55,9 @@ void Flang::addFortranDialectOptions(const ArgList &Args,
options::OPT_fdefault_double_8,
options::OPT_flarge_sizes,
options::OPT_fno_automatic,
- options::OPT_fhermetic_module_files});
+ options::OPT_fhermetic_module_files,
+ options::OPT_frealloc_lhs,
+ options::OPT_fno_realloc_lhs});
}
void Flang::addPreprocessingOptions(const ArgList &Args,
diff --git a/flang/include/flang/Lower/LoweringOptions.def b/flang/include/flang/Lower/LoweringOptions.def
index 0b22e54b648e94..5a6debfdffe030 100644
--- a/flang/include/flang/Lower/LoweringOptions.def
+++ b/flang/include/flang/Lower/LoweringOptions.def
@@ -38,5 +38,11 @@ ENUM_LOWERINGOPT(Underscoring, unsigned, 1, 1)
/// (i.e. wraps around as two's complement). Off by default.
ENUM_LOWERINGOPT(IntegerWrapAround, unsigned, 1, 0)
+/// If true (default), follow Fortran 2003 rules for (re)allocating
+/// the allocatable on the left side of the intrinsic assignment,
+/// if LHS and RHS have mismatching shapes/types.
+/// If false, assume that the shapes/types/allocation-status match.
+ENUM_LOWERINGOPT(ReallocateLHS, unsigned, 1, 1)
+
#undef LOWERINGOPT
#undef ENUM_LOWERINGOPT
diff --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp
index 648b88e84051c2..6ef4ee8721ee46 100644
--- a/flang/lib/Frontend/CompilerInvocation.cpp
+++ b/flang/lib/Frontend/CompilerInvocation.cpp
@@ -1378,6 +1378,11 @@ bool CompilerInvocation::createFromArgs(
invoc.getDiagnosticOpts().Remarks.push_back(a->getValue());
}
+ // -frealloc-lhs is the default.
+ if (!args.hasFlag(clang::driver::options::OPT_frealloc_lhs,
+ clang::driver::options::OPT_fno_realloc_lhs, true))
+ invoc.loweringOpts.setReallocateLHS(false);
+
success &= parseFrontendArgs(invoc.getFrontendOpts(), args, diags);
parseTargetArgs(invoc.getTargetOpts(), args);
parsePreprocessorArgs(invoc.getPreprocessorOpts(), args);
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index de2b941b688bee..0650433dbaf394 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -4461,7 +4461,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
// lowered.
const bool isWholeAllocatableAssignment =
!userDefinedAssignment && !isInsideHlfirWhere() &&
- Fortran::lower::isWholeAllocatable(assign.lhs);
+ Fortran::lower::isWholeAllocatable(assign.lhs) &&
+ bridge.getLoweringOptions().getReallocateLHS();
const bool isUserDefAssignToPointerOrAllocatable =
userDefinedAssignment &&
firstDummyIsPointerOrAllocatable(*userDefinedAssignment);
diff --git a/flang/test/Driver/frealloc-lhs.f90 b/flang/test/Driver/frealloc-lhs.f90
new file mode 100644
index 00000000000000..b82b1565957aa5
--- /dev/null
+++ b/flang/test/Driver/frealloc-lhs.f90
@@ -0,0 +1,11 @@
+! Check that the driver passes through -f[no-]realloc-lhs:
+! RUN: %flang -### -S -frealloc-lhs %s -o - 2>&1 | FileCheck %s --check-prefix=ON
+! RUN: %flang -### -S -fno-realloc-lhs %s -o - 2>&1 | FileCheck %s --check-prefix=OFF
+
+! Check that the compiler accepts -f[no-]realloc-lhs:
+! RUN: %flang_fc1 -emit-hlfir -frealloc-lhs %s -o -
+! RUN: %flang_fc1 -emit-hlfir -fno-realloc-lhs %s -o -
+
+! ON: "-fc1"{{.*}}"-frealloc-lhs"
+
+! OFF: "-fc1"{{.*}}"-fno-realloc-lhs"
diff --git a/flang/test/Lower/reallocate-lhs.f90 b/flang/test/Lower/reallocate-lhs.f90
new file mode 100644
index 00000000000000..82a4edab787c7d
--- /dev/null
+++ b/flang/test/Lower/reallocate-lhs.f90
@@ -0,0 +1,32 @@
+! RUN: bbc %s -o - -emit-hlfir | FileCheck %s --check-prefixes=ALL,REALLOCLHS
+! RUN: bbc %s -o - -emit-hlfir -frealloc-lhs | FileCheck %s --check-prefixes=ALL,REALLOCLHS
+! RUN: bbc %s -o - -emit-hlfir -frealloc-lhs=false | FileCheck %s --check-prefixes=ALL,NOREALLOCLHS
+! RUN: %flang_fc1 %s -o - -emit-hlfir | FileCheck %s --check-prefixes=ALL,REALLOCLHS
+! RUN: %flang_fc1 %s -o - -emit-hlfir -frealloc-lhs | FileCheck %s --check-prefixes=ALL,REALLOCLHS
+! RUN: %flang_fc1 %s -o - -emit-hlfir -fno-realloc-lhs | FileCheck %s --check-prefixes=ALL,NOREALLOCLHS
+
+subroutine test1(a, b)
+ integer, allocatable :: a(:), b(:)
+ a = b + 1
+end
+
+! ALL-LABEL: func.func @_QPtest1(
+! ALL: %[[VAL_3:.*]]:2 = hlfir.declare{{.*}}{fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest1Ea"}
+! REALLOCLHS: hlfir.assign %{{.*}} to %[[VAL_3]]#0 realloc : !hlfir.expr<?xi32>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+
+! NOREALLOCLHS: %[[VAL_20:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! NOREALLOCLHS: hlfir.assign %{{.*}} to %[[VAL_20]] : !hlfir.expr<?xi32>, !fir.box<!fir.heap<!fir.array<?xi32>>>
+
+subroutine test2(a, b)
+ character(len=*), allocatable :: a(:)
+ character(len=*) :: b(:)
+ a = b
+end subroutine test2
+
+! ALL-LABEL: func.func @_QPtest2(
+! ALL: %[[VAL_3:.*]]:2 = hlfir.declare{{.*}}{fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest2Ea"}
+! REALLOCLHS: hlfir.assign %{{.*}} to %[[VAL_3]]#0 realloc keep_lhs_len : !fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
+
+! NOREALLOCLHS: %[[VAL_7:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
+! NOREALLOCLHS: hlfir.assign %{{.*}} to %[[VAL_7]] : !fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>
+
diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp
index 02ecd6a75ef7a3..7efc460be86795 100644
--- a/flang/tools/bbc/bbc.cpp
+++ b/flang/tools/bbc/bbc.cpp
@@ -234,6 +234,12 @@ static llvm::cl::opt<bool> integerWrapAround(
llvm::cl::desc("Treat signed integer overflow as two's complement"),
llvm::cl::init(false));
+static llvm::cl::opt<bool>
+ reallocateLHS("frealloc-lhs",
+ llvm::cl::desc("Follow Fortran 2003 rules for (re)allocating "
+ "the LHS of the intrinsic assignment"),
+ llvm::cl::init(true));
+
#define FLANG_EXCLUDE_CODEGEN
#include "flang/Optimizer/Passes/CommandLineOpts.h"
#include "flang/Optimizer/Passes/Pipelines.h"
@@ -375,6 +381,7 @@ static llvm::LogicalResult convertFortranSourceToMLIR(
loweringOptions.setNoPPCNativeVecElemOrder(enableNoPPCNativeVecElemOrder);
loweringOptions.setLowerToHighLevelFIR(useHLFIR || emitHLFIR);
loweringOptions.setIntegerWrapAround(integerWrapAround);
+ loweringOptions.setReallocateLHS(reallocateLHS);
std::vector<Fortran::lower::EnvironmentDefault> envDefaults = {};
Fortran::frontend::TargetOptions targetOpts;
Fortran::frontend::CodeGenOptions cgOpts;
More information about the flang-commits
mailing list