Merge pull request #243 from Goddard-Fortran-Ecosystem/feature/#242-v…

…ector-based-set

Fixes #242 - New container "alt_set".

.github/workflows/main.yml

@@ -77,7 +77,7 @@ jobs:
       - name: Build Tests
         run: |
           cd build
-          make -j4 tests
+          make -j4 tests || ctest -j1 --output-on-failure --repeat until-pass:4
 
       - name: Run Tests
         run: |
@@ -153,7 +153,7 @@ jobs:
       - name: Build Tests
         run: |
           cd build
-          make -j4 tests
+          make -j4 tests || ctest -j1 --output-on-failure --repeat until-pass:4
 
       - name: Run Tests
         run: |
@@ -209,7 +209,7 @@ jobs:
       - name: Build Tests
         run: |
           cd build
-          make -j4 tests
+          make -j4 tests || ctest -j1 --output-on-failure --repeat until-pass:4
 
       - name: Run Tests
         run: |
@@ -265,7 +265,7 @@ jobs:
       - name: Build Tests
         run: |
           cd build
-          make -j4 tests
+          make -j4 tests || ctest -j1 --output-on-failure --repeat until-pass:4
 
       - name: Run Tests
         run: |

ChangeLog.MD

@@ -9,6 +9,15 @@
 
 ### Added
 
+- Introduced new container "alt_set".  Interfaces are the same as "set" but underlying implementation uses vectors of indices rather than pointers.  The hope is that this will result in fewer compiler bugs related to deep copies of structures with self-referential pointers.
+- Optional FPP setting `USE_ALT_SET` to enable map containter to use `alt_set` instead of `set` under-the-hood.
+
+### Fixed
+
+- missing `TARGET` in some container interfaces.  Spotted during introducition of "alt_set" container.
+
+### Added
+
 - Preliminary LLVMFlang support
 - Added missing TARGET attribute in map::erase() procedures.  When
   used with NAG compiler, would result in temporary objects with

include/v2/CMakeLists.txt

@@ -26,7 +26,7 @@ endif()
 add_subdirectory(shared)
 add_subdirectory(parameters)
 
-foreach (template ptr pair vector deque queue stack set map ordered_map algorithms)
+foreach (template ptr pair vector deque queue stack set alt_set map ordered_map algorithms)
   install (DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}/${template} DESTINATION "${dest}/include/v2"
     PATTERN CMakeLists.txt EXCLUDE
     PATTERN *~ EXCLUDE

include/v2/algorithms/find/procedures.inc

@@ -1,4 +1,6 @@
 #ifdef __T_EQ__
+
+
       function __MANGLE(find_basic)(first, last, value) result(iter)
          type(__iterator) :: iter
          type(__iterator), intent(in) :: first

include/v2/algorithms/procedures.inc

@@ -9,11 +9,12 @@
 
 
 #ifdef __algorithm_riterator
-#  define __iterator __algorithm_riterator
 #  define __guard __IDENTITY(__algorithm_guard)reverse_
+#  define __iterator __algorithm_riterator
 #  include "algorithms/dir_procedures.inc"
-#  undef __guard
 #  undef __iterator
+#  undef __guard
+# undef __tmp
 #endif
 
 #include "parameters/T/undef_derived_macros.inc"

include/v2/alt_set/header.inc

@@ -0,0 +1,8 @@
+#include "shared/define_common_macros.inc"
+#include "parameters/T/copy_T_to_alt_set_T.inc"
+
+#define __alt_set alt_set
+#define __alt_set_value_compare alt_set_ValueCompare
+#define __alt_set_iterator alt_set_Iterator
+#define __alt_set_guard alt_set_
+

include/v2/alt_set/iterator_procedures.inc

