[flang] Clean up ISO_FORTRAN_ENV, fix NUMERIC_STORAGE_SIZE (#87566)

klausler · web-flow · commit e1ad2735c3e7 · 2024-04-08T11:57:01.000-07:00
Address TODOs in the intrinsic module ISO_FORTRAN_ENV, and extend the implementation of NUMERIC_STORAGE_SIZE so that the calculation of its value is deferred until it is needed so that the effects of -fdefault-integer-8 or -fdefault-real-8 are reflected. Emit a warning when NUMERIC_STORAGE_SIZE is used from the module file and the default integer and real sizes do not match. Fixes #87476.
diff --git a/flang/include/flang/Evaluate/common.h b/flang/include/flang/Evaluate/common.h
@@ -256,9 +256,11 @@ class FoldingContext {
   const common::LanguageFeatureControl &languageFeatures() const {
     return languageFeatures_;
   }
-  bool inModuleFile() const { return inModuleFile_; }
-  FoldingContext &set_inModuleFile(bool yes = true) {
-    inModuleFile_ = yes;
+  std::optional<parser::CharBlock> moduleFileName() const {
+    return moduleFileName_;
+  }
+  FoldingContext &set_moduleFileName(std::optional<parser::CharBlock> n) {
+    moduleFileName_ = n;
     return *this;
   }
 
@@ -288,7 +290,7 @@ class FoldingContext {
   const IntrinsicProcTable &intrinsics_;
   const TargetCharacteristics &targetCharacteristics_;
   const semantics::DerivedTypeSpec *pdtInstance_{nullptr};
-  bool inModuleFile_{false};
+  std::optional<parser::CharBlock> moduleFileName_;
   std::map<parser::CharBlock, ConstantSubscript> impliedDos_;
   const common::LanguageFeatureControl &languageFeatures_;
   std::set<std::string> &tempNames_;
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
@@ -478,6 +478,14 @@ std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
           return {std::move(folded)};
         }
       } else if (IsNamedConstant(symbol)) {
+        if (symbol.name() == "numeric_storage_size" &&
+            symbol.owner().IsModule() &&
+            DEREF(symbol.owner().symbol()).name() == "iso_fortran_env") {
+          // Very special case: numeric_storage_size is not folded until
+          // it read from the iso_fortran_env module file, as its value
+          // depends on compilation options.
+          return {std::move(folded)};
+        }
         context.messages().Say(
             "Value of named constant '%s' (%s) cannot be computed as a constant value"_err_en_US,
             symbol.name(), folded.AsFortran());
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
@@ -1969,7 +1969,7 @@ Expr<T> FoldOperation(FoldingContext &context, Divide<T> &&x) {
       // NaN, and Inf respectively.
       bool isCanonicalNaNOrInf{false};
       if constexpr (T::category == TypeCategory::Real) {
-        if (folded->second.IsZero() && context.inModuleFile()) {
+        if (folded->second.IsZero() && context.moduleFileName().has_value()) {
           using IntType = typename T::Scalar::Word;
           auto intNumerator{folded->first.template ToInteger<IntType>()};
           isCanonicalNaNOrInf = intNumerator.flags == RealFlags{} &&
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
@@ -1302,6 +1302,24 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
     return FoldSum<T>(context, std::move(funcRef));
   } else if (name == "ubound") {
     return UBOUND(context, std::move(funcRef));
+  } else if (name == "__builtin_numeric_storage_size") {
+    if (!context.moduleFileName()) {
+      // Don't fold this reference until it appears in the module file
+      // for ISO_FORTRAN_ENV -- the value depends on the compiler options
+      // that might be in force.
+    } else {
+      auto intBytes{
+          context.targetCharacteristics().GetByteSize(TypeCategory::Integer,
+              context.defaults().GetDefaultKind(TypeCategory::Integer))};
+      auto realBytes{
+          context.targetCharacteristics().GetByteSize(TypeCategory::Real,
+              context.defaults().GetDefaultKind(TypeCategory::Real))};
+      if (intBytes != realBytes) {
+        context.messages().Say(*context.moduleFileName(),
+            "NUMERIC_STORAGE_SIZE from ISO_FORTRAN_ENV is not well-defined when default INTEGER and REAL are not consistent due to compiler options"_warn_en_US);
+      }
+      return Expr<T>{8 * std::min(intBytes, realBytes)};
+    }
   }
   return Expr<T>{std::move(funcRef)};
 }
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
@@ -903,6 +903,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
             {"back", AnyLogical, Rank::elemental, Optionality::optional},
             DefaultingKIND},
         KINDInt},
+    {"__builtin_compiler_options", {}, DefaultChar},
+    {"__builtin_compiler_version", {}, DefaultChar},
     {"__builtin_fma", {{"f1", SameReal}, {"f2", SameReal}, {"f3", SameReal}},
         SameReal},
     {"__builtin_ieee_is_nan", {{"a", AnyFloating}}, DefaultLogical},
@@ -941,8 +943,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
     {"__builtin_ieee_support_underflow_control",
         {{"x", AnyReal, Rank::elemental, Optionality::optional}},
         DefaultLogical},
-    {"__builtin_compiler_options", {}, DefaultChar},
-    {"__builtin_compiler_version", {}, DefaultChar},
+    {"__builtin_numeric_storage_size", {}, DefaultInt},
 };
 
 // TODO: Coarray intrinsic functions
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
@@ -1458,11 +1458,11 @@ Scope *ModFileReader::Read(SourceName name, std::optional<bool> isIntrinsic,
     parentScope = ancestor;
   }
   // Process declarations from the module file
-  bool wasInModuleFile{context_.foldingContext().inModuleFile()};
-  context_.foldingContext().set_inModuleFile(true);
+  auto wasModuleFileName{context_.foldingContext().moduleFileName()};
+  context_.foldingContext().set_moduleFileName(name);
   GetModuleDependences(context_.moduleDependences(), sourceFile->content());
   ResolveNames(context_, parseTree, topScope);
-  context_.foldingContext().set_inModuleFile(wasInModuleFile);
+  context_.foldingContext().set_moduleFileName(wasModuleFileName);
   if (!moduleSymbol) {
     // Submodule symbols' storage are owned by their parents' scopes,
     // but their names are not in their parents' dictionaries -- we
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
@@ -175,7 +175,9 @@ class BaseVisitor {
     }
   }
 
-  bool InModuleFile() const { return GetFoldingContext().inModuleFile(); }
+  bool InModuleFile() const {
+    return GetFoldingContext().moduleFileName().has_value();
+  }
 
   // Make a placeholder symbol for a Name that otherwise wouldn't have one.
   // It is not in any scope and always has MiscDetails.
diff --git a/flang/module/iso_fortran_env.f90 b/flang/module/iso_fortran_env.f90
@@ -6,8 +6,7 @@
 !
 !===------------------------------------------------------------------------===!
 
-! See Fortran 2018, clause 16.10.2
-! TODO: These are placeholder values so that some tests can be run.
+! See Fortran 2023, subclause 16.10.2
 
 include '../include/flang/Runtime/magic-numbers.h'
 
@@ -24,27 +23,20 @@ module iso_fortran_env
     compiler_version => __builtin_compiler_version
 
   implicit none
-
-  ! Set PRIVATE by default to explicitly only export what is meant
-  ! to be exported by this MODULE.
   private
 
   public :: event_type, notify_type, lock_type, team_type, &
     atomic_int_kind, atomic_logical_kind, compiler_options, &
     compiler_version
 
-
-  ! TODO: Use PACK([x],test) in place of the array constructor idiom
-  ! [(x, integer::j=1,COUNT([test]))] below once PACK() can be folded.
-
   integer, parameter :: &
     selectedASCII = selected_char_kind('ASCII'), &
     selectedUCS_2 = selected_char_kind('UCS-2'), &
     selectedUnicode = selected_char_kind('ISO_10646')
   integer, parameter, public :: character_kinds(*) = [ &
-    [(selectedASCII, integer :: j=1, count([selectedASCII >= 0]))], &
-    [(selectedUCS_2, integer :: j=1, count([selectedUCS_2 >= 0]))], &
-    [(selectedUnicode, integer :: j=1, count([selectedUnicode >= 0]))]]
+    pack([selectedASCII], selectedASCII >= 0), &
+    pack([selectedUCS_2], selectedUCS_2 >= 0), &
+    pack([selectedUnicode], selectedUnicode >= 0)]
 
   integer, parameter :: &
     selectedInt8 = selected_int_kind(2), &
@@ -76,19 +68,18 @@ module iso_fortran_env
 
   integer, parameter, public :: integer_kinds(*) = [ &
     selected_int_kind(0), &
-    ((selected_int_kind(k), &
-      integer :: j=1, count([selected_int_kind(k) >= 0 .and. &
-                             selected_int_kind(k) /= &
-                               selected_int_kind(k-1)])), &
-     integer :: k=1, 39)]
+    [(pack([selected_int_kind(k)], &
+           selected_int_kind(k) >= 0 .and. &
+             selected_int_kind(k) /= selected_int_kind(k-1)), &
+      integer :: k=1, 39)]]
 
   integer, parameter, public :: &
     logical8 = int8, logical16 = int16, logical32 = int32, logical64 = int64
   integer, parameter, public :: logical_kinds(*) = [ &
-    [(logical8, integer :: j=1, count([logical8 >= 0]))], &
-    [(logical16, integer :: j=1, count([logical16 >= 0]))], &
-    [(logical32, integer :: j=1, count([logical32 >= 0]))], &
-    [(logical64, integer :: j=1, count([logical64 >= 0]))]]
+    pack([logical8],  logical8 >= 0), &
+    pack([logical16], logical16 >= 0), &
+    pack([logical32], logical32 >= 0), &
+    pack([logical64], logical64 >= 0)]
 
   integer, parameter :: &
     selectedReal16 = selected_real_kind(3, 4), &      ! IEEE half
