Fixes #419 - memory leak.

ChangeLog.md

@@ -5,17 +5,19 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 
-
+	
 ### Added
 
 - Fujitsu compiler support
 
 ### Fixed
 
-This fixes a small CMake bug which can lead to posix_predefined.x being built in the wrong build subdirectory when CMAKE_RUNTIME_OUTPUT_DIRECTORY is set*.
+- Eliminated small memory leak for @disable tests.   Accomplished by switching to gFTL v2 implementation of Map.
+- This fixes a small CMake bug which can lead to posix_predefined.x being built in the wrong build subdirectory when CMAKE_RUNTIME_OUTPUT_DIRECTORY is set*.
 
 ### Changed
 
+- Made annotation map a component of Test rather than using inheritance from StringTestAnnotationMap.  Arguably looser coupling, and was explored as part of chasing small memory leak mentioned above.
 - Updated the CI to use Intel LLVM compilers
 - Removed obsolete documentation
 
@@ -54,7 +56,6 @@ This fixes a small CMake bug which can lead to posix_predefined.x being built in
 ### Fixed
 - Increased size of buffer for reporting real values in asserts.   Previous length was not quite enough for some 128 bit values, which resulted in EOR failures during execution.
 
-
 ## [4.7.0] - 2023-04-17
 
 ### Changed

bin/funit/pFUnitParser.py

@@ -780,7 +780,8 @@ def printMakeSuite(self):
         self.outputFile.write('   use '+ self.wrapModuleName + '\n')
         self.outputFile.write('   implicit none'+ '\n')
         self.outputFile.write('   type (TestSuite) :: suite\n\n')
-        self.outputFile.write('   class (Test), allocatable :: t\n\n')
+        self.outputFile.write('   class (Test), allocatable :: t\n')
+        self.outputFile.write('   type(StringTestAnnotationMap), pointer :: annotations\n\n')
 
         if not self.userModuleName:
             for testMethod in self.userTestMethods:
@@ -842,7 +843,8 @@ def addSimpleTestMethod(self, testMethod):
         self.outputFile.write('   if(allocated(t)) deallocate(t)\n')
         self.outputFile.write('   allocate(t, source=' + type + '(' + args + '))\n')
         if ('disable' in testMethod):
-            self.outputFile.write('   call t%insert(Disable%type_name(),Disable)\n')
+            self.outputFile.write('   annotations => t%get_annotations()\n')
+            self.outputFile.write('   call annotations%insert(Disable%type_name(),Disable)\n')
         self.outputFile.write('   call suite%addTest(t)\n')
 
     def addMpiTestMethod(self, testMethod):

src/funit/CMakeLists.txt

@@ -30,7 +30,7 @@ function(funit_target_link_pfunit funit_target)
     message(FATAL_ERROR "Could not find gFTL-shared. This should not happen.")
   endif ()
 
-  target_link_libraries (${funit_target} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared FARGPARSE::fargparse)
+  target_link_libraries (${funit_target} PUBLIC GFTL::gftl GFTL::gftl-v2 GFTL_SHARED::gftl-shared FARGPARSE::fargparse)
   target_include_directories(${funit_target} PUBLIC
     $<BUILD_INTERFACE:${PFUNIT_SOURCE_DIR}/include>
     )

src/funit/core/FUnit_Core.F90

@@ -32,6 +32,7 @@ module FUnit_Core
    use PF_SerialContext
 
    use Pf_TestAnnotation
+   use pf_StringTestAnnotationMap
    use Pf_DisableAnnotation
    use Pf_TimeoutAnnotation
 
@@ -87,6 +88,7 @@ end function LoadTests_interface
    end interface
 
    public :: TestAnnotation
+   public :: StringTestAnnotationMap
    public :: Disable
    public :: TimeoutAnnotation
 

src/funit/core/RemoteProxyTestCase.F90

@@ -31,6 +31,7 @@ module PF_RemoteProxyTestCase
    use pf_Posix
    use pf_File
    use pf_TestAnnotation
+   use pf_StringTestAnnotationMap
    use pf_TimeoutAnnotation
    use pf_TestTimer
    implicit none
@@ -60,10 +61,13 @@ function newRemoteProxyTestCase(a_test, f, max_time) result(proxy)
       type(File), intent(in) :: f
       real, intent(in) :: max_time
 
+      class(StringTestAnnotationMap), pointer :: annotations
       class(TestAnnotation), pointer :: annotation
+      integer :: status
 
