- Patched (again) such that the assignment operator for Set invokes a…

… deep copy. Previously I mistakenly thought that since the data structure now uses ALLOCATABLE components that Fortran intrinsic assignment would suffice. But forgot that the "parent" component is still a pointer. Failures from this assumption were subtle as often parents would point to correctly looking copies outside the intended data structure.

- Missing RECURSIVE declarations on some procedures.  The issue arises for YAML data structures where a map may contain items of the same map type and similarly for vectors.

- A verify() method was added to several containers to aid in debugging some of the problems mentioned above.   Users of gFTL should not use this method - its interface may change and the procedure may even disappear in later releases.

CMakeLists.txt

@@ -4,7 +4,7 @@ if (COMMAND cmake_policy)
 endif (COMMAND cmake_policy)
 
 project (GFTL
-  VERSION 1.7.1
+  VERSION 1.7.2
   LANGUAGES NONE)
 
 if (CMAKE_INSTALL_PREFIX_INITIALIZED_TO_DEFAULT)

ChangeLog.MD

@@ -2,6 +2,17 @@
 
 ## Unreleased
 
+### Fixed
+
+- Patched (again) such that the assignment operator for Set invokes a deep copy.  Previously I mistakenly thought that since the data structure now uses ALLOCATABLE components that Fortran intrinsic assignment would suffice.  But forgot that the "parent" component is still a pointer.  Failures from this assumption were subtle as often parents would point to   correctly looking copies outside the intended data structure.
+
+- Missing RECURSIVE declarations on some procedures.  The issue arises for YAML data structures where a map may contain items of the same map type and similarly for vectors.
+
+### Added
+
+- A verify() method was added to several containers to aid in debugging some of the problems mentioned above.   Users of gFTL should not use this method - its interface may change and the procedure may even disappear in later releases.
+
+
 ## [1.7.1] - 2022-04-24
 
 ### Fixed

include/v1/templates/unused.inc

@@ -7,4 +7,8 @@
 ! Licensed under the Apache License, Version 2.0.                   |
 !--------------------------------------------------------------------
 
+#ifdef _UNUSED_DUMMY
+#  undef _UNUSED_DUMMY
+#endif
+
 #define _UNUSED_DUMMY(dummy) if (.false.) print*,shape(dummy)

include/v2/map/iterator_procedures.inc

@@ -73,7 +73,7 @@
 ! =======================
 !  next
 ! =======================
-      subroutine __MANGLE(iter_next)(this)
+      recursive subroutine __MANGLE(iter_next)(this)
          class(__map_iterator), intent(inout) :: this
 
          call this%set_iter%next()

include/v2/map/procedures.inc

@@ -1,3 +1,9 @@
+#ifdef _DEPTH_
+#  undef _DEPTH_
+#endif
+
+#define _DEPTH_ *
+
 !--------------------------------------------------------------------
 ! Copyright © 2020 United States Government as represented by the   |
 ! Administrator of the National Aeronautics and Space               |
@@ -42,13 +48,13 @@
 #define __set_T __map_pair
 #define __set_T_LT(a,b) __IDENTITY(__map_guard)__IDENTITY(key_less_than)(a,b)
 #define __set_guard __IDENTITY(__map_guard)__IDENTITY(s_)
-
 #include "set/procedures.inc"
 
 #undef __set
 #undef __set_iterator
 #include "parameters/T/undef_set_T.inc"
 #undef __set_guard
+#undef __set_T_COPY
 
 #include "parameters/T1/undef_pair_T1.inc"   
 #include "parameters/T2/undef_pair_T2.inc"   
@@ -128,101 +134,112 @@
 ! =======================
 !  insert
 ! =======================
-      subroutine __MANGLE(insert_key_value)(this, key, value)
+      recursive subroutine __MANGLE(insert_key_value)(this, key, value)
          class (__map), intent(inout) :: this
          __Key_declare_dummy__, intent(in) :: key
-         __T_declare_dummy__, intent(in) :: value
+         __T_declare_dummy__, target, intent(in) :: value
+
+         integer :: sz
+
+         integer, save :: depth = 0
 
          type (__map_pair) :: p
 
