Skip to content

Commit 42487ea

Browse files
committed
added 2nd test case for insert_at
1 parent 9bfab34 commit 42487ea

File tree

1 file changed

+152
-19
lines changed

1 file changed

+152
-19
lines changed
Lines changed: 152 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1,45 +1,177 @@
11
! SPDX-Identifier: MIT
22
module test_insert_at
33
use stdlib_error, only: check
4-
use stdlib_string_type, only: string_type, char, operator(//), operator(==)
4+
use stdlib_string_type, only: string_type, operator(//), operator(==)
55
use stdlib_stringlist, only: stringlist_type, stringlist_index_type, fidx, bidx, list_head, &
6-
& list_tail, operator(==), operator(/=)
6+
& list_tail, operator(//), operator(==), operator(/=)
77
use stdlib_ascii, only: to_string
88
implicit none
99

1010
contains
1111

1212
subroutine test_insert_at_1
13-
type(stringlist_type) :: first_list
13+
type(stringlist_type) :: work_list
1414
integer :: i, current_length
1515
character(len=:), allocatable :: string
16+
integer, parameter :: first = -5
17+
integer, parameter :: last = 1
1618

17-
call check( first_list%to_current_idxn( list_tail ) == 0, "test_insert_at_1: list_tail == 0")
18-
call check( first_list%to_current_idxn( list_head ) == 1, "test_insert_at_1: list_head == 1")
19+
call check( work_list%to_current_idxn( list_tail ) == 0, "test_insert_at_1: list_tail == 0")
20+
call check( work_list%to_current_idxn( list_head ) == 1, "test_insert_at_1: list_head == 1")
1921

22+
write (*,*) "test_insert_at_1: Starting test case 1!"
2023
current_length = 0
21-
do i = -5, 1
24+
do i = first, last
2225
string = to_string( i )
23-
call first_list%insert_at( fidx(i), string )
26+
call work_list%insert_at( fidx(i), string )
2427
current_length = current_length + 1
2528

26-
call check( first_list%get( fidx(1) ) == string, "test_insert_at_1: get check failed &
27-
& for forward index " // string )
28-
call check( first_list%get( list_head ) == string, "test_insert_at_1: get list_head check &
29-
& failed for " // string )
30-
call check( first_list%get( bidx(current_length) ) == string, "test_insert_at_1: get &
31-
& list_head check failed for backward index " // string )
32-
call check( first_list%get( list_tail ) == to_string(-5), "test_insert_at_1: get list_tail &
33-
& check failed for " // string )
34-
call check( first_list%to_current_idxn( list_head ) == 1, "")
35-
call check( first_list%to_current_idxn( list_tail ) == current_length, "" )
36-
call check( first_list%len() == current_length, "test_insert_at_1: length check &
37-
& failed for " // to_string( current_length ) )
29+
call check( work_list%get( fidx(1) ) == string, "test_insert_at_1:&
30+
& get fidx(1) " // string )
31+
call check( work_list%get( list_head ) == string, "test_insert_at_1:&
32+
& get list_head " // string )
33+
call check( work_list%get( bidx(current_length) ) == string, "test_insert_at_1: get&
34+
& bidx(current_length) " // string )
35+
call check( work_list%get( list_tail ) == to_string(first), "test_insert_at_1: get&
36+
& list_tail " // string )
37+
38+
call check( work_list%to_current_idxn( list_head ) == 1, "test_insert_at_1:&
39+
& to_current_idxn( list_head ) " // to_string( current_length ) )
40+
call check( work_list%to_current_idxn( list_tail ) == current_length, "test_insert_at_1:&
41+
& to_current_idxn( list_tail ) " // to_string( current_length ) )
42+
call check( work_list%len() == current_length, "test_insert_at_1: length check "&
43+
& // to_string( current_length ) )
44+
45+
end do
46+
47+
! compare work_list with [1, 0, -1, -2, -3, -4, -5]
48+
call compare_list( work_list, last, first - 1, 1)
49+
50+
call work_list%destroy()
51+
current_length = 0
52+
53+
write (*,*) "test_insert_at_1: Starting test case 2!"
54+
do i = first, last
55+
string = to_string( i )
56+
call work_list%insert_at( bidx(i), string )
57+
current_length = current_length + 1
58+
59+
call check( work_list%get( bidx(1) ) == string, "test_insert_at_1:&
60+
& get bidx(1) " // string )
61+
call check( work_list%get( list_tail ) == string, "test_insert_at_1:&
62+
& get list_tail " // string )
63+
call check( work_list%get( fidx(current_length) ) == string, "test_insert_at_1: get&
64+
& fidx(current_length) " // string )
65+
call check( work_list%get( list_head ) == to_string(first), "test_insert_at_1: get&
66+
& list_head " // string )
67+
68+
call check( work_list%to_current_idxn( list_head ) == 1, "test_insert_at_1:&
69+
& to_current_idxn( list_head ) " // to_string( current_length ) )
70+
call check( work_list%to_current_idxn( list_tail ) == current_length, "test_insert_at_1:&
71+
& to_current_idxn( list_tail ) " // to_string( current_length ) )
72+
call check( work_list%len() == current_length, "test_insert_at_1: length check "&
73+
& // to_string( current_length ) )
3874

3975
end do
4076

77+
! compare work_list with [-5, -4, -3, -2, -1, 0, 1]
78+
call compare_list( work_list, first, last + 1, 2)
79+
4180
end subroutine test_insert_at_1
4281

82+
subroutine test_insert_at_2
83+
type(stringlist_type) :: work_list
84+
integer :: i, current_length
85+
character(len=:), allocatable :: string
86+
integer, parameter :: first = 2
87+
integer, parameter :: last = 20
88+
89+
write (*,*) "test_insert_at_2: Starting test case 1!"
90+
91+
current_length = 0
92+
do i = first, last, 2
93+
string = to_string( i )
94+
call work_list%insert_at( fidx(i), string )
95+
current_length = current_length + 1
96+
97+
call check( work_list%get( fidx(current_length) ) == string, "test_insert_at_2:&
98+
& get fidx(current_length) " // string )
99+
call check( work_list%get( fidx(1) ) == to_string(first), "test_insert_at_2:&
100+
& get fidx(1) " // string )
101+
call check( work_list%get( list_head ) == to_string(first), "test_insert_at_2:&
102+
& get list_head " // string )
103+
call check( work_list%get( bidx(1) ) == string, "test_insert_at_2:&
104+
& get bidx(1) " // string )
105+
call check( work_list%get( bidx(current_length) ) == to_string(first), "test_insert_at_2: get&
106+
& bidx(current_length) " // string )
107+
call check( work_list%get( list_tail ) == string, "test_insert_at_2: get&
108+
& list_tail " // string )
109+
110+
call check( work_list%to_current_idxn( list_head ) == 1, "test_insert_at_2:&
111+
& to_current_idxn( list_head ) " // to_string( current_length ) )
112+
call check( work_list%to_current_idxn( list_tail ) == current_length, "test_insert_at_2:&
113+
& to_current_idxn( list_tail ) " // to_string( current_length ) )
114+
call check( work_list%len() == current_length, "test_insert_at_2: length check "&
115+
& // to_string( current_length ) )
116+
117+
end do
118+
119+
write (*,*) "test_insert_at_2: Starting test case 2!"
120+
121+
do i = first - 1, last - 1, 2
122+
string = to_string( i )
123+
call work_list%insert_at( fidx(i), string )
124+
current_length = current_length + 1
125+
126+
call check( work_list%get( fidx(i) ) == string, "test_insert_at_2:&
127+
& get fidx(current_length) " // string )
128+
call check( work_list%get( fidx(1) ) == to_string(first - 1), "test_insert_at_2:&
129+
& get fidx(1) " // string )
130+
call check( work_list%get( list_head ) == to_string(first - 1), "test_insert_at_2:&
131+
& get list_head " // string )
132+
call check( work_list%get( bidx(1) ) == to_string(last), "test_insert_at_2:&
133+
& get bidx(1) " // string )
134+
call check( work_list%get( bidx(current_length) ) == to_string(first - 1), "test_insert_at_2: get&
135+
& bidx(current_length) " // string )
136+
call check( work_list%get( list_tail ) == to_string(last), "test_insert_at_2: get&
137+
& list_tail " // string )
138+
139+
call check( work_list%to_current_idxn( list_head ) == 1, "test_insert_at_2:&
140+
& to_current_idxn( list_head ) " // to_string( current_length ) )
141+
call check( work_list%to_current_idxn( list_tail ) == current_length, "test_insert_at_2:&
142+
& to_current_idxn( list_tail ) " // to_string( current_length ) )
143+
call check( work_list%len() == current_length, "test_insert_at_2: length check "&
144+
& // to_string( current_length ) )
145+
146+
end do
147+
148+
! compare work_list with [1, 2, ..., ..., 19, 20]
149+
call compare_list( work_list, first - 1, last + 1, 3 )
150+
151+
end subroutine test_insert_at_2
152+
153+
! compares input stringlist 'list' with an array of consecutive integers
154+
! array is 'first' inclusive and 'last' exclusive
155+
subroutine compare_list(list, first, last, call_number)
156+
type(stringlist_type), intent(in) :: list
157+
integer, intent(in) :: first, last, call_number
158+
integer :: i, j
159+
160+
call check( abs( last - first ) == list%len(), "compare_list: length mis-match&
161+
& call_number " // to_string( call_number ) )
162+
163+
j = merge(-1, 1, last < first)
164+
do i = 1, list%len()
165+
call check( list%get( fidx(i) ) == to_string( first + ( ( i - 1 ) * j ) ), &
166+
& "compare_list: call_number " // to_string( call_number ) &
167+
& // " fidx( " // to_string( i ) // " )")
168+
call check( list%get( bidx(i) ) == to_string( last - ( i * j ) ), &
169+
& "compare_list: call_number " // to_string( call_number ) &
170+
& // " bidx( " // to_string( i ) // " )")
171+
end do
172+
173+
end subroutine compare_list
174+
43175
end module test_insert_at
44176

45177

@@ -48,5 +180,6 @@ program tester
48180
implicit none
49181

50182
call test_insert_at_1
183+
call test_insert_at_2
51184

52185
end program tester

0 commit comments

Comments
 (0)