11! SPDX-Identifier: MIT
22module 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
1010contains
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+
43175end 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
52185end program tester
0 commit comments