@@ -129,35 +120,40 @@ module iso_fortran_env
                     digits(real(0,kind=safeReal128)) == 113)
 
   integer, parameter, public :: real_kinds(*) = [ &
-    [(real16, integer :: j=1, count([real16 >= 0]))], &
-    [(bfloat16, integer :: j=1, count([bfloat16 >= 0]))], &
-    [(real32, integer :: j=1, count([real32 >= 0]))], &
-    [(real64, integer :: j=1, count([real64 >= 0]))], &
-    [(real80, integer :: j=1, count([real80 >= 0]))], &
-    [(real64x2, integer :: j=1, count([real64x2 >= 0]))], &
-    [(real128, integer :: j=1, count([real128 >= 0]))]]
-
-  integer, parameter, public :: current_team = -1, initial_team = -2, parent_team = -3
-
-  integer, parameter, public :: output_unit = FORTRAN_DEFAULT_OUTPUT_UNIT
-  integer, parameter, public :: input_unit = FORTRAN_DEFAULT_INPUT_UNIT
-  integer, parameter, public :: error_unit = FORTRAN_ERROR_UNIT
-  integer, parameter, public :: iostat_end = FORTRAN_RUNTIME_IOSTAT_END
-  integer, parameter, public :: iostat_eor = FORTRAN_RUNTIME_IOSTAT_EOR
-  integer, parameter, public :: iostat_inquire_internal_unit = &
-                          FORTRAN_RUNTIME_IOSTAT_INQUIRE_INTERNAL_UNIT
+    pack([real16], real16 >= 0), &
+    pack([bfloat16], bfloat16 >= 0), &
+    pack([real32], real32 >= 0), &
+    pack([real64], real64 >= 0), &
+    pack([real80], real80 >= 0), &
+    pack([real64x2], real64x2 >= 0), &
+    pack([real128], real128 >= 0)]
+
+  integer, parameter, public :: current_team = -1, &
+    initial_team = -2, &
+    parent_team = -3
 
   integer, parameter, public :: character_storage_size = 8
   integer, parameter, public :: file_storage_size = 8
