jpenix-quic updated this revision to Diff 464849.
jpenix-quic added a comment.

Add /*overwrite=*/ comment I missed previously, move 
Runtime/environment-defaults.h to Lower/EnvironmentDefault.h


CHANGES SINCE LAST ACTION
  https://reviews.llvm.org/D130513/new/

https://reviews.llvm.org/D130513

Files:
  clang/include/clang/Driver/Options.td
  clang/lib/Driver/ToolChains/Flang.cpp
  flang/examples/external-hello.cpp
  flang/include/flang/Frontend/FrontendOptions.h
  flang/include/flang/Lower/Bridge.h
  flang/include/flang/Lower/EnvironmentDefault.h
  flang/include/flang/Optimizer/Builder/Runtime/EnvironmentDefaults.h
  flang/include/flang/Runtime/main.h
  flang/lib/Frontend/CompilerInvocation.cpp
  flang/lib/Frontend/FrontendActions.cpp
  flang/lib/Lower/Bridge.cpp
  flang/lib/Optimizer/Builder/CMakeLists.txt
  flang/lib/Optimizer/Builder/Runtime/EnvironmentDefaults.cpp
  flang/runtime/FortranMain/Fortran_main.c
  flang/runtime/environment-default-list.h
  flang/runtime/environment.cpp
  flang/runtime/environment.h
  flang/runtime/main.cpp
  flang/test/Driver/convert.f90
  flang/test/Driver/driver-help-hidden.f90
  flang/test/Driver/driver-help.f90
  flang/test/Driver/emit-mlir.f90
  flang/test/Driver/frontend-forwarding.f90
  flang/test/Lower/convert.f90
  flang/test/Lower/environment-defaults.f90
  flang/test/Runtime/no-cpp-dep.c
  flang/tools/bbc/bbc.cpp
  flang/unittests/Runtime/CommandTest.cpp
  flang/unittests/Runtime/Stop.cpp

Index: flang/unittests/Runtime/Stop.cpp
===================================================================
--- flang/unittests/Runtime/Stop.cpp
+++ flang/unittests/Runtime/Stop.cpp
@@ -26,7 +26,8 @@
 
 TEST(TestProgramEnd, StopTestNoStopMessage) {
   putenv(const_cast<char *>("NO_STOP_MESSAGE=1"));
-  Fortran::runtime::executionEnvironment.Configure(0, nullptr, nullptr);
+  Fortran::runtime::executionEnvironment.Configure(
+      0, nullptr, nullptr, nullptr);
   EXPECT_EXIT(
       RTNAME(StopStatement)(), testing::ExitedWithCode(EXIT_SUCCESS), "");
 }
