GitFlow

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

ChangeLog.md

@@ -9,6 +9,14 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ### Fixed
 
+- Workaround additional polymorphic assignment bug in gfortran 13.2 (in build_locks)
+
+## [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
 
 ### Fixed

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,15 +1036,15 @@ 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
 
          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

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

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.

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