@@ -0,0 +1,206 @@
+   ! =======================
+   !  iter_of
+   ! =======================
+   function __MANGLE(iter_of)(this) result(value)
+      class(__alt_set_iterator), intent(in) :: this
+      __T_declare_result__, pointer :: value
+
+      print*,__FILE__,__LINE__
+      value => null()
+      print*,__FILE__,__LINE__, this%current
+      print*,__FILE__,__LINE__, __MANGLE(exists)(this%current)
+      print*,__FILE__,__LINE__, associated(this%tree)
+      if (__MANGLE(exists)(this%current)) then
+         value  => this%tree%items%of(this%current)
+      end if
+      print*,__FILE__,__LINE__
+   end function __MANGLE(iter_of)
+
+   ! =======================
+   !  iter_next
+   ! =======================
+   subroutine __MANGLE(iter_next)(this)
+      class(__alt_set_iterator), intent(inout) :: this
+
+      call this%tree%advpos(this%current, __RIGHT)
+
+   end subroutine __MANGLE(iter_next)
+
+   ! =======================
+   !  iter_prev
+   ! =======================
+   subroutine __MANGLE(iter_prev)(this)
+      class(__alt_set_iterator), intent(inout) :: this
+
+      call this%tree%advpos(this%current, __LEFT)
+
+   end subroutine __MANGLE(iter_prev)
+
+   ! =======================
+   !  equalIters
+   ! =======================
+   logical function __MANGLE(iter_equal)(a, b) result(eq)
+      type(__alt_set_iterator), intent(in) :: a
+      type(__alt_set_iterator), intent(in) :: b
+
+      eq = (a%current == b%current)
+
+   end function __MANGLE(iter_equal)
+
+   ! =======================
+   !  nequal
+   ! =======================
+   logical function __MANGLE(iter_not_equal)(a, b) result(ne)
+      implicit none
+      class(__alt_set_iterator), intent(in) :: a, b
+
+      ne = .not. (a == b)
+
+   end function __MANGLE(iter_not_equal)
+
+
+   subroutine __MANGLE(iter_advance_size_kind)(it, n)
+      type(__alt_set_iterator), intent(inout) :: it
+      integer(kind=__gftl_size_kind), intent(in) :: n
+
+      integer :: i
+
+      do i = 1, n
+         call it%next()
+      end do
+
+      return
+   end subroutine __MANGLE(iter_advance_size_kind)
+
+   subroutine __MANGLE(iter_advance_default)(it, n)
+      type(__alt_set_iterator), intent(inout) :: it
+      integer, intent(in) :: n
+
+      integer :: i
+
+      do i = 1, n
+         call it%next()
+      end do
+
+      return
+   end subroutine __MANGLE(iter_advance_default)
+
+
+   function __MANGLE(iter_begin)(cont) result(begin)
+      type(__alt_set_iterator) :: begin
+      type(__alt_set), target, intent(in) :: cont
+
+      begin = cont%begin()
+
+      return
+   end function __MANGLE(iter_begin)
+
+
+
+   function __MANGLE(iter_end)(cont) result(end)
+      type(__alt_set_iterator) :: end
+      type(__alt_set), target, intent(in) :: cont
+
+      end = cont%end()
+
+   end function __MANGLE(iter_end)
+
+
+   function __MANGLE(iter_ftn_begin)(cont) result(begin)
+      type(__alt_set_iterator) :: begin
+      type(__alt_set), target, intent(in) :: cont
+
+      begin = cont%ftn_begin()
+
+      return
+   end function __MANGLE(iter_ftn_begin)
+
+
+
+   function __MANGLE(iter_ftn_end)(cont) result(end)
+      type(__alt_set_iterator) :: end
+      type(__alt_set), target, intent(in) :: cont
+
+      end = cont%ftn_end()
+
+   end function __MANGLE(iter_ftn_end)
+
+
+   function __MANGLE(iter_next_1)(it) result(new_it)
+      type(__alt_set_iterator) :: new_it
+      type(__alt_set_iterator), intent(in) :: it
+
+      new_it = next(it,1)
+
+      return
+   end function __MANGLE(iter_next_1)
+
+   function __MANGLE(iter_next_n_size_kind)(it, n) result(new_it)
+      type(__alt_set_iterator) :: new_it
+      type(__alt_set_iterator), intent(in) :: it
+      integer(kind=__gftl_size_kind), intent(in) :: n
+
+      integer :: i
+
+      new_it = it
+      do i = 1, n
+         call new_it%next()
+      end do
+
+      return
+   end function __MANGLE(iter_next_n_size_kind)
+
+   function __MANGLE(iter_next_n_default)(it, n) result(new_it)
+      type(__alt_set_iterator) :: new_it
+      type(__alt_set_iterator), intent(in) :: it
+      integer, intent(in) :: n
+
+      integer :: i
+
+      new_it = it
+      do i = 1, n
+         call new_it%next()
+      end do
+
+      return
+   end function __MANGLE(iter_next_n_default)
+
+   function __MANGLE(iter_prev_1)(it) result(new_it)
+      type(__alt_set_iterator) :: new_it
+      type(__alt_set_iterator), intent(in) :: it
+
+      new_it = prev(it,1)
+
+      return
+   end function __MANGLE(iter_prev_1)
+
+   function __MANGLE(iter_prev_n_size_kind)(it, n) result(new_it)
+      type(__alt_set_iterator) :: new_it
+      type(__alt_set_iterator), intent(in) :: it
+      integer(kind=__gftl_size_kind), intent(in) :: n
+
+      integer :: i
+
+      new_it = it
+      do i = 1, n
+         call new_it%prev()
+      end do
+
+      return
+   end function __MANGLE(iter_prev_n_size_kind)
+
+   function __MANGLE(iter_prev_n_default)(it, n) result(new_it)
+      type(__alt_set_iterator) :: new_it
+      type(__alt_set_iterator), intent(in) :: it
+      integer, intent(in) :: n
+
+      integer :: i
+
+      new_it = it
+      do i = 1, n
+         call new_it%prev()
+      end do
+
+      return
+   end function __MANGLE(iter_prev_n_default)
+