@@ -52,7 +53,8 @@
 
 TEST(TestProgramEnd, NoStopMessageTest) {
   putenv(const_cast<char *>("NO_STOP_MESSAGE=1"));
-  Fortran::runtime::executionEnvironment.Configure(0, nullptr, nullptr);
+  Fortran::runtime::executionEnvironment.Configure(
+      0, nullptr, nullptr, nullptr);
   static const char *message{"bye bye"};
   EXPECT_EXIT(RTNAME(StopStatementText)(message, std::strlen(message),
                   /*isErrorStop=*/false, /*quiet=*/false),
Index: flang/unittests/Runtime/CommandTest.cpp
===================================================================
--- flang/unittests/Runtime/CommandTest.cpp
+++ flang/unittests/Runtime/CommandTest.cpp
@@ -49,7 +49,7 @@
 class CommandFixture : public ::testing::Test {
 protected:
   CommandFixture(int argc, const char *argv[]) {
-    RTNAME(ProgramStart)(argc, argv, {});
+    RTNAME(ProgramStart)(argc, argv, {}, {});
   }
 
   std::string GetPaddedStr(const char *text, std::size_t len) const {
Index: flang/tools/bbc/bbc.cpp
===================================================================
--- flang/tools/bbc/bbc.cpp
+++ flang/tools/bbc/bbc.cpp
@@ -224,7 +224,7 @@
   auto burnside = Fortran::lower::LoweringBridge::create(
       ctx, semanticsContext, defKinds, semanticsContext.intrinsics(),
       semanticsContext.targetCharacteristics(), parsing.allCooked(), "",
-      kindMap, loweringOptions);
+      kindMap, loweringOptions, {});
   burnside.lower(parseTree, semanticsContext);
   mlir::ModuleOp mlirModule = burnside.getModule();
   std::error_code ec;
Index: flang/test/Runtime/no-cpp-dep.c
===================================================================
--- flang/test/Runtime/no-cpp-dep.c
+++ flang/test/Runtime/no-cpp-dep.c
@@ -16,18 +16,20 @@
 we're testing. We can't include any headers directly since they likely contain
 C++ code that would explode here.
 */
+struct EnvironmentDefaultList;
 struct Descriptor;
 
 double RTNAME(CpuTime)();
 
-void RTNAME(ProgramStart)(int, const char *[], const char *[]);
+void RTNAME(ProgramStart)(
+    int, const char *[], const char *[], const struct EnvironmentDefaultList *);
 int32_t RTNAME(ArgumentCount)();
 int32_t RTNAME(GetCommandArgument)(int32_t, const struct Descriptor *,
     const struct Descriptor *, const struct Descriptor *);
 
 int main() {
   double x = RTNAME(CpuTime)();
-  RTNAME(ProgramStart)(0, 0, 0);
+  RTNAME(ProgramStart)(0, 0, 0, 0);
   int32_t c = RTNAME(ArgumentCount)();
   int32_t v = RTNAME(GetCommandArgument)(0, 0, 0, 0);
   return x + c + v;
Index: flang/test/Lower/environment-defaults.f90
===================================================================
--- /dev/null
+++ flang/test/Lower/environment-defaults.f90
@@ -0,0 +1,12 @@
+! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+program test
+  continue
+end
+
+! Test that a null pointer is generated for environment defaults if nothing is specified
+
+! CHECK: fir.global @_QQEnvironmentDefaults constant : !fir.ref<tuple<i[[int_size:.*]], !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>> {
+! CHECK:  %[[VAL_0:.*]] = fir.zero_bits !fir.ref<tuple<i[[int_size]], !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>
+! CHECK: fir.has_value  %[[VAL_0]] : !fir.ref<tuple<i[[int_size]], !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>
Index: flang/test/Lower/convert.f90
===================================================================
--- /dev/null
+++ flang/test/Lower/convert.f90
@@ -0,0 +1,46 @@
+! RUN: %flang_fc1 -emit-fir -fconvert=unknown %s -o - | FileCheck %s --check-prefixes=ALL,UNKNOWN
+! RUN: %flang_fc1 -emit-fir -fconvert=native %s -o - | FileCheck %s --check-prefixes=ALL,NATIVE
+! RUN: %flang_fc1 -emit-fir -fconvert=little-endian %s -o - | FileCheck %s --check-prefixes=ALL,LITTLE_ENDIAN
+! RUN: %flang_fc1 -emit-fir -fconvert=big-endian %s -o - | FileCheck %s --check-prefixes=ALL,BIG_ENDIAN
+! RUN: %flang_fc1 -emit-fir -fconvert=swap %s -o - | FileCheck %s --check-prefixes=ALL,SWAP
+
+program test
+  continue
+end
+
+! Try to test that -fconvert=<value> flag results in a environment default list
+! with the FORT_CONVERT option correctly specified.
+
+! ALL: fir.global linkonce @_QQEnvironmentDefaults.items constant : !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>> {
+! ALL: %[[VAL_0:.*]] = fir.undefined !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>
+! ALL: %[[VAL_1:.*]] = fir.address_of(@[[FC_STR:.*]]) : !fir.ref<!fir.char<1,13>>
+! ALL: %[[VAL_3:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.char<1,13>>) -> !fir.ref<i8>
+! ALL: %[[VAL_4:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_3]], [0 : index, 0 : index] : (!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>, !fir.ref<i8>) -> !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>
+! ALL: %[[VAL_5:.*]] = fir.address_of(@[[OPT_STR:.*]]) : !fir.ref<!fir.char<1,[[OPT_STR_LEN:.*]]>>
+! ALL: %[[VAL_7:.*]] = fir.convert %[[VAL_5]] : (!fir.ref<!fir.char<1,[[OPT_STR_LEN]]>>) -> !fir.ref<i8>
+! ALL: %[[VAL_8:.*]] = fir.insert_value %[[VAL_4]], %[[VAL_7]], [0 : index, 1 : index] : (!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>, !fir.ref<i8>) -> !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>
+! ALL: fir.has_value %[[VAL_8]] : !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>
+
+! ALL: fir.global linkonce @[[FC_STR]] constant : !fir.char<1,13> {
+! ALL: %[[VAL_0:.*]] = fir.string_lit "FORT_CONVERT\00"(13) : !fir.char<1,13>
+! ALL: fir.has_value %[[VAL_0]] : !fir.char<1,13>
+
+! ALL: fir.global linkonce @[[OPT_STR]] constant : !fir.char<1,[[OPT_STR_LEN]]> {
+! UNKNOWN: %[[VAL_0:.*]] = fir.string_lit "UNKNOWN\00"([[OPT_STR_LEN]]) : !fir.char<1,[[OPT_STR_LEN]]>
+! NATIVE: %[[VAL_0:.*]] = fir.string_lit "NATIVE\00"([[OPT_STR_LEN]]) : !fir.char<1,[[OPT_STR_LEN]]>
+! LITTLE_ENDIAN: %[[VAL_0:.*]] = fir.string_lit "LITTLE_ENDIAN\00"([[OPT_STR_LEN]]) : !fir.char<1,[[OPT_STR_LEN]]>
+! BIG_ENDIAN: %[[VAL_0:.*]] = fir.string_lit "BIG_ENDIAN\00"([[OPT_STR_LEN]]) : !fir.char<1,[[OPT_STR_LEN]]>
+! SWAP: %[[VAL_0:.*]] = fir.string_lit "SWAP\00"([[OPT_STR_LEN]]) : !fir.char<1,[[OPT_STR_LEN]]>
+! ALL: fir.has_value %[[VAL_0]] : !fir.char<1,[[OPT_STR_LEN]]>
+
+! ALL: fir.global linkonce @_QQEnvironmentDefaults.list constant : tuple<i[[int_size:.*]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>> {
+! ALL: %[[VAL_0:.*]] = fir.undefined tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>
+! ALL: %[[VAL_1:.*]] = arith.constant 1 : i[[int_size]]
+! ALL: %[[VAL_2:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_1]], [0 : index] : (tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>, i[[int_size]]) -> tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>
+! ALL: %[[VAL_3:.*]] = fir.address_of(@_QQEnvironmentDefaults.items) : !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>
+! ALL: %[[VAL_4:.*]] = fir.insert_value %[[VAL_2]], %[[VAL_3]], [1 : index] : (tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>) -> tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>
+! ALL: fir.has_value %[[VAL_4]] : tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>
+
+! ALL: fir.global @_QQEnvironmentDefaults constant : !fir.ref<tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>> {
+! ALL: %[[VAL_0:.*]] = fir.address_of(@_QQEnvironmentDefaults.list) : !fir.ref<tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>
+! ALL: fir.has_value %[[VAL_0]] : !fir.ref<tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>
Index: flang/test/Driver/frontend-forwarding.f90
===================================================================
--- flang/test/Driver/frontend-forwarding.f90
+++ flang/test/Driver/frontend-forwarding.f90
@@ -7,6 +7,7 @@
 ! RUN:     -fdefault-integer-8 \
 ! RUN:     -fdefault-real-8 \
 ! RUN:     -flarge-sizes \
+! RUN:     -fconvert=little-endian \
 ! RUN:     -mllvm -print-before-all\
 ! RUN:     -P \
 ! RUN:   | FileCheck %s
@@ -17,4 +18,5 @@
 ! CHECK: "-fdefault-integer-8"
 ! CHECK: "-fdefault-real-8"
 ! CHECK: "-flarge-sizes"
+! CHECK: "-fconvert=little-endian"
 ! CHECK:  "-mllvm" "-print-before-all"
Index: flang/test/Driver/emit-mlir.f90
===================================================================
--- flang/test/Driver/emit-mlir.f90
+++ flang/test/Driver/emit-mlir.f90
@@ -13,6 +13,10 @@
 ! CHECK-LABEL: func @_QQmain() {
 ! CHECK-NEXT:  return
 ! CHECK-NEXT: }
+! CHECK-NEXT: fir.global @_QQEnvironmentDefaults constant : !fir.ref<tuple<i[[int_size:.*]], !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>> {
+! CHECK-NEXT:  %[[VAL_0:.*]] = fir.zero_bits !fir.ref<tuple<i[[int_size]], !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>
+! CHECK-NEXT: fir.has_value  %[[VAL_0]] : !fir.ref<tuple<i[[int_size]], !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>
+! CHECK-NEXT: }
 ! CHECK-NEXT: }
 
 end program
Index: flang/test/Driver/driver-help.f90
===================================================================
--- flang/test/Driver/driver-help.f90
+++ flang/test/Driver/driver-help.f90
@@ -24,6 +24,7 @@
 ! HELP-NEXT: Enable the old style PARAMETER statement
 ! HELP-NEXT: -fbackslash            Specify that backslash in string introduces an escape character
 ! HELP-NEXT: -fcolor-diagnostics    Enable colors in diagnostics
+! HELP-NEXT: -fconvert=<value>      Set endian conversion of data for unformatted files
 ! HELP-NEXT: -fdefault-double-8     Set the default double precision kind to an 8 byte wide type
 ! HELP-NEXT: -fdefault-integer-8    Set the default integer kind to an 8 byte wide type
 ! HELP-NEXT: -fdefault-real-8       Set the default real kind to an 8 byte wide type
@@ -79,6 +80,7 @@
 ! HELP-FC1-NEXT: Enable the old style PARAMETER statement
 ! HELP-FC1-NEXT: -fbackslash            Specify that backslash in string introduces an escape character
 ! HELP-FC1-NEXT: -fcolor-diagnostics     Enable colors in diagnostics
+! HELP-FC1-NEXT: -fconvert=<value>      Set endian conversion of data for unformatted files
 ! HELP-FC1-NEXT: -fdebug-dump-all       Dump symbols and the parse tree after the semantic checks
 ! HELP-FC1-NEXT: -fdebug-dump-parse-tree-no-sema
 ! HELP-FC1-NEXT:                        Dump the parse tree (skips the semantic checks)
Index: flang/test/Driver/driver-help-hidden.f90
===================================================================
--- flang/test/Driver/driver-help-hidden.f90
+++ flang/test/Driver/driver-help-hidden.f90
@@ -24,6 +24,7 @@
 ! CHECK-NEXT: Enable the old style PARAMETER statement
 ! CHECK-NEXT: -fbackslash            Specify that backslash in string introduces an escape character
 ! CHECK-NEXT: -fcolor-diagnostics    Enable colors in diagnostics
+! CHECK-NEXT: -fconvert=<value>      Set endian conversion of data for unformatted files
 ! CHECK-NEXT: -fdefault-double-8     Set the default double precision kind to an 8 byte wide type
 ! CHECK-NEXT: -fdefault-integer-8    Set the default integer kind to an 8 byte wide type
 ! CHECK-NEXT: -fdefault-real-8       Set the default real kind to an 8 byte wide type
Index: flang/test/Driver/convert.f90
===================================================================
--- /dev/null
+++ flang/test/Driver/convert.f90
@@ -0,0 +1,29 @@
+! Ensure argument -fconvert=<value> accepts all relevant options and produces an
+! error if an invalid value is specified. 
+
+!--------------------------
+! FLANG DRIVER (flang)
+!--------------------------
+! RUN: %flang -### -fconvert=unknown %s  2>&1 | FileCheck %s --check-prefix=VALID
+! RUN: %flang -### -fconvert=native %s  2>&1 | FileCheck %s --check-prefix=VALID
+! RUN: %flang -### -fconvert=little-endian %s  2>&1 | FileCheck %s --check-prefix=VALID
+! RUN: %flang -### -fconvert=big-endian %s  2>&1 | FileCheck %s --check-prefix=VALID
+! RUN: %flang -### -fconvert=swap %s  2>&1 | FileCheck %s --check-prefix=VALID
+! RUN: not %flang -fconvert=foobar %s  2>&1 | FileCheck %s --check-prefix=INVALID
+
+!-----------------------------------------
+! FRONTEND FLANG DRIVER (flang-new -fc1)
+!-----------------------------------------
+! RUN: %flang_fc1 -emit-mlir -fconvert=unknown %s -o - | FileCheck %s --check-prefix=VALID_FC1
+! RUN: %flang_fc1 -emit-mlir -fconvert=native %s -o - | FileCheck %s --check-prefix=VALID_FC1
+! RUN: %flang_fc1 -emit-mlir -fconvert=little-endian %s -o - | FileCheck %s --check-prefix=VALID_FC1
+! RUN: %flang_fc1 -emit-mlir -fconvert=big-endian %s -o - | FileCheck %s --check-prefix=VALID_FC1
+! RUN: %flang_fc1 -emit-mlir -fconvert=swap %s -o - | FileCheck %s --check-prefix=VALID_FC1
+! RUN: not %flang_fc1 -fconvert=foobar %s  2>&1 | FileCheck %s --check-prefix=INVALID
+
+! Only test that the command executes without error. Correct handling of each
+! option is handled in Lowering tests.
+! VALID: -fconvert
+! VALID_FC1: module
+
+! INVALID: error: invalid value 'foobar' in '-fconvert=foobar'
Index: flang/runtime/main.cpp
===================================================================
--- flang/runtime/main.cpp
+++ flang/runtime/main.cpp
@@ -27,9 +27,11 @@
 }
 
 extern "C" {
-void RTNAME(ProgramStart)(int argc, const char *argv[], const char *envp[]) {
+void RTNAME(ProgramStart)(int argc, const char *argv[], const char *envp[],
+    const EnvironmentDefaultList *envDefaults) {
   std::atexit(Fortran::runtime::NotifyOtherImagesOfNormalEnd);
-  Fortran::runtime::executionEnvironment.Configure(argc, argv, envp);
+  Fortran::runtime::executionEnvironment.Configure(
+      argc, argv, envp, envDefaults);
   ConfigureFloatingPoint();
   // I/O is initialized on demand so that it works for non-Fortran main().
 }
Index: flang/runtime/environment.h
===================================================================
--- flang/runtime/environment.h
+++ flang/runtime/environment.h
@@ -12,6 +12,8 @@
 #include "flang/Decimal/decimal.h"
 #include <optional>
 
+struct EnvironmentDefaultList;
+
 namespace Fortran::runtime {
 
 class Terminator;
@@ -31,13 +33,14 @@
 
 struct ExecutionEnvironment {
   constexpr ExecutionEnvironment(){};
-  void Configure(int argc, const char *argv[], const char *envp[]);
+  void Configure(int argc, const char *argv[], const char *envp[],
+      const EnvironmentDefaultList *envDefaults);
   const char *GetEnv(
       const char *name, std::size_t name_length, const Terminator &terminator);
 
   int argc{0};
   const char **argv{nullptr};
-  const char **envp{nullptr};
+  char **envp{nullptr};
 
   int listDirectedOutputLineLengthLimit{79}; // FORT_FMT_RECL
   enum decimal::FortranRounding defaultOutputRoundingMode{
Index: flang/runtime/environment.cpp
===================================================================
--- flang/runtime/environment.cpp
+++ flang/runtime/environment.cpp
@@ -7,6 +7,7 @@
 //===----------------------------------------------------------------------===//
 
 #include "environment.h"
+#include "environment-default-list.h"
 #include "memory.h"
 #include "tools.h"
 #include <cstdio>
@@ -14,10 +15,38 @@
 #include <cstring>
 #include <limits>
 
+#ifdef _WIN32
+extern char **_environ;
+#else
+extern char **environ;
+#endif
+
 namespace Fortran::runtime {
 
 ExecutionEnvironment executionEnvironment;
 
+static void SetEnvironmentDefaults(const EnvironmentDefaultList *envDefaults) {
+  if (!envDefaults) {
+    return;
+  }
+
+  for (int itemIndex = 0; itemIndex < envDefaults->numItems; ++itemIndex) {
+    const char *name = envDefaults->item[itemIndex].name;
+    const char *value = envDefaults->item[itemIndex].value;
+#ifdef _WIN32
+    if (auto *x{std::getenv(name)}) {
+      continue;
+    }
+    if (_putenv_s(name, value) != 0) {
+#else
+    if (setenv(name, value, /*overwrite=*/0) == -1) {
+#endif
+      Fortran::runtime::Terminator{__FILE__, __LINE__}.Crash(
+          std::strerror(errno));
+    }
+  }
+}
+
 std::optional<Convert> GetConvertFromString(const char *x, std::size_t n) {
   static const char *keywords[]{
       "UNKNOWN", "NATIVE", "LITTLE_ENDIAN", "BIG_ENDIAN", "SWAP", nullptr};
@@ -37,11 +66,16 @@
   }
 }
 
-void ExecutionEnvironment::Configure(
-    int ac, const char *av[], const char *env[]) {
+void ExecutionEnvironment::Configure(int ac, const char *av[],
+    const char *env[], const EnvironmentDefaultList *envDefaults) {
   argc = ac;
   argv = av;
-  envp = env;
+  SetEnvironmentDefaults(envDefaults);
+#ifdef _WIN32
+  envp = _environ;
+#else
+  envp = environ;
+#endif
   listDirectedOutputLineLengthLimit = 79; // PGI default
   defaultOutputRoundingMode =
       decimal::FortranRounding::RoundNearest; // RP(==RN)
Index: flang/runtime/environment-default-list.h
===================================================================
--- /dev/null
+++ flang/runtime/environment-default-list.h
@@ -0,0 +1,31 @@
+/*===-- runtime/environment-default-list.h --------------------------*- C -*-===
+ *
+ * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+ * See https://llvm.org/LICENSE.txt for license information.
+ * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+ *
+ * ===-----------------------------------------------------------------------===
+ */
+
+#ifndef FORTRAN_RUNTIME_ENVIRONMENT_DEFAULT_LIST_H_
+#define FORTRAN_RUNTIME_ENVIRONMENT_DEFAULT_LIST_H_
+
+/* Try to maintain C compatibility to make it easier to both define environment
+ * defaults in non-Fortran main programs as well as pass through the environment
+ * default list in C code.
+ */
+
+struct EnvironmentDefaultItem {
+  const char *name;
+  const char *value;
+};
+
+/* Default values for environment variables are packaged by lowering into an
+ * instance of this struct to be read and set by the runtime.
+ */
+struct EnvironmentDefaultList {
+  int numItems;
+  const struct EnvironmentDefaultItem *item;
+};
+
+#endif /* FORTRAN_RUNTIME_ENVIRONMENT_DEFAULT_LIST_H_ */
Index: flang/runtime/FortranMain/Fortran_main.c
===================================================================
--- flang/runtime/FortranMain/Fortran_main.c
+++ flang/runtime/FortranMain/Fortran_main.c
@@ -12,9 +12,11 @@
 /* main entry into PROGRAM */
 void _QQmain(void);
 
+extern const struct EnvironmentDefaultList *_QQEnvironmentDefaults;
+
 /* C main stub */
 int main(int argc, const char *argv[], const char *envp[]) {
-  RTNAME(ProgramStart)(argc, argv, envp);
+  RTNAME(ProgramStart)(argc, argv, envp, _QQEnvironmentDefaults);
   _QQmain();
   RTNAME(ProgramEndStatement)();
   return 0;
Index: flang/lib/Optimizer/Builder/Runtime/EnvironmentDefaults.cpp
===================================================================
--- /dev/null
+++ flang/lib/Optimizer/Builder/Runtime/EnvironmentDefaults.cpp
@@ -0,0 +1,109 @@
+//===-- EnvironmentDefaults.cpp -------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Optimizer/Builder/Runtime/EnvironmentDefaults.h"
+#include "flang/Lower/EnvironmentDefault.h"
+#include "flang/Optimizer/Builder/BoxValue.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Support/InternalNames.h"
+#include "llvm/ADT/ArrayRef.h"
+
+void fir::runtime::genEnvironmentDefaults(
+    fir::FirOpBuilder &builder, mlir::Location loc,
+    const std::vector<Fortran::lower::EnvironmentDefault> &envDefaults) {
+  std::string envDefaultListPtrName =
+      fir::NameUniquer::doGenerated("EnvironmentDefaults");
+
+  mlir::MLIRContext *context = builder.getContext();
+  mlir::StringAttr linkOnce = builder.createLinkOnceLinkage();
+  mlir::IntegerType intTy = builder.getIntegerType(8 * sizeof(int));
+  fir::ReferenceType charRefTy =
+      fir::ReferenceType::get(builder.getIntegerType(8));
+  fir::SequenceType itemListTy = fir::SequenceType::get(
+      envDefaults.size(),
+      mlir::TupleType::get(context, {charRefTy, charRefTy}));
+  mlir::TupleType envDefaultListTy = mlir::TupleType::get(
+      context, {intTy, fir::ReferenceType::get(itemListTy)});
+  fir::ReferenceType envDefaultListRefTy =
+      fir::ReferenceType::get(envDefaultListTy);
+
+  // If no defaults were specified, initialize with a null pointer.
+  if (envDefaults.empty()) {
+    builder.createGlobalConstant(
+        loc, envDefaultListRefTy, envDefaultListPtrName,
+        [&](fir::FirOpBuilder &builder) {
+          mlir::Value nullVal =
+              builder.createNullConstant(loc, envDefaultListRefTy);
+          builder.create<fir::HasValueOp>(loc, nullVal);
+        });
+    return;
+  }
+
+  // Create the Item list.
+  mlir::IndexType idxTy = builder.getIndexType();
+  mlir::IntegerAttr zero = builder.getIntegerAttr(idxTy, 0);
+  mlir::IntegerAttr one = builder.getIntegerAttr(idxTy, 1);
+  std::string itemListName = envDefaultListPtrName + ".items";
+  auto listBuilder = [&](fir::FirOpBuilder &builder) {
+    mlir::Value list = builder.create<fir::UndefOp>(loc, itemListTy);
+    llvm::SmallVector<mlir::Attribute, 2> idx = {mlir::Attribute{},
+                                                 mlir::Attribute{}};
+    auto insertStringField = [&](const std::string &s,
+                                 llvm::ArrayRef<mlir::Attribute> idx) {
+      mlir::Value stringAddress = fir::getBase(
+          fir::factory::createStringLiteral(builder, loc, s + '\0'));
+      mlir::Value addr = builder.createConvert(loc, charRefTy, stringAddress);
+      return builder.create<fir::InsertValueOp>(loc, itemListTy, list, addr,
+                                                builder.getArrayAttr(idx));
+    };
+
+    size_t n = 0;
+    for (const Fortran::lower::EnvironmentDefault &def : envDefaults) {
+      idx[0] = builder.getIntegerAttr(idxTy, n);
+      idx[1] = zero;
+      list = insertStringField(def.varName, idx);
+      idx[1] = one;
+      list = insertStringField(def.defaultValue, idx);
+      ++n;
+    }
+    builder.create<fir::HasValueOp>(loc, list);
+  };
+  builder.createGlobalConstant(loc, itemListTy, itemListName, listBuilder,
+                               linkOnce);
+
+  // Define the EnviornmentDefaultList object.
+  auto envDefaultListBuilder = [&](fir::FirOpBuilder &builder) {
+    mlir::Value envDefaultList =
+        builder.create<fir::UndefOp>(loc, envDefaultListTy);
+    mlir::Value numItems =
+        builder.createIntegerConstant(loc, intTy, envDefaults.size());
+    envDefaultList = builder.create<fir::InsertValueOp>(
+        loc, envDefaultListTy, envDefaultList, numItems,
+        builder.getArrayAttr(zero));
+    fir::GlobalOp itemList = builder.getNamedGlobal(itemListName);
+    assert(itemList && "missing environment default list");
+    mlir::Value listAddr = builder.create<fir::AddrOfOp>(
+        loc, itemList.resultType(), itemList.getSymbol());
+    envDefaultList = builder.create<fir::InsertValueOp>(
+        loc, envDefaultListTy, envDefaultList, listAddr,
+        builder.getArrayAttr(one));
+    builder.create<fir::HasValueOp>(loc, envDefaultList);
+  };
+  fir::GlobalOp envDefaultList = builder.createGlobalConstant(
+      loc, envDefaultListTy, envDefaultListPtrName + ".list",
+      envDefaultListBuilder, linkOnce);
+
+  // Define the pointer to the list used by the runtime.
+  builder.createGlobalConstant(
+      loc, envDefaultListRefTy, envDefaultListPtrName,
+      [&](fir::FirOpBuilder &builder) {
+        mlir::Value addr = builder.create<fir::AddrOfOp>(
+            loc, envDefaultList.resultType(), envDefaultList.getSymbol());
+        builder.create<fir::HasValueOp>(loc, addr);
+      });
+}
Index: flang/lib/Optimizer/Builder/CMakeLists.txt
===================================================================
--- flang/lib/Optimizer/Builder/CMakeLists.txt
+++ flang/lib/Optimizer/Builder/CMakeLists.txt
@@ -12,6 +12,7 @@
   Runtime/Character.cpp
   Runtime/Command.cpp
   Runtime/Derived.cpp
+  Runtime/EnvironmentDefaults.cpp
   Runtime/Inquiry.cpp
   Runtime/Numeric.cpp
   Runtime/Ragged.cpp
Index: flang/lib/Lower/Bridge.cpp
===================================================================
--- flang/lib/Lower/Bridge.cpp
+++ flang/lib/Lower/Bridge.cpp
@@ -31,6 +31,7 @@
 #include "flang/Optimizer/Builder/Character.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/Runtime/Character.h"
+#include "flang/Optimizer/Builder/Runtime/EnvironmentDefaults.h"
 #include "flang/Optimizer/Builder/Runtime/Ragged.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/Dialect/FIRAttr.h"
@@ -223,9 +224,12 @@
     //  - Define module variables and OpenMP/OpenACC declarative construct so
     //    that they are available before lowering any function that may use
     //    them.
+    bool hasMainProgram = false;
     for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
       std::visit(Fortran::common::visitors{
                      [&](Fortran::lower::pft::FunctionLikeUnit &f) {
+                       if (f.isMainProgram())
+                         hasMainProgram = true;
                        declareFunction(f);
                      },
                      [&](Fortran::lower::pft::ModuleLikeUnit &m) {
@@ -262,6 +266,22 @@
     /// processed.
     createGlobalOutsideOfFunctionLowering(
         [&]() { runtimeTypeInfoConverter.createTypeInfoGlobals(*this); });
+
+    // Create the list of any environment defaults for the runtime to set. The
+    // runtime default list is only created if there is a main program to ensure
+    // it only happens once and to provide consistent results if multiple files
+    // are compiled separately.
+    if (hasMainProgram)
+      createGlobalOutsideOfFunctionLowering([&]() {
+        // FIXME: Ideally, this would create a call to a runtime function
+        // accepting the list of environment defaults. That way, we would not
+        // need to add an extern pointer to the runtime and said pointer would
+        // not need to be generated even if no defaults are specified.
+        // However, generating main or changing when the runtime reads
+        // environment variables is required to do so.
+        fir::runtime::genEnvironmentDefaults(*builder, toLocation(),
+                                             bridge.getEnvironmentDefaults());
+      });
   }
 
   /// Declare a function.
@@ -3346,11 +3366,12 @@
     const Fortran::evaluate::TargetCharacteristics &targetCharacteristics,
     const Fortran::parser::AllCookedSources &cooked, llvm::StringRef triple,
     fir::KindMapping &kindMap,
-    const Fortran::lower::LoweringOptions &loweringOptions)
+    const Fortran::lower::LoweringOptions &loweringOptions,
+    const std::vector<Fortran::lower::EnvironmentDefault> &envDefaults)
     : semanticsContext{semanticsContext}, defaultKinds{defaultKinds},
       intrinsics{intrinsics}, targetCharacteristics{targetCharacteristics},
       cooked{&cooked}, context{context}, kindMap{kindMap},
-      loweringOptions{loweringOptions} {
+      loweringOptions{loweringOptions}, envDefaults{envDefaults} {
   // Register the diagnostic handler.
   context.getDiagEngine().registerHandler([](mlir::Diagnostic &diag) {
     llvm::raw_ostream &os = llvm::errs();
Index: flang/lib/Frontend/FrontendActions.cpp
===================================================================
--- flang/lib/Frontend/FrontendActions.cpp
+++ flang/lib/Frontend/FrontendActions.cpp
@@ -149,7 +149,8 @@
       ci.getInvocation().getSemanticsContext().intrinsics(),
       ci.getInvocation().getSemanticsContext().targetCharacteristics(),
       ci.getParsing().allCooked(), ci.getInvocation().getTargetOpts().triple,
-      kindMap, ci.getInvocation().getLoweringOpts());
+      kindMap, ci.getInvocation().getLoweringOpts(),
+      ci.getInvocation().getFrontendOpts().envDefaults);
 
   // Create a parse tree and lower it to FIR
   Fortran::parser::Program &parseTree{*ci.getParsing().parseTree()};
Index: flang/lib/Frontend/CompilerInvocation.cpp
===================================================================
--- flang/lib/Frontend/CompilerInvocation.cpp
+++ flang/lib/Frontend/CompilerInvocation.cpp
@@ -180,6 +180,17 @@
     opts.needProvenanceRangeToCharBlockMappings = true;
 }
 
+/// Parse the argument specified for the -fconvert=<value> option
+static std::optional<const char *> parseConvertArg(const char *s) {
+  return llvm::StringSwitch<std::optional<const char *>>(s)
+      .Case("unknown", "UNKNOWN")
+      .Case("native", "NATIVE")
+      .Case("little-endian", "LITTLE_ENDIAN")
+      .Case("big-endian", "BIG_ENDIAN")
+      .Case("swap", "SWAP")
+      .Default(std::nullopt);
+}
+
 static bool parseFrontendArgs(FrontendOptions &opts, llvm::opt::ArgList &args,
                               clang::DiagnosticsEngine &diags) {
   unsigned numErrorsBefore = diags.getNumErrors();
@@ -399,6 +410,17 @@
     }
   }
 
+  // Set conversion based on -fconvert=<value>
+  if (const auto *arg =
+          args.getLastArg(clang::driver::options::OPT_fconvert_EQ)) {
+    const char *argValue = arg->getValue();
+    if (auto convert = parseConvertArg(argValue))
+      opts.envDefaults.push_back({"FORT_CONVERT", *convert});
+    else
+      diags.Report(clang::diag::err_drv_invalid_value)
+          << arg->getAsString(args) << argValue;
+  }
+
   // -f{no-}implicit-none
   opts.features.Enable(
       Fortran::common::LanguageFeature::ImplicitNoneTypeAlways,
Index: flang/include/flang/Runtime/main.h
===================================================================
--- flang/include/flang/Runtime/main.h
+++ flang/include/flang/Runtime/main.h
@@ -12,8 +12,11 @@
 #include "flang/Runtime/c-or-cpp.h"
 #include "flang/Runtime/entry-names.h"
 
+struct EnvironmentDefaultList;
+
 FORTRAN_EXTERN_C_BEGIN
-void RTNAME(ProgramStart)(int, const char *[], const char *[]);
+void RTNAME(ProgramStart)(
+    int, const char *[], const char *[], const struct EnvironmentDefaultList *);
 void RTNAME(ByteswapOption)(void); // -byteswapio
 FORTRAN_EXTERN_C_END
 
Index: flang/include/flang/Optimizer/Builder/Runtime/EnvironmentDefaults.h
===================================================================
--- /dev/null
+++ flang/include/flang/Optimizer/Builder/Runtime/EnvironmentDefaults.h
@@ -0,0 +1,45 @@
+//===-- EnvironmentDefaults.h -----------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+// EnvironmentDefaults is a list of default values for environment variables
+// that may be specified at compile time and set by the runtime during
+// program startup if the variable is not already present in the environment.
+// EnvironmentDefaults is intended to allow options controlled by environment
+// variables to also be set on the command line at compile time without needing
+// to define option-specific runtime calls or duplicate logic within the
+// runtime. For example, the -fconvert command line option is implemented in
+// terms of an default value for the FORT_CONVERT environment variable.
+
+#ifndef FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ENVIRONMENTDEFAULTS_H
+#define FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ENVIRONMENTDEFAULTS_H
+
+#include <vector>
+
+namespace fir {
+class FirOpBuilder;
+} // namespace fir
+
+namespace mlir {
+class Location;
+} // namespace mlir
+
+namespace Fortran::lower {
+struct EnvironmentDefault;
+} // namespace Fortran::lower
+
+namespace fir::runtime {
+
+/// Create the list of environment variable defaults for the runtime to set. The
+/// form of the generated list is defined in the runtime header file
+/// environment-default-list.h
+void genEnvironmentDefaults(
+    fir::FirOpBuilder &builder, mlir::Location loc,
+    const std::vector<Fortran::lower::EnvironmentDefault> &envDefaults);
+
+} // namespace fir::runtime
+#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ENVIRONMENTDEFAULTS_H
Index: flang/include/flang/Lower/EnvironmentDefault.h
===================================================================
--- /dev/null
+++ flang/include/flang/Lower/EnvironmentDefault.h
@@ -0,0 +1,23 @@
+//===-- Lower/EnvironmentDefault.h ------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_ENVIRONMENTDEFAULT_H
+#define FORTRAN_LOWER_ENVIRONMENTDEFAULT_H
+
+#include <string>
+
+namespace Fortran::lower {
+
+struct EnvironmentDefault {
+  std::string varName;
+  std::string defaultValue;
+};
+
+} // namespace Fortran::lower
+
+#endif // FORTRAN_LOWER_ENVIRONMENTDEFAULT_H
Index: flang/include/flang/Lower/Bridge.h
===================================================================
--- flang/include/flang/Lower/Bridge.h
+++ flang/include/flang/Lower/Bridge.h
@@ -15,6 +15,7 @@
 
 #include "flang/Common/Fortran.h"
 #include "flang/Lower/AbstractConverter.h"
+#include "flang/Lower/EnvironmentDefault.h"
 #include "flang/Lower/LoweringOptions.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Support/KindMapping.h"
@@ -55,10 +56,11 @@
          const Fortran::evaluate::TargetCharacteristics &targetCharacteristics,
          const Fortran::parser::AllCookedSources &allCooked,
          llvm::StringRef triple, fir::KindMapping &kindMap,
-         const Fortran::lower::LoweringOptions &loweringOptions) {
+         const Fortran::lower::LoweringOptions &loweringOptions,
+         const std::vector<Fortran::lower::EnvironmentDefault> &envDefaults) {
     return LoweringBridge(ctx, semanticsContext, defaultKinds, intrinsics,
                           targetCharacteristics, allCooked, triple, kindMap,
-                          loweringOptions);
+                          loweringOptions, envDefaults);
   }
 
   //===--------------------------------------------------------------------===//
@@ -91,6 +93,11 @@
     return loweringOptions;
   }
 
+  const std::vector<Fortran::lower::EnvironmentDefault> &
+  getEnvironmentDefaults() const {
+    return envDefaults;
+  }
+
   /// Create a folding context. Careful: this is very expensive.
   Fortran::evaluate::FoldingContext createFoldingContext() const;
 
@@ -121,7 +128,8 @@
       const Fortran::evaluate::TargetCharacteristics &targetCharacteristics,
       const Fortran::parser::AllCookedSources &cooked, llvm::StringRef triple,
       fir::KindMapping &kindMap,
-      const Fortran::lower::LoweringOptions &loweringOptions);
+      const Fortran::lower::LoweringOptions &loweringOptions,
+      const std::vector<Fortran::lower::EnvironmentDefault> &envDefaults);
   LoweringBridge() = delete;
   LoweringBridge(const LoweringBridge &) = delete;
 
@@ -134,6 +142,7 @@
   std::unique_ptr<mlir::ModuleOp> module;
   fir::KindMapping &kindMap;
   const Fortran::lower::LoweringOptions &loweringOptions;
+  const std::vector<Fortran::lower::EnvironmentDefault> &envDefaults;
 };
 
 } // namespace lower
Index: flang/include/flang/Frontend/FrontendOptions.h
===================================================================
--- flang/include/flang/Frontend/FrontendOptions.h
+++ flang/include/flang/Frontend/FrontendOptions.h
@@ -14,6 +14,7 @@
 #define FORTRAN_FRONTEND_FRONTENDOPTIONS_H
 
 #include "flang/Common/Fortran-features.h"
+#include "flang/Lower/EnvironmentDefault.h"
 #include "flang/Parser/characters.h"
 #include "flang/Parser/unparse.h"
 #include "llvm/ADT/StringRef.h"
@@ -258,6 +259,9 @@
   // The form to process files in, if specified.
   FortranForm fortranForm = FortranForm::Unknown;
 
+  // Default values for environment variables to be set by the runtime.
+  std::vector<Fortran::lower::EnvironmentDefault> envDefaults;
+
   // The column after which characters are ignored in fixed form lines in the
   // source file.
   int fixedFormColumns = 72;
Index: flang/examples/external-hello.cpp
===================================================================
--- flang/examples/external-hello.cpp
+++ flang/examples/external-hello.cpp
@@ -42,7 +42,7 @@
 }
 
 int main(int argc, const char *argv[], const char *envp[]) {
-  RTNAME(ProgramStart)(argc, argv, envp);
+  RTNAME(ProgramStart)(argc, argv, envp, nullptr);
   output1();
   input1();
   RTNAME(PauseStatement)();
Index: clang/lib/Driver/ToolChains/Flang.cpp
===================================================================
--- clang/lib/Driver/ToolChains/Flang.cpp
+++ clang/lib/Driver/ToolChains/Flang.cpp
@@ -55,7 +55,8 @@
   Args.AddAllArgs(CmdArgs,
                   {options::OPT_module_dir, options::OPT_fdebug_module_writer,
                    options::OPT_fintrinsic_modules_path, options::OPT_pedantic,
-                   options::OPT_std_EQ, options::OPT_W_Joined});
+                   options::OPT_std_EQ, options::OPT_W_Joined,
+                   options::OPT_fconvert_EQ});
 }
 
 void Flang::AddPicOptions(const ArgList &Args, ArgStringList &CmdArgs) const {
Index: clang/include/clang/Driver/Options.td
===================================================================
--- clang/include/clang/Driver/Options.td
+++ clang/include/clang/Driver/Options.td
@@ -4835,7 +4835,6 @@
 def fblas_matmul_limit_EQ : Joined<["-"], "fblas-matmul-limit=">, Group<gfortran_Group>;
 def fcheck_EQ : Joined<["-"], "fcheck=">, Group<gfortran_Group>;
 def fcoarray_EQ : Joined<["-"], "fcoarray=">, Group<gfortran_Group>;
-def fconvert_EQ : Joined<["-"], "fconvert=">, Group<gfortran_Group>;
 def ffpe_trap_EQ : Joined<["-"], "ffpe-trap=">, Group<gfortran_Group>;
 def ffree_line_length_VALUE : Joined<["-"], "ffree-line-length-">, Group<gfortran_Group>;
 def finit_character_EQ : Joined<["-"], "finit-character=">, Group<gfortran_Group>;
@@ -4936,6 +4935,8 @@
   DocBrief<[{Set column after which characters are ignored in typical fixed-form lines in the source
 file}]>;
 def ffixed_line_length_VALUE : Joined<["-"], "ffixed-line-length-">, Group<f_Group>, Alias<ffixed_line_length_EQ>;
+def fconvert_EQ : Joined<["-"], "fconvert=">, Group<f_Group>,
+  HelpText<"Set endian conversion of data for unformatted files">;
 def fopenacc : Flag<["-"], "fopenacc">, Group<f_Group>,
   HelpText<"Enable OpenACC">;
 def fdefault_double_8 : Flag<["-"],"fdefault-double-8">, Group<f_Group>,
_______________________________________________
cfe-commits mailing list
cfe-commits@lists.llvm.org
https://lists.llvm.org/cgi-bin/mailman/listinfo/cfe-commits

Reply via email to