-      if (a_test%count('Timeout') == 1) then
-         annotation => a_test%at('Timeout')
+      annotations => a_test%get_annotations()
+      if (annotations%count('Timeout') == 1) then
+         annotation => annotations%at('Timeout', rc=status)
          ! cast
          select type (annotation)
          class is (TimeoutAnnotation)
@@ -77,7 +81,7 @@ function newRemoteProxyTestCase(a_test, f, max_time) result(proxy)
       call proxy%setName(a_test%getName())
 
       if(a_test%is_disabled()) then
-         call proxy%insert(Disable%type_name(),Disable)
+         call annotations%insert(Disable%type_name(),Disable)
       end if
 
    end function newRemoteProxyTestCase

src/funit/core/Test.F90

@@ -30,7 +30,9 @@ module PF_Test
    public :: Test
 
    ! Abstract class from which other Test classes inherit
-   type, abstract, extends(StringTestAnnotationMap) :: Test
+   type, abstract :: Test
+      private
+      type(StringTestAnnotationMap) :: annotations
       integer :: placeholder
    contains
       procedure(countTestCases), deferred :: countTestCases
@@ -39,6 +41,7 @@ module PF_Test
       procedure :: setName
 
       procedure :: is_disabled
+      procedure :: get_annotations
    end type Test
 
    abstract interface
@@ -80,8 +83,16 @@ end subroutine setName
    logical function is_disabled(this)
       class (Test), intent(in) :: this
 
-      is_disabled = (this%count(Disable%type_name()) == 1)
+      is_disabled = (this%annotations%count(Disable%type_name()) == 1)
 
    end function is_disabled
 
+
+   function get_annotations(this) result(annotations)
+      type(StringTestAnnotationMap), pointer :: annotations
+      class(Test), target, intent(in) :: this
+
+      annotations => this%annotations
+   end function get_annotations
+
 end module PF_Test

src/funit/core/TestAnnotation.F90

@@ -24,13 +24,20 @@ end module pf_TestAnnotation
 module pf_StringTestAnnotationMap
    use pf_TestAnnotation
 
-#define _map StringTestAnnotationMap
-#define _iterator StringTestAnnotationMapIterator
-#define _pair StringTestAnnotationPair
-#include "types/key_deferredLengthString.inc"
-#define _value_allocatable
-#define _value class(TestAnnotation)
-#define _alt
-#include "templates/map.inc"
+#define Key __CHARACTER_DEFERRED
+#define T TestAnnotation
+#define T_polymorphic
+#define Map StringTestAnnotationMap
+#define MapIterator StringTestAnnotationMapIterator
+#define Pair StringTestAnnotationPair
+
+#include "map/template.inc"
+
+#undef Pair
+#undef MapIterator
+#undef Map
+#undef T
+#undef T_polymorphic
+#undef Key
 
 end module pf_StringTestAnnotationMap

tests/funit-core/Test_DisableTest.pf

@@ -11,13 +11,20 @@ contains
       type (TestSuite) :: s
       type (TestRunner) :: r
       type (TestResult) :: rslt
-      class (Test), allocatable :: t
+      class (Test), target, allocatable :: t
       integer :: unit
+      type(StringTestAnnotationMap), pointer :: annotations
 
       s = TestSuite()
-      t = TestMethod('test_is_disabled',test_is_disabled)
-      call t%insert(Disable%type_name(), Disable)
+      print*,__FILE__,__LINE__
+      allocate(t, source= TestMethod('test_is_disabled',test_is_disabled))
+      print*,__FILE__,__LINE__
+      annotations => t%get_annotations()
+      print*,__FILE__,__LINE__
+      call annotations%insert(Disable%type_name(), Disable)
+      print*,__FILE__,__LINE__
       call s%addTest(t)
+      print*,__FILE__,__LINE__
 
       t = TestMethod('test_is_not_igored',test_is_not_disabled)
       call s%addTest(t)

tests/funit-core/robustTestSuite.F90

@@ -35,8 +35,9 @@ function suite()
       use PF_TestMethod, only: TestMethod
       type (TestSuite) :: suite
 
-      class (Test), allocatable :: t
+      class (Test), target, allocatable :: t
       type(TimeoutAnnotation) :: timeout
+      type(StringTestAnnotationMap), pointer :: annotations
 
       suite = TestSuite('robustTestSuite')
 
@@ -45,7 +46,8 @@ function suite()
 
       t = TestMethod('testRunHangs', testRunHangs)
       timeout = TimeoutAnnotation(0.1)
-      call t%insert(timeout%type_name(), timeout)
+      annotations => t%get_annotations()
+      call annotations%insert(timeout%type_name(), timeout)
       call suite%addTest( t )
 
       call suite%addTest( TestMethod('testRunStops', testRunStops) )