-  integer, parameter, public :: numeric_storage_size = 32
 
-  integer, parameter, public :: stat_failed_image = FORTRAN_RUNTIME_STAT_FAILED_IMAGE
-  integer, parameter, public :: stat_locked = FORTRAN_RUNTIME_STAT_LOCKED
-  integer, parameter, public :: &
-    stat_locked_other_image = FORTRAN_RUNTIME_STAT_LOCKED_OTHER_IMAGE
-  integer, parameter, public :: stat_stopped_image = FORTRAN_RUNTIME_STAT_STOPPED_IMAGE
-  integer, parameter, public :: stat_unlocked = FORTRAN_RUNTIME_STAT_UNLOCKED
+  intrinsic :: __builtin_numeric_storage_size
+  ! This value depends on any -fdefault-integer-N and -fdefault-real-N
+  ! compiler options that are active when the module file is read.
+  integer, parameter, public :: numeric_storage_size = &
+    __builtin_numeric_storage_size()
+
+  ! From Runtime/magic-numbers.h:
   integer, parameter, public :: &
+    output_unit = FORTRAN_DEFAULT_OUTPUT_UNIT, &
+    input_unit = FORTRAN_DEFAULT_INPUT_UNIT, &
+    error_unit = FORTRAN_ERROR_UNIT, &
+    iostat_end = FORTRAN_RUNTIME_IOSTAT_END, &
+    iostat_eor = FORTRAN_RUNTIME_IOSTAT_EOR, &
+    iostat_inquire_internal_unit = FORTRAN_RUNTIME_IOSTAT_INQUIRE_INTERNAL_UNIT, &
+    stat_failed_image = FORTRAN_RUNTIME_STAT_FAILED_IMAGE, &
+    stat_locked = FORTRAN_RUNTIME_STAT_LOCKED, &
+    stat_locked_other_image = FORTRAN_RUNTIME_STAT_LOCKED_OTHER_IMAGE, &
+    stat_stopped_image = FORTRAN_RUNTIME_STAT_STOPPED_IMAGE, &
+    stat_unlocked = FORTRAN_RUNTIME_STAT_UNLOCKED, &
     stat_unlocked_failed_image = FORTRAN_RUNTIME_STAT_UNLOCKED_FAILED_IMAGE
 
 end module iso_fortran_env