+         depth = depth + 1
          __Key_COPY__(p%first, key)
          __T_COPY__(p%second, value)
 
+         sz = this%size()
          call this%tree%insert(p)
+         depth = depth - 1
 
       end subroutine __MANGLE(insert_key_value)
 
 
-      subroutine __MANGLE(insert_pair)(this, p)
+      recursive subroutine __MANGLE(insert_pair)(this, p)
          class (__map), intent(inout) :: this
          type (__map_pair), intent(in) :: p
 
+         integer, save :: depth = 0
+
+         depth = depth + 1
          call this%tree%insert(p)
 
+         depth = depth - 1
       end subroutine __MANGLE(insert_pair)
 
-! =======================
-!  set
-! =======================
+      ! =======================
+      !  set
+      ! =======================
       subroutine __MANGLE(set_)(this, key, value)
-      class(__map), intent(inout) :: this
-      __Key_declare_dummy__, intent(in) :: key
-      __T_declare_dummy__, intent(in) :: value
-      type(__map_pair) :: p
+         class(__map), intent(inout) :: this
+         __Key_declare_dummy__, intent(in) :: key
+         __T_declare_dummy__, intent(in) :: value
+         type(__map_pair) :: p
 
-      __Key_COPY__(p%first, key)
-      __T_COPY__(p%second, value)
+         __Key_COPY__(p%first, key)
+         __T_COPY__(p%second, value)
 
-      call this%tree%insert(p)
-      return
+         call this%tree%insert(p)
+         return
 
       end subroutine __MANGLE(set_)
 
-! =======================
-!  of - grows map if key does not exist
-!  Analog of C++ [] operator.
-! =======================
+      ! =======================
+      !  of - grows map if key does not exist
+      !  Analog of C++ [] operator.
+      ! =======================
       function __MANGLE(of)(this, key) result(res)
-      class(__map), target, intent(inout) :: this
-      __Key_declare_dummy__, intent(in) :: key
-      __T_declare_result__, pointer :: res
-      type(__map_pair) :: p
+         class(__map), target, intent(inout) :: this
+         __Key_declare_dummy__, intent(in) :: key
+         __T_declare_result__, pointer :: res
+         type(__map_pair) :: p
 
-      logical :: is_new
-      type(__MANGLE(SetIterator)) :: iter
-      type(__map_pair), pointer :: pair_ptr
+         logical :: is_new
+         type(__MANGLE(SetIterator)) :: iter
+         type(__map_pair), pointer :: pair_ptr
 
-      __Key_COPY__(p%first, key)
+         __Key_COPY__(p%first, key)
 
-      call this%tree%insert(p, iter=iter, is_new=is_new)
-      if (.not. is_new) then
-         pair_ptr => iter%of()
-         res => pair_ptr%second
-      else
-         res => null()
-      end if
+         call this%tree%insert(p, iter=iter, is_new=is_new)
+         if (.not. is_new) then
+            pair_ptr => iter%of()
+            res => pair_ptr%second
+         else
+            res => null()
+         end if
 
-      return
+         return
       end function __MANGLE(of)
 
-! =======================
-!  at
-! =======================
+      ! =======================
+      !  at
+      ! =======================
       function __MANGLE(at_rc)(this, key, rc) result(res)
-      __T_declare_result__, pointer :: res
-      class(__map), target, intent(in) :: this
-      __Key_declare_dummy__, intent(in) :: key
-      integer, intent(out) :: rc
-
-      type (__map_iterator) :: iter
-
-      iter = this%find(key)
-      if (iter == this%end()) then
-         res => null()
-         rc = OUT_OF_RANGE
-      else
-         res => iter%second()
-         rc = SUCCESS
-      end if
+         __T_declare_result__, pointer :: res
+         class(__map), target, intent(in) :: this
+         __Key_declare_dummy__, intent(in) :: key
+         integer, intent(out) :: rc
 
-      return
+         type (__map_iterator) :: iter
+
+         iter = this%find(key)
+         if (iter == this%end()) then
+            res => null()
+            rc = OUT_OF_RANGE
+         else
+            res => iter%second()
+            rc = SUCCESS
+         end if
+
+         return
       end function __MANGLE(at_rc)
 
 
 
