1
1
! SPDX-Identifier: MIT
2
2
module test_insert_at
3
3
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 (==)
5
5
use stdlib_stringlist, only: stringlist_type, stringlist_index_type, fidx, bidx, list_head, &
6
- & list_tail, operator (==), operator (/= )
6
+ & list_tail, operator (// ), operator ( ==), operator (/= )
7
7
use stdlib_ascii, only: to_string
8
8
implicit none
9
9
10
10
contains
11
11
12
12
subroutine test_insert_at_1
13
- type (stringlist_type) :: first_list
13
+ type (stringlist_type) :: work_list
14
14
integer :: i, current_length
15
15
character (len= :), allocatable :: string
16
+ integer , parameter :: first = - 5
17
+ integer , parameter :: last = 1
16
18
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" )
19
21
22
+ write (* ,* ) " test_insert_at_1: Starting test case 1!"
20
23
current_length = 0
21
- do i = - 5 , 1
24
+ do i = first, last
22
25
string = to_string( i )
23
- call first_list % insert_at( fidx(i), string )
26
+ call work_list % insert_at( fidx(i), string )
24
27
current_length = current_length + 1
25
28
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 ) )
38
74
39
75
end do
40
76
77
+ ! compare work_list with [-5, -4, -3, -2, -1, 0, 1]
78
+ call compare_list( work_list, first, last + 1 , 2 )
79
+
41
80
end subroutine test_insert_at_1
42
81
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
+
43
175
end module test_insert_at
44
176
45
177
@@ -48,5 +180,6 @@ program tester
48
180
implicit none
49
181
50
182
call test_insert_at_1
183
+ call test_insert_at_2
51
184
52
185
end program tester
0 commit comments