fixed a bug in ftlHashMap%Clear

SCM-NV · Feb 6, 2020 · 0cd4a89 · 0cd4a89
1 parent 17b497f
commit 0cd4a89
Show file tree

Hide file tree

Showing 3 changed files with 42 additions and 2 deletions.
diff --git a/src/ftlHashMap.F90_template b/src/ftlHashMap.F90_template
@@ -520,6 +520,7 @@ contains
                deleter => walker
             enddo
             deallocate(deleter)
+            nullify(self%buckets(b)%first)
          enddo
       endif
       self%psize = 0
@@ -535,7 +536,11 @@ contains
    pure integer function BucketCount(self)
       class(CAT3(ftlHashMap,FTL_TEMPLATE_KEYTYPE_NAME,FTL_TEMPLATE_TYPE_NAME)), intent(in) :: self
 
-      BucketCount = size(self%buckets)
+      if (allocated(self%buckets)) then
+         BucketCount = size(self%buckets)
+      else
+         BucketCount = 0
+      endif
 
    end function
 

diff --git a/src/ftlHashSet.F90_template b/src/ftlHashSet.F90_template
@@ -487,7 +487,11 @@ contains
    pure integer function BucketCount(self)
       class(CAT(ftlHashSet,FTL_TEMPLATE_TYPE_NAME)), intent(in) :: self
 
-      BucketCount = size(self%buckets)
+      if (allocated(self%buckets)) then
+         BucketCount = size(self%buckets)
+      else
+         BucketCount = 0
+      endif
 
    end function
 

diff --git a/tests/ftlHashMapTests.F90 b/tests/ftlHashMapTests.F90
@@ -42,6 +42,7 @@ subroutine ftlHashMapTests
       call testNewDefault
       call testNewCopyOther
       call testAssignment
+      call testClear
       call testSetAndGet
       call testRehash
       call testIterators
@@ -163,6 +164,36 @@ subroutine testAssignment
    end subroutine
 
 
+   subroutine testClear
+      type(ftlHashMapStrInt) :: um
+      integer :: b
+
+      call um%New(10)
+      call um%Set('foo ', 42)
+      call um%Set('bar ',  1)
+      call um%Set('test',  2)
+      call um%Set('blub',  3)
+      call um%Set('jipi',  4)
+      call um%Set('fort',  5)
+      call um%Set('ran ',  6)
+      call um%Set('is m',  7)
+      call um%Set('y fa',  8)
+      call um%Set('vour',  9)
+      call um%Set('ite ', 10)
+      call um%Set('lang', 11)
+      call um%Set('not ', 12)
+      call um%Set('rly!', 13)
+
+      call um%Clear()
+
+      ASSERT(um%Size() == 0)
+      do b = 1, um%BucketCount()
+         ASSERT(um%BucketSize(b) == 0)
+      enddo
+
+   end subroutine
+
+
    subroutine testSetAndGet
       type(ftlHashMapStrInt) :: um
       integer :: i