-! =======================
-!  erase_iter()
-! =======================
+      ! =======================
+      !  erase_iter()
+      ! =======================
       function __MANGLE(erase_iter)(this, iter) result(new_iter)
          type(__map_iterator) :: new_iter
          class(__map), intent(inout) :: this
@@ -233,9 +250,9 @@
 
       end function __MANGLE(erase_iter)
 
-! =======================
-!  erase_key()
-! =======================
+      ! =======================
+      !  erase_key()
+      ! =======================
       function __MANGLE(erase_key)(this, k) result(n)
          integer(kind=GFTL_SIZE_KIND) :: n
          class(__map), intent(inout) :: this
@@ -254,9 +271,9 @@
       end function __MANGLE(erase_key)
 
 
-! =======================
-!  erase_range()
-! =======================
+      ! =======================
+      !  erase_range()
+      ! =======================
       function __MANGLE(erase_range)(this, first, last) result(new_iter)
          type(__map_iterator) :: new_iter
          class(__map), target, intent(inout) :: this
@@ -269,45 +286,45 @@
       end function __MANGLE(erase_range)
 
 
-! =======================
-!  clear
-! =======================
+      ! =======================
+      !  clear
+      ! =======================
       recursive subroutine __MANGLE(clear)(this)
-      class(__map), intent(inout) :: this
+         class(__map), intent(inout) :: this
 
-      call this%tree%clear()
+         call this%tree%clear()
 
       end subroutine __MANGLE(clear)
 
 
-! Non type-bound functions
-
+      ! Non type-bound functions
 
-   ! =======================
-   !  equal
-   ! =======================
-   logical function __MANGLE(equal)(a, b) result(equal)
-      type(__map), intent(in) :: a
-      type(__map), intent(in) :: b
 
-      equal = a%tree == b%tree
+      ! =======================
+      !  equal
+      ! =======================
+      logical function __MANGLE(equal)(a, b) result(equal)
+         type(__map), intent(in) :: a
+         type(__map), intent(in) :: b
 
-   end function __MANGLE(equal)
+         equal = a%tree == b%tree
 
-   ! =======================
-   !  not_equal
-   ! =======================
-   logical function __MANGLE(not_equal)(a, b) result(not_equal)
-      type(__map), intent(in) :: a
-      type(__map), intent(in) :: b
+      end function __MANGLE(equal)
 
-      not_equal = .not. (a == b)
+      ! =======================
+      !  not_equal
+      ! =======================
+      logical function __MANGLE(not_equal)(a, b) result(not_equal)
+         type(__map), intent(in) :: a
+         type(__map), intent(in) :: b
 
-   end function __MANGLE(not_equal)
+         not_equal = .not. (a == b)
 
-! =======================
-!  begin
-! =======================
+      end function __MANGLE(not_equal)
+
+      ! =======================
+      !  begin
+      ! =======================
       function __MANGLE(begin)(this) result(iter)
          class(__map), target, intent(in) :: this
          type (__map_iterator) :: iter
@@ -373,11 +390,18 @@
 
       recursive subroutine __MANGLE(deep_copy)(this, x)
          class(__map), intent(out) :: this
-         type(__map), intent(in) :: x
+         type(__map), target, intent(in) :: x
+
+         integer, save :: depth = 0
 
          ! Set container assigmnent ovrrides default assignment.
          ! Correct implementations should do a deep copy here
-         this%tree = x%tree
+!!$         this%tree = x%tree
+
+         depth = depth + 1
+         call this%tree%deep_copy(x%tree)
+
+         depth = depth - 1
 
       end subroutine __MANGLE(deep_copy)
 
@@ -391,6 +415,13 @@
          return
       end function __MANGLE(key_less_than)
 
+      recursive logical function __MANGLE(verify)(this) result(verify)
+         class (__map), target, intent(in) :: this
+
+         verify = this%tree%verify()
+      end function __MANGLE(verify)
+
+
 #ifdef _DUMP_MAP
 ! =======================
 !  mapdump

include/v2/map/specification.inc

@@ -104,6 +104,7 @@
 !#ifdef _DUMP_MAP
 !      procedure :: dump => mapdump
 !#endif
+      procedure :: verify => __MANGLE(verify)
    end type __map