diff --git a/flang/test/Semantics/numeric_storage_size.f90 b/flang/test/Semantics/numeric_storage_size.f90
@@ -0,0 +1,40 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s --check-prefix=CHECK
+! RUN: %flang_fc1 -fdebug-unparse -fdefault-integer-8 %s 2>&1 | FileCheck %s --check-prefix=CHECK-I8
+! RUN: %flang_fc1 -fdebug-unparse %s -fdefault-real-8 2>&1 | FileCheck %s --check-prefix=CHECK-R8
+! RUN: %flang_fc1 -fdebug-unparse %s -fdefault-integer-8 -fdefault-real-8  2>&1 | FileCheck %s --check-prefix=CHECK-I8-R8
+
+use iso_fortran_env
+
+!CHECK-NOT: warning
+!CHECK: nss = 32_4
+!CHECK-I8: warning: NUMERIC_STORAGE_SIZE from ISO_FORTRAN_ENV is not well-defined when default INTEGER and REAL are not consistent due to compiler options
+!CHECK-I8: nss = 32_4
+!CHECK-R8: warning: NUMERIC_STORAGE_SIZE from ISO_FORTRAN_ENV is not well-defined when default INTEGER and REAL are not consistent due to compiler options
+!CHECK-R8: nss = 32_4
+!CHECK-I8-R8: nss = 64_4
+integer, parameter :: nss = numeric_storage_size
+
+!CHECK: iss = 32_4
+!CHECK-I8: iss = 64_8
+!CHECK-R8: iss = 32_4
+!CHECK-I8-R8: iss = 64_8
+integer, parameter :: iss = storage_size(1)
+
+!CHECK: rss = 32_4
+!CHECK-I8: rss = 32_8
+!CHECK-R8: rss = 64_4
+!CHECK-I8-R8: rss = 64_8
+integer, parameter :: rss = storage_size(1.)
+
+!CHECK: zss = 64_4
+!CHECK-I8: zss = 64_8
+!CHECK-R8: zss = 128_4
+!CHECK-I8-R8: zss = 128_8
+integer, parameter :: zss = storage_size((1.,0.))
+
+!CHECK: lss = 32_4
+!CHECK-I8: lss = 64_8
+!CHECK-R8: lss = 32_4
+!CHECK-I8-R8: lss = 64_8
+integer, parameter :: lss = storage_size(.true.)
+end
diff --git a/flang/tools/f18/CMakeLists.txt b/flang/tools/f18/CMakeLists.txt
@@ -17,8 +17,6 @@ set(MODULES
   "ieee_features"
   "iso_c_binding"
   "iso_fortran_env"
-  "__fortran_builtins"
-  "__fortran_type_info"
 )
 
 # Create module files directly from the top-level module source directory.
