Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
295 changes: 295 additions & 0 deletions autotest/TestCircularBuffer.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,295 @@
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
integer(I4B), parameter :: capacity = 3
integer(I4B), parameter :: elem_size = 2
type(CircularBufferType) :: buffer
real(DP) :: element(elem_size)
real(DP), pointer :: retrieved(:)

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)

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
integer(I4B), parameter :: capacity = 3
integer(I4B), parameter :: elem_size = 2
type(CircularBufferType) :: buffer
real(DP) :: element(elem_size)
real(DP), pointer :: retrieved(:)

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)
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
integer(I4B), parameter :: capacity = 3
integer(I4B), parameter :: elem_size = 2
type(CircularBufferType) :: buffer
real(DP) :: element(elem_size)
real(DP), pointer :: retrieved(:)

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)
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
integer(I4B), parameter :: capacity = 3
integer(I4B), parameter :: elem_size = 2
type(CircularBufferType) :: buffer
real(DP) :: element(elem_size)
real(DP), pointer :: retrieved(:)

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)

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
integer(I4B), parameter :: capacity = 3
integer(I4B), parameter :: elem_size = 2
type(CircularBufferType) :: buffer
real(DP) :: element(elem_size)
real(DP), pointer :: retrieved(:)

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)
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
integer(I4B), parameter :: capacity = 2
integer(I4B), parameter :: elem_size = 2
type(CircularBufferType) :: buffer
real(DP) :: element(elem_size)

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")
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
integer(I4B), parameter :: capacity = 3
integer(I4B), parameter :: elem_size = 1
type(CircularBufferType) :: buffer
real(DP) :: element(elem_size)
real(DP), pointer :: retrieved(:)

! Fill a capacity-3 buffer then push a 4th element: oldest is overwritten.
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)
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
integer(I4B), parameter :: capacity = 3
integer(I4B), parameter :: elem_size = 1
type(CircularBufferType) :: buffer
real(DP) :: element(elem_size)

buffer = CircularBufferType(capacity, elem_size, "TestName", "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
integer(I4B), parameter :: capacity = 3
integer(I4B), parameter :: elem_size = 1
type(CircularBufferType) :: buffer
real(DP) :: element(elem_size)
real(DP), pointer :: retrieved(:)

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)

! 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
1 change: 1 addition & 0 deletions autotest/meson.build
Original file line number Diff line number Diff line change
Expand Up @@ -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',
Expand Down
2 changes: 2 additions & 0 deletions autotest/tester.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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), &
Expand Down
1 change: 1 addition & 0 deletions msvs/mf6core.vfproj
Original file line number Diff line number Diff line change
Expand Up @@ -676,6 +676,7 @@
<File RelativePath="..\src\Utilities\BudgetObject.f90"/>
<File RelativePath="..\src\Utilities\BudgetTerm.f90"/>
<File RelativePath="..\src\Utilities\CharString.f90"/>
<File RelativePath="..\src\Utilities\CircularBuffer.f90"/>

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

don't forget the makefile (just sayin' :-))

<File RelativePath="..\src\Utilities\comarg.f90"/>
<File RelativePath="..\src\Utilities\compilerversion.F90">
<FileConfiguration Name="Debug|Win32">
Expand Down
Loading
Loading