From e856c54f8900c7ed9dd63948be541b696f7db1af Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 12 Mar 2024 17:09:18 -0400 Subject: [PATCH 1/4] Fix MockMpi. --- ChangeLog.md | 2 ++ src/MockMpi.F90 | 4 ++-- tests/Test_MpiCommConfig.pf | 10 ++++++---- tests/Test_MpiFormatter.pf | 10 +++++++--- 4 files changed, 17 insertions(+), 9 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 8ecb362..9f65ddd 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -9,6 +9,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Another fix for MockMpi layer. With the workaround for NAG in previous release, GFortran 13 detects some inconsistencies that are now resolved. + ## [1.13.1] - 2024-03-07 ### Fixed diff --git a/src/MockMpi.F90 b/src/MockMpi.F90 index d5a0fcc..5c549e8 100644 --- a/src/MockMpi.F90 +++ b/src/MockMpi.F90 @@ -19,8 +19,8 @@ module mpi public :: MPI_ANY_SOURCE integer, parameter :: MPI_ADDRESS_KIND = INT64 - integer, parameter :: MPI_STATUS_SIZE = 1 - integer, parameter :: MPI_STATUS_IGNORE(MPI_STATUS_SIZE) = [0] + integer, parameter :: MPI_STATUS_SIZE = 6 + integer, parameter :: MPI_STATUS_IGNORE(MPI_STATUS_SIZE) = spread(0, dim=1, ncopies=MPI_STATUS_SIZE) integer, parameter :: MPI_LOGICAL = 9 integer, parameter :: MPI_SUCCESS = 0 integer, parameter :: MPI_INFO_NULL = 0 diff --git a/tests/Test_MpiCommConfig.pf b/tests/Test_MpiCommConfig.pf index 1434e6e..87923c2 100644 --- a/tests/Test_MpiCommConfig.pf +++ b/tests/Test_MpiCommConfig.pf @@ -1,16 +1,15 @@ module Test_MpiCommConfig - use mpi use funit use PFL_MpiCommConfig use gftl2_StringUnlimitedMap, only: StringUnlimitedMap use PFL_FormatString implicit none - contains @test subroutine test_default() + use mpi ! use mpi_comm_world if necessary. ! Note that the usage is ! read-only, so does not violate encapsulation of MPI @@ -35,7 +34,8 @@ contains @test subroutine test_override_keywords() - ! use mpi_comm_world if necessary. + use mpi + ! use mpi_comm_world if necessary. ! Note that the usage is ! read-only, so does not violate encapsulation of MPI ! communicators. @@ -58,7 +58,8 @@ contains @test subroutine test_with_comm() - ! Note this test is a bit weak, as the mock layer does not actually + use mpi + ! Note this test is a bit weak, as the mock layer does not actually ! use comm. But it ensures the interface is in place, ! and the implementation is trivial extension. character(len=:), allocatable :: s @@ -80,6 +81,7 @@ contains @test subroutine test_with_multi_comm() + use mpi ! Note this test is a bit weak, as the mock layer does not actually ! use comm. But it ensures the interface is in place, ! and the implementation is trivial extension. diff --git a/tests/Test_MpiFormatter.pf b/tests/Test_MpiFormatter.pf index 3d97153..150c8c8 100644 --- a/tests/Test_MpiFormatter.pf +++ b/tests/Test_MpiFormatter.pf @@ -1,6 +1,5 @@ module Test_MpiFormatter use funit - use mpi use PFL_MpiFormatter use PFL_LogRecord use PFL_SeverityLevels @@ -10,6 +9,7 @@ contains @test subroutine test_no_reference() + use mpi type (MpiFormatter) :: f type (LogRecord) :: rec integer :: comm ! not really used due to mock @@ -24,6 +24,7 @@ contains @test subroutine test_one_comm() + use mpi type (MpiFormatter) :: f type (LogRecord) :: rec @@ -43,7 +44,8 @@ contains @test subroutine test_multi_comm() - type (MpiFormatter) :: f + use mpi + type (MpiFormatter) :: f type (LogRecord) :: rec integer :: comm = 1 ! not really used due to mock @@ -62,6 +64,7 @@ contains @test subroutine test_multi_comm_default_fmt() + use mpi type (MpiFormatter) :: f type (LogRecord) :: rec @@ -80,7 +83,8 @@ contains @test subroutine test_alt_names() - type (MpiFormatter) :: f + use mpi + type (MpiFormatter) :: f type (LogRecord) :: rec character(len=:), allocatable :: fmt From 93cf48f135a864bbcc9fd3ac425545da644864ee Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Wed, 13 Mar 2024 10:09:58 -0400 Subject: [PATCH 2/4] Release details. --- CMakeLists.txt | 2 +- ChangeLog.md | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index ea7bd45..1399296 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -20,7 +20,7 @@ # ------------------------------------------------------------------------ # cmake_minimum_required (VERSION 3.12) project (PFLOGGER - VERSION 1.13.1 + VERSION 1.13.2 LANGUAGES Fortran) set (CMAKE_MODULE_PATH diff --git a/ChangeLog.md b/ChangeLog.md index 9f65ddd..7177f57 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -9,6 +9,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +## [1.13.2] - 2024-03-13 + - Another fix for MockMpi layer. With the workaround for NAG in previous release, GFortran 13 detects some inconsistencies that are now resolved. ## [1.13.1] - 2024-03-07 From b89b3a15fe188838e790ada2805d3845362342d6 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Wed, 13 Mar 2024 10:12:09 -0400 Subject: [PATCH 3/4] Update ChangeLog.md --- ChangeLog.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 7177f57..9acee31 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -7,10 +7,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] -### Fixed - ## [1.13.2] - 2024-03-13 +### Fixed + - Another fix for MockMpi layer. With the workaround for NAG in previous release, GFortran 13 detects some inconsistencies that are now resolved. ## [1.13.1] - 2024-03-07 From 2d7fe2117e88e6cbbd94c23861c8ef3df609af0b Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 22 Mar 2024 09:37:37 -0400 Subject: [PATCH 4/4] Fix another polymorphic assignment bug in gfortran 13.2 --- ChangeLog.md | 4 +++ src/Config.F90 | 66 ++++++++++++++++++++++++++------------------------ 2 files changed, 38 insertions(+), 32 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 9acee31..58ef83f 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -7,6 +7,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] +### Fixed + +- Workaround additional polymorphic assignment bug in gfortran 13.2 (in build_locks) + ## [1.13.2] - 2024-03-13 ### Fixed diff --git a/src/Config.F90 b/src/Config.F90 index e897069..a202a2c 100644 --- a/src/Config.F90 +++ b/src/Config.F90 @@ -18,7 +18,7 @@ module PFL_Config use PFL_Formatter use PFL_Filterer use PFL_FileHandler - + use gFTL2_StringUnlimitedMap use PFL_Filter use PFL_StringUtilities, only: to_lower_case @@ -77,7 +77,7 @@ subroutine build_formatters(this, cfg, unusable, extra, rc) class(NodeIterator), allocatable :: iter class (Formatter), allocatable :: f character(:), allocatable :: formatter_name - + integer :: status _ASSERT(cfg%is_mapping(), "PFL::Config::build_formatters() - input cfg not a mapping", rc) @@ -123,7 +123,7 @@ subroutine build_formatter(fmtr, cfg, unusable, extra, global_communicator, rc) select case (class_name) case ('Formatter') call build_basic_formatter(fmtr, cfg, _RC) -#ifdef _LOGGER_USE_MPI +#ifdef _LOGGER_USE_MPI case ('MpiFormatter') if (present(extra)) then extra_ = extra @@ -287,7 +287,7 @@ subroutine build_mpi_formatter(fmtr, cfg, unusable, extra, rc) _RETURN(_SUCCESS,rc) end subroutine build_mpi_formatter #endif - + subroutine build_locks(this, cfg, unusable, extra, rc) use PFL_AbstractLock #ifdef _LOGGER_USE_MPI @@ -304,7 +304,7 @@ subroutine build_locks(this, cfg, unusable, extra, rc) character(:), allocatable :: lock_name class (AbstractLock), allocatable :: lock integer :: status - + _ASSERT(cfg%is_mapping(), "PFL::Config::build_locks() - input cfg not a mapping", rc) associate (b => cfg%begin(), e => cfg%end()) @@ -313,7 +313,9 @@ subroutine build_locks(this, cfg, unusable, extra, rc) lock_name = to_string(iter%first(), _RC) subcfg => iter%second() - lock = build_lock(subcfg, extra=extra, _RC) + !lock = build_lock(subcfg, extra=extra, _RC) + allocate(lock, source=build_lock(subcfg, extra=extra, rc=status)) + _VERIFY(status,'',rc) call this%locks%insert(lock_name, lock) call iter%next() end do @@ -376,7 +378,7 @@ subroutine build_filters(this, cfg, unusable, extra, rc) associate (b => cfg%begin(), e => cfg%end()) iter = b - + do while (iter /= e) filter_name = to_string(iter%first(), _RC) @@ -407,7 +409,7 @@ function build_filter(cfg, unusable, extra, rc) result(f) character(len=:), allocatable :: class_name integer :: status - + _ASSERT(cfg%is_mapping(), "PFL::Config::build_formatter() - input cfg not a mapping", rc) if (cfg%has('class')) then @@ -420,12 +422,12 @@ function build_filter(cfg, unusable, extra, rc) result(f) case ('filter') allocate(f, source=build_basic_filter(cfg, rc=status)) _VERIFY(status, '', rc) - + case ('levelfilter') allocate(f, source=build_LevelFilter(cfg, rc=status)) _VERIFY(status, '', rc) - -#ifdef _LOGGER_USE_MPI + +#ifdef _LOGGER_USE_MPI case ('mpifilter') allocate(f, source=build_MpiFilter(cfg, extra=extra, rc=status)) _VERIFY(status, '', rc) @@ -443,7 +445,7 @@ function build_basic_filter(cfg, rc) result(f) type (Filter) :: f class(YAML_Node), intent(in) :: cfg integer, optional, intent(out) :: rc - + character(len=:), allocatable :: name integer :: status @@ -461,18 +463,18 @@ function build_LevelFilter(cfg, rc) result(f) type (LevelFilter) :: f class(YAML_Node), intent(in) :: cfg integer, optional, intent(out) :: rc - + integer :: min_level, max_level integer :: status min_level = get_level('min_level', _RC) max_level = get_level('max_level', _RC) - + f = LevelFilter(min_level, max_level) - + _RETURN(_SUCCESS,rc) contains - + integer function get_level(key, rc) result(level) character(len=*), intent(in) :: key integer, optional, intent(out) :: rc @@ -493,7 +495,7 @@ integer function get_level(key, rc) result(level) _RETURN(_SUCCESS,rc) end function get_level - + end function build_LevelFilter #ifdef _LOGGER_USE_MPI @@ -504,7 +506,7 @@ function build_MpiFilter(cfg, unusable, extra, rc) result(f) class (KeywordEnforcer), optional, intent(in) :: unusable type (StringUnlimitedMap), optional, intent(in) :: extra integer, optional, intent(out) :: rc - + character(len=:), allocatable :: comm_name integer :: comm integer :: rank, root, ierror @@ -528,7 +530,7 @@ function build_MpiFilter(cfg, unusable, extra, rc) result(f) _UNUSED_DUMMY(unusable) end function build_MpiFilter #endif - + subroutine build_handlers(this, cfg, unusable, extra, rc) class (ConfigElements), intent(inout) :: this @@ -558,7 +560,7 @@ subroutine build_handlers(this, cfg, unusable, extra, rc) _RETURN(_SUCCESS,rc) end subroutine build_handlers - + subroutine build_handler(h, cfg, elements, unusable, extra, rc) class (AbstractHandler), allocatable, intent(out) :: h class(YAML_Node), intent(inout) :: cfg @@ -568,7 +570,7 @@ subroutine build_handler(h, cfg, elements, unusable, extra, rc) integer, optional, intent(out) :: rc integer :: status - + call allocate_concrete_handler(h, cfg, _RC) call set_handler_level(h, cfg, _RC) call set_handler_formatter(h, cfg, elements%formatters, _RC) @@ -600,11 +602,11 @@ subroutine allocate_concrete_handler(h, cfg, rc) case ('filehandler') call build_filehandler(fh, cfg) allocate(h, source=fh) -#ifdef _LOGGER_USE_MPI +#ifdef _LOGGER_USE_MPI case ('mpifilehandler') call build_mpifilehandler(fh, cfg) allocate(h, source=fh) -#endif +#endif case default _ASSERT(.false., "PFL::Config::build_handler() - unsupported class: '" // class_name //"'.", rc) end select @@ -614,7 +616,7 @@ end subroutine allocate_concrete_handler subroutine set_handler_level(h, cfg, rc) class (AbstractHandler), intent(inout) :: h class(YAML_Node), intent(in) :: cfg - integer, optional, intent(out) :: rc + integer, optional, intent(out) :: rc character(len=:), allocatable :: level_name integer :: level @@ -638,7 +640,7 @@ subroutine set_handler_level(h, cfg, rc) _RETURN(_SUCCESS,rc) end subroutine set_handler_level - + subroutine set_handler_formatter(h, cfg, formatters, rc) use PFL_Formatter @@ -726,7 +728,7 @@ subroutine set_handler_lock(h, cfg, locks, rc) end if _RETURN(_SUCCESS,rc) end subroutine set_handler_lock - + end subroutine build_handler @@ -893,8 +895,8 @@ subroutine build_mpifilehandler(h, cfg, unusable, extra, rc) end if h = FileHandler(fileName, delay=delay) - - _RETURN(_SUCCESS,rc) + + _RETURN(_SUCCESS,rc) end subroutine build_mpifilehandler #endif @@ -990,7 +992,7 @@ subroutine set_logger_propagate(lgr, cfg, rc) _RETURN(_SUCCESS,rc) end subroutine set_logger_propagate - + subroutine set_logger_filters(lgr, cfg, filters, unusable, extra, rc) class (Logger), intent(inout) :: lgr @@ -1034,7 +1036,7 @@ subroutine set_logger_handlers(lgr, cfg, handlers, unusable, extra, rc) type (StringUnlimitedMap), optional, intent(in) :: extra integer, optional, intent(out) :: rc - character(len=:), allocatable :: handler_name + character(len=:), allocatable :: handler_name class(YAML_Node), pointer :: subcfg integer :: i integer :: status @@ -1042,7 +1044,7 @@ subroutine set_logger_handlers(lgr, cfg, handlers, unusable, extra, rc) if (cfg%has('handlers')) then subcfg => cfg%of('handlers') _ASSERT(cfg%has('handlers'), "PFL::Config::set_logger_handlers() - expected sequence for 'handlers' key.", rc) - + do i = 1, subcfg%size() call subcfg%get(handler_name, i, _RC) @@ -1145,7 +1147,7 @@ subroutine set_global_communicator(this, comm) class (ConfigElements), intent(inout) :: this integer, optional, intent(in) :: comm -#ifdef _LOGGER_USE_MPI +#ifdef _LOGGER_USE_MPI if (present(comm)) then this%global_communicator = comm else