@@ -27,22 +25,20 @@ set(MODULES
 # can't be used for generating module files.
 if (NOT CMAKE_CROSSCOMPILING)
   foreach(filename ${MODULES})
-    set(base ${FLANG_INTRINSIC_MODULES_DIR}/${filename})
-    if(${filename} STREQUAL "__fortran_builtins")
-      set(depends "")
-    elseif(${filename} STREQUAL "__ppc_types")
-      set(depends "")
+    set(depends "")
+    if(${filename} STREQUAL "__fortran_builtins" OR
+       ${filename} STREQUAL "__ppc_types")
     elseif(${filename} STREQUAL "__ppc_intrinsics" OR
            ${filename} STREQUAL "mma")
       set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__ppc_types.mod)
     else()
       set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_builtins.mod)
       if(NOT ${filename} STREQUAL "__fortran_type_info")
-        set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_type_info.mod)
+        set(depends ${depends} ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_type_info.mod)
       endif()
       if(${filename} STREQUAL "ieee_arithmetic" OR
          ${filename} STREQUAL "ieee_exceptions")
-        set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_ieee_exceptions.mod)
+        set(depends ${depends} ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_ieee_exceptions.mod)
       endif()
     endif()
 
@@ -58,6 +54,7 @@ if (NOT CMAKE_CROSSCOMPILING)
       endif()
     endif()
 
+    set(base ${FLANG_INTRINSIC_MODULES_DIR}/${filename})
     # TODO: We may need to flag this with conditional, in case Flang is built w/o OpenMP support
     add_custom_command(OUTPUT ${base}.mod
       COMMAND ${CMAKE_COMMAND} -E make_directory ${FLANG_INTRINSIC_MODULES_DIR}

Original file line number	Diff line number	Diff line change
`@@ -175,7 +175,9 @@ class BaseVisitor {`
`175`	`175`	`}`
`176`	`176`	`}`
`177`	`177`
`178`		`- bool InModuleFile() const { return GetFoldingContext().inModuleFile(); }`
	`178`	`+ bool InModuleFile() const {`
	`179`	`+ return GetFoldingContext().moduleFileName().has_value();`
	`180`	`+ }`
`179`	`181`
`180`	`182`	`// Make a placeholder symbol for a Name that otherwise wouldn't have one.`
`181`	`183`	`// It is not in any scope and always has MiscDetails.`