From 462f3f5b8d9bf8fa6974778f8dba4c61a1c0badc Mon Sep 17 00:00:00 2001 From: Sunny Titus Date: Mon, 13 Apr 2026 16:30:21 +0200 Subject: [PATCH 1/2] Create CirculairBuffer class and add unit tests --- autotest/TestCircularBuffer.f90 | 274 +++++++++++++++++++++++++++++++ autotest/meson.build | 1 + autotest/tester.f90 | 2 + msvs/mf6core.vfproj | 1 + src/Utilities/CircularBuffer.f90 | 248 ++++++++++++++++++++++++++++ src/meson.build | 1 + 6 files changed, 527 insertions(+) create mode 100644 autotest/TestCircularBuffer.f90 create mode 100644 src/Utilities/CircularBuffer.f90 diff --git a/autotest/TestCircularBuffer.f90 b/autotest/TestCircularBuffer.f90 new file mode 100644 index 00000000000..e46b89e2407 --- /dev/null +++ b/autotest/TestCircularBuffer.f90 @@ -0,0 +1,274 @@ +module TestCircularBuffer + use KindModule, only: I4B, DP + use testdrive, only: error_type, unittest_type, new_unittest, check + use CircularBufferModule + use SimModule, only: store_error, count_errors, initial_message + + implicit none + private + public :: collect_circular_buffer + +contains + + subroutine collect_circular_buffer(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("push_back", test_push_back), & + new_unittest("pop_back", test_pop_back), & + new_unittest("front_and_back", test_front_and_back), & + new_unittest("front_at", test_front_at), & + new_unittest("back_at", test_back_at), & + new_unittest("is_full_and_is_empty", test_is_full_and_is_empty), & + new_unittest("wrap_around", test_wrap_around), & + new_unittest("pop_back_underflow", test_pop_back_underflow), & + new_unittest("index_out_of_bounds", test_index_out_of_bounds) & + ] + end subroutine collect_circular_buffer + + subroutine test_push_back(error) + type(error_type), allocatable, intent(out) :: error + type(CircularBufferType) :: buffer + real(DP) :: element(2) + real(DP), pointer :: retrieved(:) + + buffer = CircularBufferType(3, 2, "cbuf_pba", "TestPath") + + element = [1.0_DP, 2.0_DP] + call buffer%push_back(element) + element = [3.0_DP, 4.0_DP] + call buffer%push_back(element) + + retrieved => buffer%front(1) + call check(error, all(retrieved == [1.0_DP, 2.0_DP]), & + "front(1) should return the oldest element") + if (allocated(error)) return + + retrieved => buffer%front(2) + call check(error, all(retrieved == [3.0_DP, 4.0_DP]), & + "front(2) should return the newest element") + end subroutine test_push_back + + subroutine test_front_at(error) + type(error_type), allocatable, intent(out) :: error + type(CircularBufferType) :: buffer + real(DP) :: element(2) + real(DP), pointer :: retrieved(:) + + buffer = CircularBufferType(3, 2, "cbuf_fwa", "TestPath") + + element = [1.0_DP, 2.0_DP]; call buffer%push_back(element) + element = [3.0_DP, 4.0_DP]; call buffer%push_back(element) + element = [5.0_DP, 6.0_DP]; call buffer%push_back(element) + + retrieved => buffer%front(1) + call check(error, all(retrieved == [1.0_DP, 2.0_DP]), & + "front(1) should return the oldest element") + if (allocated(error)) return + + retrieved => buffer%front(2) + call check(error, all(retrieved == [3.0_DP, 4.0_DP]), & + "front(2) should return the second oldest element") + if (allocated(error)) return + + retrieved => buffer%front(3) + call check(error, all(retrieved == [5.0_DP, 6.0_DP]), & + "front(3) should return the newest element") + if (allocated(error)) return + + ! no-arg front() must still work via the generic + retrieved => buffer%front() + call check(error, all(retrieved == [1.0_DP, 2.0_DP]), & + "front() should still return the oldest element") + end subroutine test_front_at + + subroutine test_back_at(error) + type(error_type), allocatable, intent(out) :: error + type(CircularBufferType) :: buffer + real(DP) :: element(2) + real(DP), pointer :: retrieved(:) + + buffer = CircularBufferType(3, 2, "cbuf_ba", "TestPath") + + element = [1.0_DP, 2.0_DP]; call buffer%push_back(element) + element = [3.0_DP, 4.0_DP]; call buffer%push_back(element) + element = [5.0_DP, 6.0_DP]; call buffer%push_back(element) + + retrieved => buffer%back(1) + call check(error, all(retrieved == [5.0_DP, 6.0_DP]), & + "back(1) should return the newest element") + if (allocated(error)) return + + retrieved => buffer%back(2) + call check(error, all(retrieved == [3.0_DP, 4.0_DP]), & + "back(2) should return the second newest element") + if (allocated(error)) return + + retrieved => buffer%back(3) + call check(error, all(retrieved == [1.0_DP, 2.0_DP]), & + "back(3) should return the oldest element") + if (allocated(error)) return + + ! no-arg back() must still work via the generic + retrieved => buffer%back() + call check(error, all(retrieved == [5.0_DP, 6.0_DP]), & + "back() should still return the newest element") + end subroutine test_back_at + + subroutine test_pop_back(error) + type(error_type), allocatable, intent(out) :: error + type(CircularBufferType) :: buffer + real(DP) :: element(2) + real(DP), pointer :: retrieved(:) + + buffer = CircularBufferType(3, 2, "cbuf_pb", "TestPath") + + element = [1.0_DP, 2.0_DP] + call buffer%push_back(element) + element = [3.0_DP, 4.0_DP] + call buffer%push_back(element) + + call buffer%pop_back() + + call check(error, buffer%size() == 1, "size should be 1 after pop_back") + if (allocated(error)) return + + retrieved => buffer%back() + call check(error, all(retrieved == [1.0_DP, 2.0_DP]), & + "back after pop_back should be the remaining element") + end subroutine test_pop_back + + subroutine test_front_and_back(error) + type(error_type), allocatable, intent(out) :: error + type(CircularBufferType) :: buffer + real(DP) :: element(2) + real(DP), pointer :: retrieved(:) + + buffer = CircularBufferType(3, 2, "cbuf_fb", "TestPath") + + element = [1.0_DP, 2.0_DP] + call buffer%push_back(element) + element = [3.0_DP, 4.0_DP] + call buffer%push_back(element) + element = [5.0_DP, 6.0_DP] + call buffer%push_back(element) + + retrieved => buffer%front() + call check(error, all(retrieved == [1.0_DP, 2.0_DP]), & + "front should return the oldest element") + if (allocated(error)) return + + retrieved => buffer%back() + call check(error, all(retrieved == [5.0_DP, 6.0_DP]), & + "back should return the newest element") + end subroutine test_front_and_back + + subroutine test_is_full_and_is_empty(error) + type(error_type), allocatable, intent(out) :: error + type(CircularBufferType) :: buffer + real(DP) :: element(2) + + buffer = CircularBufferType(2, 2, "cbuf_fie", "TestPath") + + call check(error, buffer%is_empty(), "buffer should be empty initially") + if (allocated(error)) return + call check(error, .not. buffer%is_full(), "buffer should not be full initially") + if (allocated(error)) return + + element = [1.0_DP, 2.0_DP] + call buffer%push_back(element) + call buffer%push_back(element) + + call check(error, buffer%is_full(), "buffer should be full after push to capacity") + if (allocated(error)) return + call check(error, .not. buffer%is_empty(), "buffer should not be empty when full") + end subroutine test_is_full_and_is_empty + + subroutine test_wrap_around(error) + type(error_type), allocatable, intent(out) :: error + type(CircularBufferType) :: buffer + real(DP) :: element(1) + real(DP), pointer :: retrieved(:) + + ! Fill a capacity-3 buffer then push a 4th element: oldest is overwritten. + buffer = CircularBufferType(3, 1, "cbuf_wrap", "TestPath") + + element = [1.0_DP]; call buffer%push_back(element) + element = [2.0_DP]; call buffer%push_back(element) + element = [3.0_DP]; call buffer%push_back(element) + element = [4.0_DP]; call buffer%push_back(element) + + call check(error, buffer%size() == 3, & + "size should remain at capacity after wrap-around push_back") + if (allocated(error)) return + + retrieved => buffer%front() + call check(error, retrieved(1) == 2.0_DP, & + "front after wrap should be the second inserted element") + if (allocated(error)) return + + retrieved => buffer%back() + call check(error, retrieved(1) == 4.0_DP, & + "back after wrap should be the last inserted element") + end subroutine test_wrap_around + + subroutine test_pop_back_underflow(error) + type(error_type), allocatable, intent(out) :: error + type(CircularBufferType) :: buffer + real(DP) :: element(1) + + buffer = CircularBufferType(3, 1, "cbuf_ufl", "TestPath") + call initial_message() + + element = [1.0_DP]; call buffer%push_back(element) + element = [2.0_DP]; call buffer%push_back(element) + + call buffer%pop_back() + call buffer%pop_back() + + ! Buffer is now empty; one more pop should store an error + call buffer%pop_back() + call check(error, count_errors() == 1, & + "pop_back on empty buffer should store one error") + end subroutine test_pop_back_underflow + + subroutine test_index_out_of_bounds(error) + type(error_type), allocatable, intent(out) :: error + type(CircularBufferType) :: buffer + real(DP) :: element(1) + real(DP), pointer :: retrieved(:) + + buffer = CircularBufferType(3, 1, "cbuf_oob", "TestPath") + + element = [1.0_DP]; call buffer%push_back(element) + element = [2.0_DP]; call buffer%push_back(element) + + ! front(n) with n > size() + call initial_message() + retrieved => buffer%front(5) + call check(error, count_errors() == 1, & + "front(5) on size-2 buffer should store one error") + if (allocated(error)) return + + ! back(n) with n > size() + call initial_message() + retrieved => buffer%back(5) + call check(error, count_errors() == 1, & + "back(5) on size-2 buffer should store one error") + if (allocated(error)) return + + ! front(0) — zero index is invalid (1-based) + call initial_message() + retrieved => buffer%front(0) + call check(error, count_errors() == 1, & + "front(0) should store one error (1-based indexing)") + if (allocated(error)) return + + ! back(0) — zero index is invalid (1-based) + call initial_message() + retrieved => buffer%back(0) + call check(error, count_errors() == 1, & + "back(0) should store one error (1-based indexing)") + end subroutine test_index_out_of_bounds + +end module TestCircularBuffer \ No newline at end of file diff --git a/autotest/meson.build b/autotest/meson.build index e8176c173a1..5ddc81fe347 100644 --- a/autotest/meson.build +++ b/autotest/meson.build @@ -2,6 +2,7 @@ test_drive = dependency('test-drive', required : false) if test_drive.found() and not fc_id.contains('intel') tests = [ 'ArrayHandlers', + 'CircularBuffer', 'FeatureFlags', 'GeomUtil', 'HashTable', diff --git a/autotest/tester.f90 b/autotest/tester.f90 index bf99077fcd3..13783c5a7c8 100644 --- a/autotest/tester.f90 +++ b/autotest/tester.f90 @@ -3,6 +3,7 @@ program tester use testdrive, only: run_testsuite, new_testsuite, testsuite_type, & & select_suite, run_selected, get_argument use TestArrayHandlers, only: collect_arrayhandlers + use TestCircularBuffer, only: collect_circular_buffer use TestFeatureFlags, only: collect_feature_flags use TestGeomUtil, only: collect_geomutil use TestHashTable, only: collect_hashtable @@ -32,6 +33,7 @@ program tester stat = 0 testsuites = [ & new_testsuite("ArrayHandlers", collect_arrayhandlers), & + new_testsuite("CircularBuffer", collect_circular_buffer), & new_testsuite("FeatureFlags", collect_feature_flags), & new_testsuite("GeomUtil", collect_geomutil), & new_testsuite("HashTable", collect_hashtable), & diff --git a/msvs/mf6core.vfproj b/msvs/mf6core.vfproj index acfd78b77cc..c38f1c4456c 100644 --- a/msvs/mf6core.vfproj +++ b/msvs/mf6core.vfproj @@ -676,6 +676,7 @@ + diff --git a/src/Utilities/CircularBuffer.f90 b/src/Utilities/CircularBuffer.f90 new file mode 100644 index 00000000000..feda4eff132 --- /dev/null +++ b/src/Utilities/CircularBuffer.f90 @@ -0,0 +1,248 @@ +module CircularBufferModule + + use KindModule, only: DP, I4B + use MemoryManagerModule, only: mem_allocate, mem_deallocate + use SimModule, only: store_error + + implicit none + private + public :: CircularBufferType + + type :: CircularBufferType + private + integer(I4B) :: n_capacity !< Maximum number of elements in the buffer + integer(I4B) :: n_size = 0 !< Current number of elements in the buffer + integer(I4B) :: head_index = 0 !< Slot index of the back (newest) element; 0 when empty + real(DP), pointer, contiguous :: data(:, :) !< The buffer array + + contains + procedure :: push_back + procedure :: pop_back + generic :: front => front_impl, front_at_impl + generic :: back => back_impl, back_at_impl + procedure :: size => get_size + procedure :: capacity => get_capacity + procedure :: is_empty + procedure :: is_full + final :: destructor + + procedure, private :: front_impl + procedure, private :: front_at_impl + procedure, private :: back_impl + procedure, private :: back_at_impl + end type CircularBufferType + + interface CircularBufferType + module procedure constructor + end interface CircularBufferType + +contains + + function constructor(capacity, neq, name, mem_path) result(buffer) + type(CircularBufferType) :: buffer + ! -- dummy + integer(I4B), intent(in) :: capacity !< maximum number of elements + integer(I4B), intent(in) :: neq !< number of equations (size of each element) + character(len=*), intent(in) :: name !< variable name + character(len=*), intent(in) :: mem_path !< path where variable is stored + + call mem_allocate(buffer%data, neq, capacity, name, mem_path) + buffer%n_capacity = capacity + + end function constructor + + subroutine destructor(this) + ! -- dummy + type(CircularBufferType), intent(inout) :: this + + call mem_deallocate(this%data) + end subroutine destructor + + !> @brief Insert an element at the back (newest end) of the buffer. + !! + !! If the buffer is full the front (oldest) element is overwritten. + !< + subroutine push_back(this, element) + ! -- dummy + class(CircularBufferType), target :: this + real(DP), dimension(:), intent(in) :: element + ! -- local + integer(I4B) :: insert_index + + if (this%n_size < this%n_capacity) then + this%n_size = this%n_size + 1 + end if + + insert_index = mod(this%head_index, this%n_capacity) + 1 + this%data(:, insert_index) = element + this%head_index = insert_index + + end subroutine push_back + + !> @brief Remove the element at the back (newest end) of the buffer. + !! + !! Error stops if the buffer is empty. + !< + subroutine pop_back(this) + ! -- dummy + class(CircularBufferType), target :: this + + if (this%n_size == 0) then + call store_error("Cannot pop_back from an empty CircularBufferType") + return + end if + + this%n_size = this%n_size - 1 + if (this%n_size > 0) then + this%head_index = mod(this%head_index - 2 + this%n_capacity, & + this%n_capacity) + 1 + else + this%head_index = 0 + end if + + end subroutine pop_back + + !> @brief Return a pointer to the front (oldest) element. + !! + !! Error stops if the buffer is empty. + !< + function front_impl(this) result(element) + ! -- dummy + class(CircularBufferType), target :: this + ! -- return + real(DP), pointer, dimension(:) :: element + ! -- local + integer(I4B) :: index + + if (this%n_size == 0) then + call store_error("Cannot access front of an empty CircularBufferType") + element => null() + return + end if + + index = mod(this%head_index - this%n_size + this%n_capacity, & + this%n_capacity) + 1 + element => this%data(:, index) + + end function front_impl + + !> @brief Return a pointer to element at 1-based index n counted from the front. + !! + !! n=1 is the oldest (front) element; n=size() is the newest (back). + !! Error stops if n is out of bounds. + !< + function front_at_impl(this, n) result(element) + ! -- dummy + class(CircularBufferType), target :: this + integer(I4B), intent(in) :: n !< 1-based index from front (1=oldest, size()=newest) + ! -- return + real(DP), pointer, dimension(:) :: element + ! -- local + integer(I4B) :: index + + if (n < 1 .or. n > this%n_size) then + call store_error("Index out of bounds in CircularBufferType%front") + element => null() + return + end if + + index = mod(this%head_index - this%n_size + n - 1 + this%n_capacity, & + this%n_capacity) + 1 + element => this%data(:, index) + + end function front_at_impl + + !> @brief Return a pointer to the back (newest) element. + !! + !! Error stops if the buffer is empty. + !< + function back_impl(this) result(element) + ! -- dummy + class(CircularBufferType), target :: this + ! -- return + real(DP), pointer, dimension(:) :: element + + if (this%n_size == 0) then + call store_error("Cannot access back of an empty CircularBufferType") + element => null() + return + end if + + element => this%data(:, this%head_index) + + end function back_impl + + !> @brief Return a pointer to element at 1-based index n counted from the back. + !! + !! n=1 is the newest (back) element; n=size() is the oldest (front). + !! Error stops if n is out of bounds. + !< + function back_at_impl(this, n) result(element) + ! -- dummy + class(CircularBufferType), target :: this + integer(I4B), intent(in) :: n !< 1-based index from back (1=newest, size()=oldest) + ! -- return + real(DP), pointer, dimension(:) :: element + ! -- local + integer(I4B) :: index + + if (n < 1 .or. n > this%n_size) then + call store_error("Index out of bounds in CircularBufferType%back") + element => null() + return + end if + + index = mod(this%head_index - n + this%n_capacity, this%n_capacity) + 1 + element => this%data(:, index) + + end function back_at_impl + + !> @brief Return the number of elements currently stored in the buffer. + !< + function get_size(this) result(n) + ! -- dummy + class(CircularBufferType), target :: this + ! -- return + integer(I4B) :: n + + n = this%n_size + + end function get_size + + !> @brief Return the maximum number of elements the buffer can hold. + !< + function get_capacity(this) result(n) + ! -- dummy + class(CircularBufferType), target :: this + ! -- return + integer(I4B) :: n + + n = this%n_capacity + + end function get_capacity + + !> @brief Return .true. if the buffer contains no elements. + !< + function is_empty(this) result(empty) + ! -- dummy + class(CircularBufferType), target :: this + ! -- return + logical :: empty + + empty = (this%n_size == 0) + + end function is_empty + + !> @brief Return .true. if the number of elements equals the capacity. + !< + function is_full(this) result(full) + ! -- dummy + class(CircularBufferType), target :: this + ! -- return + logical :: full + + full = (this%n_size == this%n_capacity) + + end function is_full + +end module CircularBufferModule diff --git a/src/meson.build b/src/meson.build index 1254559e3ee..49899133a2c 100644 --- a/src/meson.build +++ b/src/meson.build @@ -450,6 +450,7 @@ modflow_sources = files( 'Utilities' / 'CharString.f90', 'Utilities' / 'comarg.f90', 'Utilities' / 'compilerversion.F90', + 'Utilities' / 'CircularBuffer.f90', 'Utilities' / 'CharString.f90', 'Utilities' / 'Constants.f90', 'Utilities' / 'defmacro.F90', From da17f314dd9f54c201c61235dd61924338a29af6 Mon Sep 17 00:00:00 2001 From: Sunny Titus Date: Tue, 14 Apr 2026 15:36:26 +0200 Subject: [PATCH 2/2] Clean code. Fix lint error. Remove code duplication --- autotest/TestCircularBuffer.f90 | 85 ++++++++++++++++++++------------ src/Utilities/CircularBuffer.f90 | 20 +------- 2 files changed, 55 insertions(+), 50 deletions(-) diff --git a/autotest/TestCircularBuffer.f90 b/autotest/TestCircularBuffer.f90 index e46b89e2407..b64eefb6962 100644 --- a/autotest/TestCircularBuffer.f90 +++ b/autotest/TestCircularBuffer.f90 @@ -14,25 +14,27 @@ subroutine collect_circular_buffer(testsuite) type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & - new_unittest("push_back", test_push_back), & - new_unittest("pop_back", test_pop_back), & - new_unittest("front_and_back", test_front_and_back), & - new_unittest("front_at", test_front_at), & - new_unittest("back_at", test_back_at), & - new_unittest("is_full_and_is_empty", test_is_full_and_is_empty), & - new_unittest("wrap_around", test_wrap_around), & - new_unittest("pop_back_underflow", test_pop_back_underflow), & - new_unittest("index_out_of_bounds", test_index_out_of_bounds) & - ] + new_unittest("push_back", test_push_back), & + new_unittest("pop_back", test_pop_back), & + new_unittest("front_and_back", test_front_and_back), & + new_unittest("front_at", test_front_at), & + new_unittest("back_at", test_back_at), & + new_unittest("is_full_and_is_empty", test_is_full_and_is_empty), & + new_unittest("wrap_around", test_wrap_around), & + new_unittest("pop_back_underflow", test_pop_back_underflow), & + new_unittest("index_out_of_bounds", test_index_out_of_bounds) & + ] end subroutine collect_circular_buffer subroutine test_push_back(error) type(error_type), allocatable, intent(out) :: error + integer(I4B), parameter :: capacity = 3 + integer(I4B), parameter :: elem_size = 2 type(CircularBufferType) :: buffer - real(DP) :: element(2) + real(DP) :: element(elem_size) real(DP), pointer :: retrieved(:) - buffer = CircularBufferType(3, 2, "cbuf_pba", "TestPath") + buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath") element = [1.0_DP, 2.0_DP] call buffer%push_back(element) @@ -51,11 +53,13 @@ end subroutine test_push_back subroutine test_front_at(error) type(error_type), allocatable, intent(out) :: error + integer(I4B), parameter :: capacity = 3 + integer(I4B), parameter :: elem_size = 2 type(CircularBufferType) :: buffer - real(DP) :: element(2) + real(DP) :: element(elem_size) real(DP), pointer :: retrieved(:) - buffer = CircularBufferType(3, 2, "cbuf_fwa", "TestPath") + buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath") element = [1.0_DP, 2.0_DP]; call buffer%push_back(element) element = [3.0_DP, 4.0_DP]; call buffer%push_back(element) @@ -84,11 +88,13 @@ end subroutine test_front_at subroutine test_back_at(error) type(error_type), allocatable, intent(out) :: error + integer(I4B), parameter :: capacity = 3 + integer(I4B), parameter :: elem_size = 2 type(CircularBufferType) :: buffer - real(DP) :: element(2) + real(DP) :: element(elem_size) real(DP), pointer :: retrieved(:) - buffer = CircularBufferType(3, 2, "cbuf_ba", "TestPath") + buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath") element = [1.0_DP, 2.0_DP]; call buffer%push_back(element) element = [3.0_DP, 4.0_DP]; call buffer%push_back(element) @@ -117,11 +123,13 @@ end subroutine test_back_at subroutine test_pop_back(error) type(error_type), allocatable, intent(out) :: error + integer(I4B), parameter :: capacity = 3 + integer(I4B), parameter :: elem_size = 2 type(CircularBufferType) :: buffer - real(DP) :: element(2) + real(DP) :: element(elem_size) real(DP), pointer :: retrieved(:) - buffer = CircularBufferType(3, 2, "cbuf_pb", "TestPath") + buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath") element = [1.0_DP, 2.0_DP] call buffer%push_back(element) @@ -140,11 +148,13 @@ end subroutine test_pop_back subroutine test_front_and_back(error) type(error_type), allocatable, intent(out) :: error + integer(I4B), parameter :: capacity = 3 + integer(I4B), parameter :: elem_size = 2 type(CircularBufferType) :: buffer - real(DP) :: element(2) + real(DP) :: element(elem_size) real(DP), pointer :: retrieved(:) - buffer = CircularBufferType(3, 2, "cbuf_fb", "TestPath") + buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath") element = [1.0_DP, 2.0_DP] call buffer%push_back(element) @@ -165,33 +175,40 @@ end subroutine test_front_and_back subroutine test_is_full_and_is_empty(error) type(error_type), allocatable, intent(out) :: error + integer(I4B), parameter :: capacity = 2 + integer(I4B), parameter :: elem_size = 2 type(CircularBufferType) :: buffer - real(DP) :: element(2) + real(DP) :: element(elem_size) - buffer = CircularBufferType(2, 2, "cbuf_fie", "TestPath") + buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath") call check(error, buffer%is_empty(), "buffer should be empty initially") if (allocated(error)) return - call check(error, .not. buffer%is_full(), "buffer should not be full initially") + call check(error,.not. buffer%is_full(), & + "buffer should not be full initially") if (allocated(error)) return element = [1.0_DP, 2.0_DP] call buffer%push_back(element) call buffer%push_back(element) - call check(error, buffer%is_full(), "buffer should be full after push to capacity") + call check(error, buffer%is_full(), & + "buffer should be full after push to capacity") if (allocated(error)) return - call check(error, .not. buffer%is_empty(), "buffer should not be empty when full") + call check(error,.not. buffer%is_empty(), & + "buffer should not be empty when full") end subroutine test_is_full_and_is_empty subroutine test_wrap_around(error) type(error_type), allocatable, intent(out) :: error + integer(I4B), parameter :: capacity = 3 + integer(I4B), parameter :: elem_size = 1 type(CircularBufferType) :: buffer - real(DP) :: element(1) + real(DP) :: element(elem_size) real(DP), pointer :: retrieved(:) ! Fill a capacity-3 buffer then push a 4th element: oldest is overwritten. - buffer = CircularBufferType(3, 1, "cbuf_wrap", "TestPath") + buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath") element = [1.0_DP]; call buffer%push_back(element) element = [2.0_DP]; call buffer%push_back(element) @@ -214,10 +231,12 @@ end subroutine test_wrap_around subroutine test_pop_back_underflow(error) type(error_type), allocatable, intent(out) :: error + integer(I4B), parameter :: capacity = 3 + integer(I4B), parameter :: elem_size = 1 type(CircularBufferType) :: buffer - real(DP) :: element(1) + real(DP) :: element(elem_size) - buffer = CircularBufferType(3, 1, "cbuf_ufl", "TestPath") + buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath") call initial_message() element = [1.0_DP]; call buffer%push_back(element) @@ -234,11 +253,13 @@ end subroutine test_pop_back_underflow subroutine test_index_out_of_bounds(error) type(error_type), allocatable, intent(out) :: error + integer(I4B), parameter :: capacity = 3 + integer(I4B), parameter :: elem_size = 1 type(CircularBufferType) :: buffer - real(DP) :: element(1) + real(DP) :: element(elem_size) real(DP), pointer :: retrieved(:) - buffer = CircularBufferType(3, 1, "cbuf_oob", "TestPath") + buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath") element = [1.0_DP]; call buffer%push_back(element) element = [2.0_DP]; call buffer%push_back(element) @@ -271,4 +292,4 @@ subroutine test_index_out_of_bounds(error) "back(0) should store one error (1-based indexing)") end subroutine test_index_out_of_bounds -end module TestCircularBuffer \ No newline at end of file +end module TestCircularBuffer diff --git a/src/Utilities/CircularBuffer.f90 b/src/Utilities/CircularBuffer.f90 index feda4eff132..cdd0f882b63 100644 --- a/src/Utilities/CircularBuffer.f90 +++ b/src/Utilities/CircularBuffer.f90 @@ -111,18 +111,8 @@ function front_impl(this) result(element) class(CircularBufferType), target :: this ! -- return real(DP), pointer, dimension(:) :: element - ! -- local - integer(I4B) :: index - - if (this%n_size == 0) then - call store_error("Cannot access front of an empty CircularBufferType") - element => null() - return - end if - index = mod(this%head_index - this%n_size + this%n_capacity, & - this%n_capacity) + 1 - element => this%data(:, index) + element => this%front_at_impl(1) end function front_impl @@ -162,13 +152,7 @@ function back_impl(this) result(element) ! -- return real(DP), pointer, dimension(:) :: element - if (this%n_size == 0) then - call store_error("Cannot access back of an empty CircularBufferType") - element => null() - return - end if - - element => this%data(:, this%head_index) + element => this%back_at_impl(1) end function back_impl