include/v2/alt_set/iterator_specification.inc

@@ -0,0 +1,60 @@
+
+
+   type :: __alt_set_iterator
+      private
+      type(__alt_set), pointer :: tree => null()
+      integer(kind=GFTL_SIZE_KIND) :: current = -1
+!#      type(__alt_set_node), pointer :: node => null()
+   contains
+      procedure :: of => __MANGLE(iter_of)
+      procedure :: next => __MANGLE(iter_next)
+      procedure :: prev => __MANGLE(iter_prev)
+   end type __alt_set_iterator
+
+   interface operator(==)
+      module procedure __MANGLE(iter_equal)
+   end interface operator(==)
+
+   interface operator(/=)
+      module procedure __MANGLE(iter_not_equal)
+   end interface operator(/=)
+
+   interface advance
+#ifndef  __gftl_disable_index_kind_overload
+      module procedure __MANGLE(iter_advance_size_kind)
+#endif
+      module procedure __MANGLE(iter_advance_default)
+   end interface advance
+
+   interface begin
+      module procedure __MANGLE(iter_begin)
+   end interface begin
+
+   interface end
+      module procedure __MANGLE(iter_end)
+   end interface end
+
+   interface ftn_begin
+      module procedure __MANGLE(iter_ftn_begin)
+   end interface ftn_begin
+
+   interface ftn_end
+      module procedure __MANGLE(iter_ftn_end)
+   end interface ftn_end
+
+   interface next
+      module procedure __MANGLE(iter_next_1)
+#ifndef  __gftl_disable_index_kind_overload
+      module procedure __MANGLE(iter_next_n_size_kind)
+#endif
+      module procedure __MANGLE(iter_next_n_default)
+   end interface next
+
+   interface prev
+      module procedure __MANGLE(iter_prev_1)
+#ifndef __gftl_disable_index_kind_overload
+      module procedure __MANGLE(iter_prev_n_size_kind)
+#endif
+      module procedure __MANGLE(iter_prev_n_default)
+   end interface prev
+