From 262ed5ccee0d9a87ce3c040a8801f329c5dc2db4 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Wed, 24 Oct 2018 20:24:29 -0400 Subject: [PATCH] Fixes #25 and Fixes #24. Map now uses a custom __TYPE_MOVE for pair objects so that ALLOCATABLE values are manipulated internally with move_alloc(). This also exposed the suspected but unproven theory that TARGET was needed in a few more interfaces for pointers to be properly robust under container changes. (This requires the appropriate targets of the pointer to be ALLOCATABLE and so cannot work on simple containers. Documentation will be "fun".) Also modified flags to gFortran to handle longer lines that now appear in some test cases. Support for fixed format should be considered deprecated. --- cmake_utils/GNU.cmake | 4 ++-- include/templates/altSet_impl.inc | 15 +++++++++++++++ include/templates/map.inc | 7 ++++--- include/templates/vector_impl.inc | 10 +++++----- tests/Map/Test_map_Allocatable.pf | 6 +++++- 5 files changed, 31 insertions(+), 11 deletions(-) diff --git a/cmake_utils/GNU.cmake b/cmake_utils/GNU.cmake index f12d323..83e21c9 100644 --- a/cmake_utils/GNU.cmake +++ b/cmake_utils/GNU.cmake @@ -6,6 +6,6 @@ set(traceback "-fbacktrace") set(cpp "-cpp") -set(CMAKE_Fortran_FLAGS_DEBUG "${no_optimize}") +set(CMAKE_Fortran_FLAGS_DEBUG "${no_optimize}" ${check_all} ${traceback}) set(CMAKE_Fortran_FLAGS_RELEASE "-O3") -set(CMAKE_Fortran_FLAGS "-g ${cpp} ${traceback} ${check_all}") +set(CMAKE_Fortran_FLAGS "-g ${cpp} -ffree-line-length-255") diff --git a/include/templates/altSet_impl.inc b/include/templates/altSet_impl.inc index 968f10d..a4bd3c0 100644 --- a/include/templates/altSet_impl.inc +++ b/include/templates/altSet_impl.inc @@ -251,6 +251,9 @@ __type_declare_result, pointer :: p, q #endif +#if (defined(__vector_debug) && defined(_DEBUG___)) + print*,__FILE__,__LINE__ +#endif if (present(unused)) print*,shape(unused) if (exists(this%root)) then @@ -287,7 +290,13 @@ isNew = .true. end if +#if (defined(__vector_debug) && defined(_DEBUG___)) + print*,__FILE__,__LINE__, this%next_free +#endif if (this%next_free == 0) then +#if (defined(__vector_debug) && defined(_DEBUG___)) + print*,__FILE__,__LINE__ +#endif call this%items%push_back(value) new = this%items%size() call this%heights%push_back(1_SIZE_KIND) @@ -315,6 +324,9 @@ call this%rights%set(parent,new) end if #else +#if (defined(__vector_debug) && defined(_DEBUG___)) + print*,__FILE__,__LINE__ +#endif if (__PROC(lessThan)(value, this%items%at(parent))) then call this%lefts%set(parent, new) else @@ -325,6 +337,9 @@ else ! new root +#if (defined(__vector_debug) && defined(_DEBUG___)) + print*,__FILE__,__LINE__, this%next_free +#endif if (this%next_free == 0) then call this%items%push_back(value) new = this%items%size() diff --git a/include/templates/map.inc b/include/templates/map.inc index 8256bb4..c5331fd 100644 --- a/include/templates/map.inc +++ b/include/templates/map.inc @@ -56,9 +56,6 @@ #undef __container_prefix #define _type type(__pair) -#ifdef _pair_allocatable -#define _allocatable -#endif #include "templates/type_set_use_tokens.inc" @@ -156,6 +153,10 @@ #include "templates/type_set_use_tokens.inc" +#define __USE_ASSIGN(dest,src) dest=src +#define __USE_MOVE(dest,src) __KEY_MOVE(dest%key,src%key); __VALUE_MOVE(dest%value,src%value) +#define __USE_FREE(x) + #ifdef _alt ! vector<_type> # define __vector tVector diff --git a/include/templates/vector_impl.inc b/include/templates/vector_impl.inc index 4a20049..516f02d 100644 --- a/include/templates/vector_impl.inc +++ b/include/templates/vector_impl.inc @@ -421,7 +421,7 @@ ! ======================= subroutine __PROC(insert_size_kind)( & & this, index, value, unused, rc) - class(__vector), intent(inout) :: this + class(__vector), target, intent(inout) :: this integer(kind=SIZE_KIND), intent(in) :: index @@ -628,9 +628,9 @@ ! set_capacity ! ======================= subroutine __PROC(set_capacity)(this, capacity) - class(__vector), intent(inout) :: this + class(__vector), target, intent(inout) :: this integer(kind=SIZE_KIND), intent(in) :: capacity ! capacity must be >=0 - __declare_element_type, dimension(:), allocatable :: temp + __declare_element_type,dimension(:),allocatable,target :: temp integer(kind=SIZE_KIND) :: i if (capacity>0) then ! capacity>0 @@ -669,8 +669,8 @@ ! swap ! ======================= subroutine __PROC(swap)(this, other) - class(__vector), intent(inout) :: this - type(__vector), intent(inout) :: other + class(__vector), target, intent(inout) :: this + type(__vector), target, intent(inout) :: other __declare_element_type, & & dimension(:), allocatable :: tmpelementsfer integer :: tmpsize diff --git a/tests/Map/Test_map_Allocatable.pf b/tests/Map/Test_map_Allocatable.pf index bb2beb2..c2eb1c1 100644 --- a/tests/Map/Test_map_Allocatable.pf +++ b/tests/Map/Test_map_Allocatable.pf @@ -10,7 +10,6 @@ module MyMap_mod #include "types/key_deferredLengthString.inc" #include "types/value_FooPoly.inc" #define _alt -#define _pair_allocatable #include "templates/map.inc" end module MyMap_mod @@ -36,10 +35,15 @@ contains call m%insert('c',Foo(3)) pc => m%at('c') + @assertEqual(3, pc%i) + call m%insert('b',Foo(2)) pb => m%at('b') + @assertEqual(2, pb%i) + call m%insert('a',Foo(1)) pa => m%at('a') + @assertEqual(1, pa%i) ! Sanity checks @assertEqual(1, pa%i)