aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--flang/include/flang/Evaluate/common.h10
-rw-r--r--flang/lib/Evaluate/check-expression.cpp8
-rw-r--r--flang/lib/Evaluate/fold-implementation.h2
-rw-r--r--flang/lib/Evaluate/fold-integer.cpp18
-rw-r--r--flang/lib/Evaluate/intrinsics.cpp5
-rw-r--r--flang/lib/Semantics/mod-file.cpp6
-rw-r--r--flang/lib/Semantics/resolve-names.cpp4
-rw-r--r--flang/module/iso_fortran_env.f9086
-rw-r--r--flang/test/Semantics/numeric_storage_size.f9040
-rw-r--r--flang/tools/f18/CMakeLists.txt15
10 files changed, 129 insertions, 65 deletions
diff --git a/flang/include/flang/Evaluate/common.h b/flang/include/flang/Evaluate/common.h
index d04c901..c2c7711 100644
--- a/flang/include/flang/Evaluate/common.h
+++ b/flang/include/flang/Evaluate/common.h
@@ -256,9 +256,11 @@ public:
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 @@ private:
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
index 7d72139..0e14aa0 100644
--- 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
index 9dd8c38..470dbe9 100644
--- 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
index 25ae483..0a6ff12 100644
--- 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
index 9b98d22..7226d69 100644
--- 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
index 5d0d210..4a531c3 100644
--- 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
index c69c702..f0198cb 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -175,7 +175,9 @@ public:
}
}
- 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
index 23e22e1..6ca98e5 100644
--- 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
new file mode 100644
index 0000000..720297c
--- /dev/null
+++ 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
index 3a31f4d..e266055 100644
--- 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}
generated by cgit v1.1 at 2024-11-14 00:55:00 +0000