1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 1997-2020. All Rights Reserved. 5%% 6%% Licensed under the Apache License, Version 2.0 (the "License"); 7%% you may not use this file except in compliance with the License. 8%% You may obtain a copy of the License at 9%% 10%% http://www.apache.org/licenses/LICENSE-2.0 11%% 12%% Unless required by applicable law or agreed to in writing, software 13%% distributed under the License is distributed on an "AS IS" BASIS, 14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15%% See the License for the specific language governing permissions and 16%% limitations under the License. 17%% 18%% %CopyrightEnd% 19%% 20%%%---------------------------------------------------------------- 21%%% Purpose: Test suite for the 'lists' module. 22%%%----------------------------------------------------------------- 23 24-module(lists_SUITE). 25-include_lib("common_test/include/ct.hrl"). 26 27%% Test server specific exports 28-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 29 init_per_group/2,end_per_group/2]). 30-export([init_per_testcase/2, end_per_testcase/2]). 31 32%% Test cases must be exported. 33-export([member/1, reverse/1, 34 keymember/1, keysearch_keyfind/1, 35 keystore/1, keytake/1, keyreplace/1, 36 append_1/1, append_2/1, 37 seq_loop/1, seq_2/1, seq_3/1, seq_2_e/1, seq_3_e/1, 38 39 sublist_2/1, sublist_3/1, sublist_2_e/1, sublist_3_e/1, 40 flatten_1/1, flatten_2/1, flatten_1_e/1, flatten_2_e/1, 41 dropwhile/1, takewhile/1, 42 sort_1/1, sort_stable/1, merge/1, rmerge/1, sort_rand/1, 43 usort_1/1, usort_stable/1, umerge/1, rumerge/1,usort_rand/1, 44 keymerge/1, rkeymerge/1, 45 keysort_1/1, keysort_i/1, keysort_stable/1, 46 keysort_rand/1, keysort_error/1, 47 ukeymerge/1, rukeymerge/1, 48 ukeysort_1/1, ukeysort_i/1, ukeysort_stable/1, 49 ukeysort_rand/1, ukeysort_error/1, 50 funmerge/1, rfunmerge/1, 51 funsort_1/1, funsort_stable/1, funsort_rand/1, 52 funsort_error/1, 53 ufunmerge/1, rufunmerge/1, 54 ufunsort_1/1, ufunsort_stable/1, ufunsort_rand/1, 55 ufunsort_error/1, 56 zip_unzip/1, zip_unzip3/1, zipwith/1, zipwith3/1, 57 filter_partition/1, 58 join/1, 59 otp_5939/1, otp_6023/1, otp_6606/1, otp_7230/1, 60 suffix/1, subtract/1, droplast/1, search/1, hof/1, 61 error_info/1]). 62 63%% Sort randomized lists until stopped. 64%% 65%% If you update some of the sort or merge functions, you should 66%% definitely let sort_loop work for a couple of hours or days. Try 67%% both sort_loop/0 and sort_loop/1 with a small argument (30-50 say). 68 69-export([sort_loop/0, sort_loop/1, sloop/1]). 70 71%% Internal export. 72-export([make_fun/1]). 73 74%% 75%% all/1 76%% 77suite() -> 78 [{ct_hooks,[ts_install_cth]}, 79 {timetrap,{minutes,4}}]. 80 81all() -> 82 [{group, append}, 83 {group, key}, 84 {group,sort}, 85 {group, usort}, 86 {group, keysort}, 87 {group, ukeysort}, 88 {group, funsort}, 89 {group, ufunsort}, 90 {group, sublist}, 91 {group, flatten}, 92 {group, seq}, 93 {group, tickets}, 94 {group, zip}, 95 {group, misc}]. 96 97groups() -> 98 [{append, [parallel], [append_1, append_2]}, 99 {usort, [parallel], 100 [umerge, rumerge, usort_1, usort_rand, usort_stable]}, 101 {keysort, [parallel], 102 [keymerge, rkeymerge, keysort_1, keysort_rand, 103 keysort_i, keysort_stable, keysort_error]}, 104 {key, [parallel], [keymember, keysearch_keyfind, keystore, 105 keytake, keyreplace]}, 106 {sort,[parallel],[merge, rmerge, sort_1, sort_rand]}, 107 {ukeysort, [parallel], 108 [ukeymerge, rukeymerge, ukeysort_1, ukeysort_rand, 109 ukeysort_i, ukeysort_stable, ukeysort_error]}, 110 {funsort, [parallel], 111 [funmerge, rfunmerge, funsort_1, funsort_stable, 112 funsort_error, funsort_rand]}, 113 {ufunsort, [parallel], 114 [ufunmerge, rufunmerge, ufunsort_1, ufunsort_stable, 115 ufunsort_error, ufunsort_rand]}, 116 {seq, [parallel], [seq_loop, seq_2, seq_3, seq_2_e, seq_3_e]}, 117 {sublist, [parallel], 118 [sublist_2, sublist_3, sublist_2_e, sublist_3_e]}, 119 {flatten, [parallel], 120 [flatten_1, flatten_2, flatten_1_e, flatten_2_e]}, 121 {tickets, [parallel], [otp_5939, otp_6023, otp_6606, otp_7230]}, 122 {zip, [parallel], [zip_unzip, zip_unzip3, zipwith, zipwith3]}, 123 {misc, [parallel], [reverse, member, dropwhile, takewhile, 124 filter_partition, suffix, subtract, join, 125 hof, droplast, search, error_info]} 126 ]. 127 128init_per_suite(Config) -> 129 Config. 130 131end_per_suite(_Config) -> 132 ok. 133 134init_per_group(_GroupName, Config) -> 135 Config. 136 137end_per_group(_GroupName, Config) -> 138 Config. 139 140 141init_per_testcase(_Case, Config) -> 142 Config. 143 144end_per_testcase(_Case, _Config) -> 145 ok. 146 147%% 148%% Test cases starts here. 149%% 150 151append_1(Config) when is_list(Config) -> 152 "abcdef"=lists:append(["abc","def"]), 153 [hej, du,[glade, [bagare]]]= 154 lists:append([[hej], [du], [[glade, [bagare]]]]), 155 [10, [elem]]=lists:append([[10], [[elem]]]), 156 ok. 157 158append_2(Config) when is_list(Config) -> 159 "abcdef"=lists:append("abc", "def"), 160 [hej, du]=lists:append([hej], [du]), 161 [10, [elem]]=lists:append([10], [[elem]]), 162 163 %% Trapping, both crashing and otherwise. 164 [append_trapping_1(N) || N <- lists:seq(0, 20)], 165 166 ok. 167 168append_trapping_1(N) -> 169 List = lists:duplicate(N + (1 bsl N), gurka), 170 ImproperList = List ++ crash, 171 172 {'EXIT',_} = (catch (ImproperList ++ [])), 173 174 [3, 2, 1 | List] = lists:reverse(List ++ [1, 2, 3]), 175 176 ok. 177 178%% Tests the lists:reverse() implementation. The function is 179%% `non-blocking', and only processes a fixed number of elements at a 180%% time. 181reverse(Config) when is_list(Config) -> 182 reverse_test(0), 183 reverse_test(1), 184 reverse_test(2), 185 reverse_test(128), 186 reverse_test(256), 187 reverse_test(1000), 188 reverse_test(1998), 189 reverse_test(1999), 190 reverse_test(2000), 191 reverse_test(2001), 192 reverse_test(3998), 193 reverse_test(3999), 194 reverse_test(4000), 195 reverse_test(4001), 196 reverse_test(60001), 197 reverse_test(100007), 198 ok. 199 200reverse_test(0) -> 201 case lists:reverse([]) of 202 [] -> 203 ok; 204 _Other -> 205 error 206 end; 207reverse_test(Num) -> 208 List0 = ['The Element'|lists:duplicate(Num, 'Ele')], 209 List = lists:reverse(List0), 210 ['Ele'|_] = List, 211 'The Element' = lists:last(List), 212 List0 = lists:reverse(List), 213 ok. 214 215%% Test the lists:member() implementation. This test case depends on 216%% lists:reverse() to work, wich is tested in a separate test case. 217member(Config) when is_list(Config) -> 218 {'EXIT',{badarg,_}} = (catch lists:member(45, {a,b,c})), 219 {'EXIT',{badarg,_}} = (catch lists:member(45, [0|non_list_tail])), 220 false = lists:member(4233, []), 221 member_test(1), 222 member_test(100), 223 member_test(256), 224 member_test(1000), 225 member_test(1998), 226 member_test(1999), 227 member_test(2000), 228 member_test(2001), 229 member_test(3998), 230 member_test(3999), 231 member_test(4000), 232 member_test(4001), 233 member_test(100008), 234 ok. 235 236member_test(Num) -> 237 List0 = ['The Element'|lists:duplicate(Num, 'Elem')], 238 true = lists:member('The Element', List0), 239 true = lists:member('Elem', List0), 240 false = lists:member(arne_anka, List0), 241 false = lists:member({a,b,c}, List0), 242 List = lists:reverse(List0), 243 true = lists:member('The Element', List), 244 true = lists:member('Elem', List), 245 false = lists:member(arne_anka, List), 246 false = lists:member({a,b,c}, List). 247 248keymember(Config) when is_list(Config) -> 249 false = lists:keymember(anything_goes, 1, []), 250 {'EXIT',{badarg,_}} = (catch lists:keymember(anything_goes, -1, [])), 251 {'EXIT',{badarg,_}} = (catch lists:keymember(anything_goes, 0, [])), 252 {'EXIT',{badarg,_}} = (catch lists:keymember(anything_goes, 1, {1,2,3})), 253 List = [{52.0,a},{-19,b,c},{37.5,d},an_atom,42.0,{39},{45,{x,y,z}}], 254 255 false = lists:keymember(333, 5, List), 256 false = lists:keymember(333, 999, List), 257 false = lists:keymember(37, 1, List), 258 259 true = lists:keymember(52.0, 1, List), 260 true = lists:keymember(52, 1, List), 261 true = lists:keymember(-19, 1, List), 262 true = lists:keymember(-19.0, 1, List), 263 true = lists:keymember(37.5, 1, List), 264 true = lists:keymember(39, 1, List), 265 true = lists:keymember(39.0, 1, List), 266 true = lists:keymember(45, 1, List), 267 true = lists:keymember(45.0, 1, List), 268 269 true = lists:keymember(a, 2, List), 270 true = lists:keymember(b, 2, List), 271 true = lists:keymember(c, 3, List), 272 true = lists:keymember(d, 2, List), 273 true = lists:keymember({x,y,z}, 2, List), 274 275 Long0 = lists:seq(1, 100007), 276 false = lists:keymember(kalle, 1, Long0), 277 Long = lists:foldl(fun(E, A) -> [{1/E,E}|A] end, [], Long0), 278 true = lists:keymember(1, 2, Long), 279 true = lists:keymember(2, 2, Long), 280 true = lists:keymember(1.0, 2, Long), 281 true = lists:keymember(2.0, 2, Long), 282 true = lists:keymember(100006, 2, Long), 283 ok. 284 285keysearch_keyfind(Config) when is_list(Config) -> 286 false = key_search_find(anything_goes, 1, []), 287 {'EXIT',{badarg,_}} = (catch key_search_find(anything_goes, -1, [])), 288 {'EXIT',{badarg,_}} = (catch key_search_find(anything_goes, 0, [])), 289 {'EXIT',{badarg,_}} = (catch key_search_find(anything_goes, 1, {1,2,3})), 290 291 First = {x,42.0}, 292 Second = {y,-77}, 293 Third = {z,[a,b,c],{5.0}}, 294 List = [First,Second,Third], 295 296 false = key_search_find(333, 1, []), 297 false = key_search_find(333, 5, List), 298 false = key_search_find(333, 999, List), 299 false = key_search_find(37, 1, List), 300 301 {value,First} = key_search_find(42, 2, List), 302 {value,First} = key_search_find(42.0, 2, List), 303 304 {value,Second} = key_search_find(-77, 2, List), 305 {value,Second} = key_search_find(-77.0, 2, List), 306 307 {value,Third} = key_search_find(z, 1, List), 308 {value,Third} = key_search_find([a,b,c], 2, List), 309 {value,Third} = key_search_find({5}, 3, List), 310 {value,Third} = key_search_find({5.0}, 3, List), 311 312 Long0 = lists:seq(1, 100007), 313 false = key_search_find(kalle, 1, Long0), 314 Long = lists:foldl(fun(E, A) -> [{1/E,float(E)}|A] end, [], Long0), 315 {value,{_,1.0}} = key_search_find(1, 2, Long), 316 {value,{_,1.0}} = key_search_find(1.0, 2, Long), 317 {value,{_,2.0}} = key_search_find(2, 2, Long), 318 {value,{_,2.0}} = key_search_find(2.0, 2, Long), 319 {value,{_,33988.0}} = key_search_find(33988, 2, Long), 320 {value,{_,33988.0}} = key_search_find(33988.0, 2, Long), 321 ok. 322 323%% Test both lists:keysearch/3 and lists:keyfind/3. The only 324%% difference between these two functions is that lists:keysearch/3 325%% wraps a successfully returned tuple in a value tuple. 326%% 327key_search_find(Key, Pos, List) -> 328 case lists:keyfind(Key, Pos, List) of 329 false -> 330 false = lists:keysearch(Key, Pos, List); 331 Tuple when is_tuple(Tuple) -> 332 {value,Tuple} = lists:keysearch(Key, Pos, List) 333 end. 334 335dropwhile(Config) when is_list(Config) -> 336 F = fun(C) -> C =:= $@ end, 337 338 [] = lists:dropwhile(F, []), 339 [a] = lists:dropwhile(F, [a]), 340 [a,b] = lists:dropwhile(F, [a,b]), 341 [a,b,c] = lists:dropwhile(F, [a,b,c]), 342 343 [] = lists:dropwhile(F, [$@]), 344 [] = lists:dropwhile(F, [$@,$@]), 345 [a,$@] = lists:dropwhile(F, [$@,a,$@]), 346 347 [$k] = lists:dropwhile(F, [$@,$k]), 348 [$k,$l] = lists:dropwhile(F, [$@,$@,$k,$l]), 349 [a] = lists:dropwhile(F, [$@,$@,$@,a]), 350 351 [a,$@,b] = lists:dropwhile(F, [$@,a,$@,b]), 352 [a,$@,b] = lists:dropwhile(F, [$@,$@,a,$@,b]), 353 [a,$@,b] = lists:dropwhile(F, [$@,$@,$@,a,$@,b]), 354 355 Long = lists:seq(1, 1024), 356 Shorter = lists:seq(800, 1024), 357 358 Shorter = lists:dropwhile(fun(E) -> E < 800 end, Long), 359 360 ok. 361 362takewhile(Config) when is_list(Config) -> 363 F = fun(C) -> C =/= $@ end, 364 365 [] = lists:takewhile(F, []), 366 [a] = lists:takewhile(F, [a]), 367 [a,b] = lists:takewhile(F, [a,b]), 368 [a,b,c] = lists:takewhile(F, [a,b,c]), 369 370 [] = lists:takewhile(F, [$@]), 371 [] = lists:takewhile(F, [$@,$@]), 372 [a] = lists:takewhile(F, [a,$@]), 373 374 [$k] = lists:takewhile(F, [$k,$@]), 375 [$k,$l] = lists:takewhile(F, [$k,$l,$@,$@]), 376 [a] = lists:takewhile(F, [a,$@,$@,$@]), 377 378 [] = lists:takewhile(F, [$@,a,$@,b]), 379 [] = lists:takewhile(F, [$@,$@,a,$@,b]), 380 [] = lists:takewhile(F, [$@,$@,$@,a,$@,b]), 381 382 Long = lists:seq(1, 1024), 383 Shorter = lists:seq(1, 400), 384 385 Shorter = lists:takewhile(fun(E) -> E =< 400 end, Long), 386 387 ok. 388 389keystore(Config) when is_list(Config) -> 390 {'EXIT',_} = (catch lists:keystore(key, 0, [], {1})), 391 {'EXIT',_} = (catch lists:keystore(key, 1, {}, {})), 392 {'EXIT',_} = (catch lists:keystore(key, 1, {a,b}, {})), 393 {'EXIT', _} = (catch lists:keystore(a, 2, [{1,a}], b)), 394 T = {k,17}, 395 [T] = lists:keystore(a, 2, [], T), 396 [{1,a},{2,b},{k,17}] = lists:keystore(c, 2, [{1,a},{2,b}],T), 397 L = [{1,a},{2,b},{3,c}], 398 [{k,17},{2,b},{3,c}] = lists:keystore(a, 2, L, T), 399 [{1,a},{k,17},{3,c}] = lists:keystore(b, 2, L, T), 400 [{1,a},{2,b},{k,17}] = lists:keystore(c, 2, L, T), 401 [{2,b}] = lists:keystore(a, 2, [{1,a}], {2,b}), 402 [{1,a}] = lists:keystore(foo, 1, [], {1,a}), 403 ok. 404 405keytake(Config) when is_list(Config) -> 406 {'EXIT',_} = (catch lists:keytake(key, 0, [])), 407 {'EXIT',_} = (catch lists:keytake(key, 1, {})), 408 {'EXIT',_} = (catch lists:keytake(key, 1, {a,b})), 409 false = lists:keytake(key, 2, [{a}]), 410 false = lists:keytake(key, 1, [a]), 411 false = lists:keytake(k, 1, []), 412 false = lists:keytake(k, 1, [{a},{b},{c}]), 413 L = [{a,1},{b,2},{c,3}], 414 {value,{a,1},[{b,2},{c,3}]} = lists:keytake(1, 2, L), 415 {value,{b,2},[{a,1},{c,3}]} = lists:keytake(2, 2, L), 416 {value,{c,3},[{a,1},{b,2}]} = lists:keytake(3, 2, L), 417 false = lists:keytake(4, 2, L), 418 ok. 419 420%% Test lists:keyreplace/4. 421keyreplace(Config) when is_list(Config) -> 422 [{new,42}] = lists:keyreplace(k, 1, [{k,1}], {new,42}), 423 [atom,{new,a,b}] = lists:keyreplace(k, 1, [atom,{k,1}], {new,a,b}), 424 [a,{x,y,z}] = lists:keyreplace(a, 5, [a,{x,y,z}], {no,use}), 425 426 %% Error cases. 427 {'EXIT',_} = (catch lists:keyreplace(k, 1, [], not_tuple)), 428 {'EXIT',_} = (catch lists:keyreplace(k, 0, [], {a,b})), 429 ok. 430 431merge(Config) when is_list(Config) -> 432 433 %% merge list of lists 434 [] = lists:merge([]), 435 [] = lists:merge([[]]), 436 [] = lists:merge([[],[]]), 437 [] = lists:merge([[],[],[]]), 438 [1] = lists:merge([[1]]), 439 [1,1,2,2] = lists:merge([[1,2],[1,2]]), 440 [1] = lists:merge([[1],[],[]]), 441 [1] = lists:merge([[],[1],[]]), 442 [1] = lists:merge([[],[],[1]]), 443 [1,2] = lists:merge([[1],[2],[]]), 444 [1,2] = lists:merge([[1],[],[2]]), 445 [1,2] = lists:merge([[],[1],[2]]), 446 [1,2,3,4,5,6] = lists:merge([[1,2],[],[5,6],[],[3,4],[]]), 447 [1,2,3,4] = lists:merge([[4],[3],[2],[1]]), 448 [1,2,3,4,5] = lists:merge([[1],[2],[3],[4],[5]]), 449 [1,2,3,4,5,6] = lists:merge([[1],[2],[3],[4],[5],[6]]), 450 [1,2,3,4,5,6,7,8,9] = 451 lists:merge([[1],[2],[3],[4],[5],[6],[7],[8],[9]]), 452 Seq = lists:seq(1,100), 453 true = Seq == lists:merge(lists:map(fun(E) -> [E] end, Seq)), 454 455 Two = [1,2], 456 Six = [1,2,3,4,5,6], 457 458 %% 2-way merge 459 [] = lists:merge([], []), 460 Two = lists:merge(Two, []), 461 Two = lists:merge([], Two), 462 Six = lists:merge([1,3,5], [2,4,6]), 463 Six = lists:merge([2,4,6], [1,3,5]), 464 Six = lists:merge([1,2,3], [4,5,6]), 465 Six = lists:merge([4,5,6], [1,2,3]), 466 Six = lists:merge([1,2,5],[3,4,6]), 467 [1,2,3,5,7] = lists:merge([1,3,5,7], [2]), 468 [1,2,3,4,5,7] = lists:merge([1,3,5,7], [2,4]), 469 [1,2,3,4,5,6,7] = lists:merge([1,3,5,7], [2,4,6]), 470 [1,2,3,5,7] = lists:merge([2], [1,3,5,7]), 471 [1,2,3,4,5,7] = lists:merge([2,4], [1,3,5,7]), 472 [1,2,3,4,5,6,7] = lists:merge([2,4,6], [1,3,5,7]), 473 474 %% 3-way merge 475 [] = lists:merge3([], [], []), 476 Two = lists:merge3([], [], Two), 477 Two = lists:merge3([], Two, []), 478 Two = lists:merge3(Two, [], []), 479 Six = lists:merge3([], [1,3,5], [2,4,6]), 480 Six = lists:merge3([1,3,5], [], [2,4,6]), 481 Six = lists:merge3([1,3,5], [2,4,6], []), 482 Nine = lists:merge3([1,4,7],[2,5,8],[3,6,9]), 483 Nine = lists:merge3([1,4,7],[3,6,9],[2,5,8]), 484 Nine = lists:merge3([3,6,9],[1,4,7],[2,5,8]), 485 Nine = lists:merge3([4,5,6],[1,2,3],[7,8,9]), 486 Nine = lists:merge3([1,2,3],[4,5,6],[7,8,9]), 487 Nine = lists:merge3([7,8,9],[4,5,6],[1,2,3]), 488 Nine = lists:merge3([4,5,6],[7,8,9],[1,2,3]), 489 490 ok. 491 492%% reverse merge functions 493rmerge(Config) when is_list(Config) -> 494 495 Two = [2,1], 496 Six = [6,5,4,3,2,1], 497 498 %% 2-way reversed merge 499 [] = lists:rmerge([], []), 500 Two = lists:rmerge(Two, []), 501 Two = lists:rmerge([], Two), 502 Six = lists:rmerge([5,3,1], [6,4,2]), 503 Six = lists:rmerge([6,4,2], [5,3,1]), 504 Six = lists:rmerge([3,2,1], [6,5,4]), 505 Six = lists:rmerge([6,5,4], [3,2,1]), 506 Six = lists:rmerge([4,3,2],[6,5,1]), 507 [7,6,5,3,1] = lists:rmerge([7,5,3,1], [6]), 508 [7,6,5,4,3,1] = lists:rmerge([7,5,3,1], [6,4]), 509 [7,6,5,4,3,2,1] = lists:rmerge([7,5,3,1], [6,4,2]), 510 [7,5,3,2,1] = lists:rmerge([2], [7,5,3,1]), 511 [7,5,4,3,2,1] = lists:rmerge([4,2], [7,5,3,1]), 512 [7,6,5,4,3,2,1] = lists:rmerge([6,4,2], [7,5,3,1]), 513 514 Nine = [9,8,7,6,5,4,3,2,1], 515 516 %% 3-way reversed merge 517 [] = lists:rmerge3([], [], []), 518 Two = lists:rmerge3([], [], Two), 519 Two = lists:rmerge3([], Two, []), 520 Two = lists:rmerge3(Two, [], []), 521 Six = lists:rmerge3([], [5,3,1], [6,4,2]), 522 Six = lists:rmerge3([5,3,1], [], [6,4,2]), 523 Six = lists:rmerge3([5,3,1], [6,4,2], []), 524 Nine = lists:rmerge3([7,4,1],[8,5,2],[9,6,3]), 525 Nine = lists:rmerge3([7,4,1],[9,6,3],[8,5,2]), 526 Nine = lists:rmerge3([9,6,3],[7,4,1],[8,5,2]), 527 Nine = lists:rmerge3([6,5,4],[3,2,1],[9,8,7]), 528 Nine = lists:rmerge3([3,2,1],[6,5,4],[9,8,7]), 529 Nine = lists:rmerge3([9,8,7],[6,5,4],[3,2,1]), 530 Nine = lists:rmerge3([6,5,4],[9,8,7],[3,2,1]), 531 532 ok. 533 534sort_1(Config) when is_list(Config) -> 535 [] = lists:sort([]), 536 [a] = lists:sort([a]), 537 [a,a] = lists:sort([a,a]), 538 [a,b] = lists:sort([a,b]), 539 [a,b] = lists:sort([b,a]), 540 [1,1] = lists:sort([1,1]), 541 [1,1,2,3] = lists:sort([1,1,3,2]), 542 [1,2,3,3] = lists:sort([3,3,1,2]), 543 [1,1,1,1] = lists:sort([1,1,1,1]), 544 [1,1,1,2,2,2,3,3,3] = lists:sort([3,3,3,2,2,2,1,1,1]), 545 [1,1,1,2,2,2,3,3,3] = lists:sort([1,1,1,2,2,2,3,3,3]), 546 547 lists:foreach(fun check/1, perms([1,2,3])), 548 lists:foreach(fun check/1, perms([1,2,3,4,5,6,7,8])), 549 ok. 550 551%% sort/1 on big randomized lists 552sort_rand(Config) when is_list(Config) -> 553 ok = check(biglist(10)), 554 ok = check(biglist(100)), 555 ok = check(biglist(1000)), 556 ok = check(biglist(10000)), 557 ok. 558 559%% sort/1 was really stable for a while - the order of equal elements 560%% was kept - but since the performance suffered a bit, this "feature" 561%% was removed. 562 563%% sort/1 should be stable for equal terms. 564sort_stable(Config) when is_list(Config) -> 565 ok = check_stability(bigfunlist(10)), 566 ok = check_stability(bigfunlist(100)), 567 ok = check_stability(bigfunlist(1000)), 568 case erlang:system_info(modified_timing_level) of 569 undefined -> ok = check_stability(bigfunlist(10000)); 570 _ -> ok 571 end, 572 ok. 573 574check([]) -> 575 ok; 576check(L) -> 577 S = lists:sort(L), 578 case {length(L) == length(S), check(hd(S), tl(S))} of 579 {true,ok} -> 580 ok; 581 _ -> 582 io:format("~w~n", [L]), 583 erlang:error(check) 584 end. 585 586check(_A, []) -> 587 ok; 588check(A, [B | L]) when A =< B -> 589 check(B, L); 590check(_A, _L) -> 591 no. 592 593%% The check that sort/1 is stable is no longer used. 594%% Equal elements are no longer always kept in order. 595check_stability(L) -> 596 S = lists:sort(L), 597 LP = explicit_pid(L), 598 SP = explicit_pid(S), 599 check_sorted(1, 2, LP, SP). 600 601explicit_pid(L) -> 602 lists:reverse(expl_pid(L, [])). 603 604expl_pid([{I,F} | T], L) when is_function(F) -> 605 expl_pid(T, [{I,fun_pid(F)} | L]); 606expl_pid([], L) -> 607 L. 608 609 610usort_1(Conf) when is_list(Conf) -> 611 [] = lists:usort([]), 612 [1] = lists:usort([1]), 613 [1] = lists:usort([1,1]), 614 [1] = lists:usort([1,1,1,1,1]), 615 [1,2] = lists:usort([1,2]), 616 [1,2] = lists:usort([1,2,1]), 617 [1,2] = lists:usort([1,2,2]), 618 [1,2,3] = lists:usort([1,3,2]), 619 [1,3] = lists:usort([3,1,3]), 620 [0,1,3] = lists:usort([3,1,0]), 621 [1,2,3] = lists:usort([3,1,2]), 622 [1,2] = lists:usort([2,1,1]), 623 [1,2] = lists:usort([2,1]), 624 [0,3,4,8,9] = lists:usort([3,8,9,0,9,4]), 625 626 lists:foreach(fun ucheck/1, perms([1,2,3])), 627 lists:foreach(fun ucheck/1, perms([1,2,3,4,5,6,2,1])), 628 629 ok. 630 631umerge(Conf) when is_list(Conf) -> 632 %% merge list of lists 633 [] = lists:umerge([]), 634 [] = lists:umerge([[]]), 635 [] = lists:umerge([[],[]]), 636 [] = lists:umerge([[],[],[]]), 637 [1] = lists:umerge([[1]]), 638 [1,2] = lists:umerge([[1,2],[1,2]]), 639 [1] = lists:umerge([[1],[],[]]), 640 [1] = lists:umerge([[],[1],[]]), 641 [1] = lists:umerge([[],[],[1]]), 642 [1,2] = lists:umerge([[1],[2],[]]), 643 [1,2] = lists:umerge([[1],[],[2]]), 644 [1,2] = lists:umerge([[],[1],[2]]), 645 [1,2,3,4,5,6] = lists:umerge([[1,2],[],[5,6],[],[3,4],[]]), 646 [1,2,3,4] = lists:umerge([[4],[3],[2],[1]]), 647 [1,2,3,4,5] = lists:umerge([[1],[2],[3],[4],[5]]), 648 [1,2,3,4,5,6] = lists:umerge([[1],[2],[3],[4],[5],[6]]), 649 [1,2,3,4,5,6,7,8,9] = 650 lists:umerge([[1],[2],[3],[4],[5],[6],[7],[8],[9]]), 651 [1,2,4,6,8] = lists:umerge([[1,2],[2,4,6,8]]), 652 Seq = lists:seq(1,100), 653 true = Seq == lists:umerge(lists:map(fun(E) -> [E] end, Seq)), 654 655 Two = [1,2], 656 Six = [1,2,3,4,5,6], 657 658 %% 2-way unique merge 659 [] = lists:umerge([], []), 660 Two = lists:umerge(Two, []), 661 Two = lists:umerge([], Two), 662 Six = lists:umerge([1,3,5], [2,4,6]), 663 Six = lists:umerge([2,4,6], [1,3,5]), 664 Six = lists:umerge([1,2,3], [4,5,6]), 665 Six = lists:umerge([4,5,6], [1,2,3]), 666 Six = lists:umerge([1,2,5],[3,4,6]), 667 [1,2,3,5,7] = lists:umerge([1,3,5,7], [2]), 668 [1,2,3,4,5,7] = lists:umerge([1,3,5,7], [2,4]), 669 [1,2,3,4,5,6,7] = lists:umerge([1,3,5,7], [2,4,6]), 670 [1,2,3,5,7] = lists:umerge([2], [1,3,5,7]), 671 [1,2,3,4,5,7] = lists:umerge([2,4], [1,3,5,7]), 672 [1,2,3,4,5,6,7] = lists:umerge([2,4,6], [1,3,5,7]), 673 674 [1,2,3,5,7] = lists:umerge([1,2,3,5,7], [2]), 675 [1,2,3,4,5,7] = lists:umerge([1,2,3,4,5,7], [2,4]), 676 [1,2,3,4,5,6,7] = lists:umerge([1,2,3,4,5,6,7], [2,4,6]), 677 [1,2,3,5,7] = lists:umerge([2], [1,2,3,5,7]), 678 [1,2,3,4,5,7] = lists:umerge([2,4], [1,2,3,4,5,7]), 679 [1,2,3,4,5,6,7] = lists:umerge([2,4,6], [1,2,3,4,5,6,7]), 680 681 %% 3-way unique merge 682 [] = lists:umerge3([], [], []), 683 Two = lists:umerge3([], [], Two), 684 Two = lists:umerge3([], Two, []), 685 Two = lists:umerge3(Two, [], []), 686 Six = lists:umerge3([], [1,3,5], [2,4,6]), 687 Six = lists:umerge3([1,3,5], [], [2,4,6]), 688 Six = lists:umerge3([1,3,5], [2,4,6], []), 689 Nine = lists:umerge3([1,4,7],[2,5,8],[3,6,9]), 690 Nine = lists:umerge3([1,4,7],[3,6,9],[2,5,8]), 691 Nine = lists:umerge3([3,6,9],[1,4,7],[2,5,8]), 692 Nine = lists:umerge3([4,5,6],[1,2,3],[7,8,9]), 693 Nine = lists:umerge3([1,2,3],[4,5,6],[7,8,9]), 694 Nine = lists:umerge3([7,8,9],[4,5,6],[1,2,3]), 695 Nine = lists:umerge3([4,5,6],[7,8,9],[1,2,3]), 696 697 [1,2,3] = lists:umerge3([1,2,3],[1,2,3],[1,2,3]), 698 [1,2,3,4] = lists:umerge3([2,3,4],[1,2,3],[2,3,4]), 699 [1,2,3] = lists:umerge3([1,2,3],[2,3],[1,2,3]), 700 [1,2,3,4] = lists:umerge3([2,3,4],[3,4],[1,2,3]), 701 702 ok. 703 704rumerge(Conf) when is_list(Conf) -> 705 Two = [2,1], 706 Six = [6,5,4,3,2,1], 707 708 %% 2-way reversed unique merge 709 [] = lists:rumerge([], []), 710 Two = lists:rumerge(Two, []), 711 Two = lists:rumerge([], Two), 712 Six = lists:rumerge([5,3,1], [6,4,2]), 713 Six = lists:rumerge([6,4,2], [5,3,1]), 714 Six = lists:rumerge([3,2,1], [6,5,4]), 715 Six = lists:rumerge([6,5,4], [3,2,1]), 716 Six = lists:rumerge([4,3,2],[6,5,1]), 717 [7,6,5,3,1] = lists:rumerge([7,5,3,1], [6]), 718 [7,6,5,4,3,1] = lists:rumerge([7,5,3,1], [6,4]), 719 [7,6,5,4,3,2,1] = lists:rumerge([7,5,3,1], [6,4,2]), 720 [7,5,3,2,1] = lists:rumerge([2], [7,5,3,1]), 721 [7,5,4,3,2,1] = lists:rumerge([4,2], [7,5,3,1]), 722 [7,6,5,4,3,2,1] = lists:rumerge([6,4,2], [7,5,3,1]), 723 724 [7,6,5,3,1] = lists:rumerge([7,6,5,3,1], [6]), 725 [7,6,5,4,3,1] = lists:rumerge([7,6,5,4,3,1], [6,4]), 726 [7,6,5,4,3,2,1] = lists:rumerge([7,6,5,4,3,2,1], [6,4,2]), 727 [7,5,3,2,1] = lists:rumerge([2], [7,5,3,2,1]), 728 [7,5,4,3,2,1] = lists:rumerge([4,2], [7,5,4,3,2,1]), 729 [7,6,5,4,3,2,1] = lists:rumerge([6,4,2], [7,6,5,4,3,2,1]), 730 731 Nine = [9,8,7,6,5,4,3,2,1], 732 733 %% 3-way reversed unique merge 734 [] = lists:rumerge3([], [], []), 735 Two = lists:rumerge3([], [], Two), 736 Two = lists:rumerge3([], Two, []), 737 Two = lists:rumerge3(Two, [], []), 738 Six = lists:rumerge3([], [5,3,1], [6,4,2]), 739 Six = lists:rumerge3([5,3,1], [], [6,4,2]), 740 Six = lists:rumerge3([5,3,1], [6,4,2], []), 741 Nine = lists:rumerge3([7,4,1],[8,5,2],[9,6,3]), 742 Nine = lists:rumerge3([7,4,1],[9,6,3],[8,5,2]), 743 Nine = lists:rumerge3([9,6,3],[7,4,1],[8,5,2]), 744 Nine = lists:rumerge3([6,5,4],[3,2,1],[9,8,7]), 745 Nine = lists:rumerge3([3,2,1],[6,5,4],[9,8,7]), 746 Nine = lists:rumerge3([9,8,7],[6,5,4],[3,2,1]), 747 Nine = lists:rumerge3([6,5,4],[9,8,7],[3,2,1]), 748 749 [3,2,1] = lists:rumerge3([3,2,1],[3,2,1],[3,2,1]), 750 [4,3,2,1] = lists:rumerge3([4,3,2],[3,2,1],[3,2,1]), 751 [5,4,3,2,1] = lists:rumerge3([4,3,2],[5,4,3,2],[5,4,3,2,1]), 752 [6,5,4,3,2] = lists:rumerge3([4,3,2],[5,4,3,2],[6,5,4,3]), 753 754 L1 = [c,d,e], 755 L2 = [b,c,d], 756 true = 757 lists:umerge(L1, L2) == 758 lists:reverse(lists:rumerge(lists:reverse(L1), lists:reverse(L2))), 759 ok. 760 761%% usort/1 on big randomized lists. 762usort_rand(Config) when is_list(Config) -> 763 ok = ucheck(biglist(10)), 764 ok = ucheck(biglist(100)), 765 ok = ucheck(biglist(1000)), 766 ok = ucheck(biglist(10000)), 767 768 ok = ucheck(ubiglist(10)), 769 ok = ucheck(ubiglist(100)), 770 ok = ucheck(ubiglist(1000)), 771 ok = ucheck(ubiglist(10000)), 772 ok. 773 774%% usort/1 should keep the first duplicate. 775usort_stable(Config) when is_list(Config) -> 776 ok = ucheck_stability(bigfunlist(3)), 777 ok = ucheck_stability(bigfunlist(10)), 778 ok = ucheck_stability(bigfunlist(100)), 779 ok = ucheck_stability(bigfunlist(1000)), 780 case erlang:system_info(modified_timing_level) of 781 undefined -> ok = ucheck_stability(bigfunlist(10000)); 782 _ -> ok 783 end, 784 ok. 785 786ucheck([]) -> 787 ok; 788ucheck(L) -> 789 S = lists:usort(L), 790 case ucheck(hd(S), tl(S)) of 791 ok -> 792 ok; 793 _ -> 794 io:format("~w~n", [L]), 795 erlang:error(ucheck) 796 end. 797 798ucheck(_A, []) -> 799 ok; 800ucheck(A, [B | L]) when A < B -> 801 ucheck(B, L); 802ucheck(_A, _L) -> 803 no. 804 805%% Check that usort/1 is stable and correct relative ukeysort/2. 806ucheck_stability(L) -> 807 S = no_dups(lsort(L)), 808 U = lists:usort(L), 809 check_stab(L, U, S, "usort/1", "ukeysort/2"). 810 811 812%% Key merge two lists. 813keymerge(Config) when is_list(Config) -> 814 815 Two = [{1,a},{2,b}], 816 Six = [{1,a},{2,b},{3,c},{4,d},{5,e},{6,f}], 817 818 %% 2-way keymerge 819 [] = lists:keymerge(1, [], []), 820 Two = lists:keymerge(1, Two, []), 821 Two = lists:keymerge(1, [], Two), 822 Six = lists:keymerge(1, [{1,a},{3,c},{5,e}], [{2,b},{4,d},{6,f}]), 823 Six = lists:keymerge(1, [{2,b},{4,d},{6,f}], [{1,a},{3,c},{5,e}]), 824 Six = lists:keymerge(1, [{1,a},{2,b},{3,c}], [{4,d},{5,e},{6,f}]), 825 Six = lists:keymerge(1, [{4,d},{5,e},{6,f}], [{1,a},{2,b},{3,c}]), 826 Six = lists:keymerge(1, [{1,a},{2,b},{5,e}],[{3,c},{4,d},{6,f}]), 827 [{1,a},{2,b},{3,c},{5,e},{7,g}] = 828 lists:keymerge(1, [{1,a},{3,c},{5,e},{7,g}], [{2,b}]), 829 [{1,a},{2,b},{3,c},{4,d},{5,e},{7,g}] = 830 lists:keymerge(1, [{1,a},{3,c},{5,e},{7,g}], [{2,b},{4,d}]), 831 [{1,a},{2,b},{3,c},{4,d},{5,e},{6,f},{7,g}] = 832 lists:keymerge(1, [{1,a},{3,c},{5,e},{7,g}], [{2,b},{4,d},{6,f}]), 833 [{1,a},{2,b},{3,c},{5,e},{7,g}] = 834 lists:keymerge(1, [{2,b}], [{1,a},{3,c},{5,e},{7,g}]), 835 [{1,a},{2,b},{3,c},{4,d},{5,e},{7,g}] = 836 lists:keymerge(1, [{2,b},{4,d}], [{1,a},{3,c},{5,e},{7,g}]), 837 [{1,a},{2,b},{3,c},{4,d},{5,e},{6,f},{7,g}] = 838 lists:keymerge(1, [{2,b},{4,d},{6,f}], [{1,a},{3,c},{5,e},{7,g}]), 839 840 [{b,2},{c,11},{c,12},{c,21},{c,22},{e,5}] = 841 lists:keymerge(1,[{c,11},{c,12},{e,5}], [{b,2},{c,21},{c,22}]), 842 843 ok. 844 845%% Reverse key merge two lists. 846rkeymerge(Config) when is_list(Config) -> 847 848 Two = [{2,b},{1,a}], 849 Six = [{6,f},{5,e},{4,d},{3,c},{2,b},{1,a}], 850 851 %% 2-way reversed keymerge 852 [] = lists:rkeymerge(1, [], []), 853 Two = lists:rkeymerge(1, Two, []), 854 Two = lists:rkeymerge(1, [], Two), 855 Six = lists:rkeymerge(1, [{5,e},{3,c},{1,a}], [{6,f},{4,d},{2,b}]), 856 Six = lists:rkeymerge(1, [{6,f},{4,d},{2,b}], [{5,e},{3,c},{1,a}]), 857 Six = lists:rkeymerge(1, [{3,c},{2,b},{1,a}], [{6,f},{5,e},{4,d}]), 858 Six = lists:rkeymerge(1, [{6,f},{5,e},{4,d}], [{3,c},{2,b},{1,a}]), 859 Six = lists:rkeymerge(1, [{4,d},{3,c},{2,b}],[{6,f},{5,e},{1,a}]), 860 [{7,g},{6,f},{5,e},{3,c},{1,a}] = 861 lists:rkeymerge(1, [{7,g},{5,e},{3,c},{1,a}], [{6,f}]), 862 [{7,g},{6,f},{5,e},{4,d},{3,c},{1,a}] = 863 lists:rkeymerge(1, [{7,g},{5,e},{3,c},{1,a}], [{6,f},{4,d}]), 864 [{7,g},{6,f},{5,e},{4,d},{3,c},{2,b},{1,a}] = 865 lists:rkeymerge(1, [{7,g},{5,e},{3,c},{1,a}], [{6,f},{4,d},{2,b}]), 866 [{7,g},{5,e},{3,c},{2,b},{1,a}] = 867 lists:rkeymerge(1, [{2,b}], [{7,g},{5,e},{3,c},{1,a}]), 868 [{7,g},{5,e},{4,d},{3,c},{2,b},{1,a}] = 869 lists:rkeymerge(1, [{4,d},{2,b}], [{7,g},{5,e},{3,c},{1,a}]), 870 [{7,g},{6,f},{5,e},{4,d},{3,c},{2,b},{1,a}] = 871 lists:rkeymerge(1, [{6,f},{4,d},{2,b}], [{7,g},{5,e},{3,c},{1,a}]), 872 873 L1 = [{c,11},{c,12},{e,5}], 874 L2 = [{b,2},{c,21},{c,22}], 875 true = 876 lists:keymerge(1, L1, L2) == 877 lists:reverse(lists:rkeymerge(1,lists:reverse(L1), 878 lists:reverse(L2))), 879 880 ok. 881 882keysort_1(Config) when is_list(Config) -> 883 ok = keysort_check(1, [], []), 884 ok = keysort_check(1, [{a,b}], [{a,b}]), 885 ok = keysort_check(1, [{a,b},{a,b}], [{a,b},{a,b}]), 886 ok = keysort_check(1, [{a,b},{b,c}], [{a,b},{b,c}]), 887 ok = keysort_check(1, [{b,c},{a,b}], [{a,b},{b,c}]), 888 ok = keysort_check(1, 889 [{1,e},{3,f},{2,y},{0,z},{x,14}], 890 [{0,z},{1,e},{2,y},{3,f},{x,14}]), 891 ok = keysort_check(1, 892 [{1,a},{1,a},{1,a},{1,a}], 893 [{1,a},{1,a},{1,a},{1,a}]), 894 895 [{b,1},{c,1}] = lists:keysort(1, [{c,1},{b,1}]), 896 [{a,0},{b,2},{c,3},{d,4}] = 897 lists:keysort(1, [{d,4},{c,3},{b,2},{a,0}]), 898 [{a,0},{b,1},{b,2},{c,1}] = 899 lists:keysort(1, [{c,1},{b,1},{b,2},{a,0}]), 900 [{a,0},{b,1},{b,2},{c,1},{d,4}] = 901 lists:keysort(1, [{c,1},{b,1},{b,2},{a,0},{d,4}]), 902 903 SFun = fun(L) -> fun(X) -> keysort_check(1, X, L) end end, 904 L1 = [{1,a},{2,b},{3,c}], 905 lists:foreach(SFun(L1), perms(L1)), 906 L2 = [{1,a},{1,a},{2,b}], 907 lists:foreach(SFun(L2), perms(L2)), 908 L3 = [{1,a},{1,a},{1,a},{2,b}], 909 lists:foreach(SFun(L3), perms(L3)), 910 L4 = [{a,1},{a,1},{b,2},{b,2},{c,3},{d,4},{e,5},{f,6}], 911 lists:foreach(SFun(L4), perms(L4)), 912 913 ok. 914 915%% keysort should be stable 916keysort_stable(Config) when is_list(Config) -> 917 ok = keysort_check(1, [{1,b},{1,c}], [{1,b},{1,c}]), 918 ok = keysort_check(1, [{1,c},{1,b}], [{1,c},{1,b}]), 919 ok = keysort_check(1, 920 [{1,c},{1,b},{2,x},{3,p},{2,a}], 921 [{1,c},{1,b},{2,x},{2,a},{3,p}]), 922 ok = keysort_check(1, 923 [{1,a},{1,b},{1,a},{1,a}], 924 [{1,a},{1,b},{1,a},{1,a}]), 925 ok. 926 927%% keysort should exit when given bad arguments 928keysort_error(Config) when is_list(Config) -> 929 {'EXIT', _} = (catch lists:keysort(0, [{1,b},{1,c}])), 930 {'EXIT', _} = (catch lists:keysort(3, [{1,b},{1,c}])), 931 {'EXIT', _} = (catch lists:keysort(1.5, [{1,b},{1,c}])), 932 {'EXIT', _} = (catch lists:keysort(x, [{1,b},{1,c}])), 933 {'EXIT', _} = (catch lists:keysort(x, [])), 934 {'EXIT', _} = (catch lists:keysort(x, [{1,b}])), 935 {'EXIT', _} = (catch lists:keysort(1, [a,b])), 936 {'EXIT', _} = (catch lists:keysort(1, [{1,b} | {1,c}])), 937 ok. 938 939%% keysort with other key than first element 940keysort_i(Config) when is_list(Config) -> 941 ok = keysort_check(2, [{a,2},{b,1},{c,3}], [{b,1},{a,2},{c,3}]), 942 ok. 943 944%% keysort on big randomized lists 945keysort_rand(Config) when is_list(Config) -> 946 ok = keysort_check3(1, biglist(10)), 947 ok = keysort_check3(1, biglist(100)), 948 ok = keysort_check3(1, biglist(1000)), 949 ok = keysort_check3(1, biglist(10000)), 950 951 ok = keysort_check3(2, biglist(10)), 952 ok = keysort_check3(2, biglist(100)), 953 ok = keysort_check3(2, biglist(1000)), 954 ok = keysort_check3(2, biglist(10000)), 955 ok. 956 957%%% Keysort a list, check that the returned list is what we expected, 958%%% and that it is actually sorted. 959keysort_check(I, Input, Expected) -> 960 Expected = lists:keysort(I, Input), 961 check_sorted(I, Input, Expected). 962 963keysort_check3(I, Input) -> 964 check_sorted(I, 3, Input, lists:keysort(I, Input)). 965 966check_sorted(I, Input, L) -> 967 check_sorted(I, I, Input, L). 968 969%%% Check that a list is keysorted by element I. Elements comparing equal 970%%% should be sorted according to element J. 971check_sorted(_I, _J, _Input, []) -> 972 ok; 973check_sorted(I, J, Input, [A | Rest]) -> 974 case catch check_sorted1(I, J, A, Rest) of 975 {'EXIT', _} -> 976 io:format("~w~n", [Input]), 977 erlang:error(check_sorted); 978 Reply -> 979 Reply 980 end. 981 982check_sorted1(_I, _J, _A, []) -> 983 ok; 984check_sorted1(I, J, A, [B | Rest]) -> 985 ok = keycompare(I, J, A, B), 986 check_sorted1(I, J, B, Rest). 987 988keycompare(I, _J, A, B) when element(I, A) < element(I, B) -> 989 ok; 990keycompare(I, J, A, B) when element(I, A) == element(I, B), 991 element(J, A) =< element(J, B) -> 992 ok. 993 994 995%% Merge two lists while removing duplicates. 996ukeymerge(Conf) when is_list(Conf) -> 997 998 Two = [{1,a},{2,b}], 999 Six = [{1,a},{2,b},{3,c},{4,d},{5,e},{6,f}], 1000 1001 %% 2-way unique keymerge 1002 [] = lists:ukeymerge(1, [], []), 1003 Two = lists:ukeymerge(1, Two, []), 1004 Two = lists:ukeymerge(1, [], Two), 1005 [] = lists:ukeymerge(1, [], []), 1006 Two = lists:ukeymerge(1, Two, []), 1007 Two = lists:ukeymerge(1, [], Two), 1008 Six = lists:ukeymerge(1, [{1,a},{3,c},{5,e}], [{2,b},{4,d},{6,f}]), 1009 Six = lists:ukeymerge(1, [{2,b},{4,d},{6,f}], [{1,a},{3,c},{5,e}]), 1010 Six = lists:ukeymerge(1, [{1,a},{2,b},{3,c}], [{4,d},{5,e},{6,f}]), 1011 Six = lists:ukeymerge(1, [{4,d},{5,e},{6,f}], [{1,a},{2,b},{3,c}]), 1012 Six = lists:ukeymerge(1, [{1,a},{2,b},{5,e}],[{3,c},{4,d},{6,f}]), 1013 [{1,a},{2,b},{3,c},{5,e},{7,g}] = 1014 lists:ukeymerge(1, [{1,a},{3,c},{5,e},{7,g}], [{2,b}]), 1015 [{1,a},{2,b},{3,c},{4,d},{5,e},{7,g}] = 1016 lists:ukeymerge(1, [{1,a},{3,c},{5,e},{7,g}], [{2,b},{4,d}]), 1017 [{1,a},{2,b},{3,c},{4,d},{5,e},{6,f},{7,g}] = 1018 lists:ukeymerge(1, [{1,a},{3,c},{5,e},{7,g}], [{2,b},{4,d},{6,f}]), 1019 [{1,a},{2,b},{3,c},{5,e},{7,g}] = 1020 lists:ukeymerge(1, [{2,b}], [{1,a},{3,c},{5,e},{7,g}]), 1021 [{1,a},{2,b},{3,c},{4,d},{5,e},{7,g}] = 1022 lists:ukeymerge(1, [{2,b},{4,d}], [{1,a},{3,c},{5,e},{7,g}]), 1023 [{1,a},{2,b},{3,c},{4,d},{5,e},{6,f},{7,g}] = 1024 lists:ukeymerge(1, [{2,b},{4,d},{6,f}], [{1,a},{3,c},{5,e},{7,g}]), 1025 1026 [{1,a},{2,b},{3,c},{5,e},{7,g}] = 1027 lists:ukeymerge(1, [{1,a},{2,b},{3,c},{5,e},{7,g}], [{2,b}]), 1028 [{1,a},{2,b},{3,c},{4,d},{5,e},{7,g}] = 1029 lists:ukeymerge(1, [{1,a},{2,b},{3,c},{4,d},{5,e},{7,g}], 1030 [{2,b},{4,d}]), 1031 [{1,a},{2,b},{3,c},{4,d},{5,e},{6,f},{7,g}] = 1032 lists:ukeymerge(1, [{1,a},{3,c},{5,e},{6,f},{7,g}], 1033 [{2,b},{4,d},{6,f}]), 1034 [{1,a},{2,b},{3,c},{5,e},{7,g}] = 1035 lists:ukeymerge(1, [{2,b}], [{1,a},{2,b},{3,c},{5,e},{7,g}]), 1036 [{1,a},{2,b},{3,c},{4,d},{5,e},{7,g}] = 1037 lists:ukeymerge(1, [{2,b},{4,d}], 1038 [{1,a},{2,b},{3,c},{4,d},{5,e},{7,g}]), 1039 [{1,a},{2,b},{3,c},{4,d},{5,e},{6,f},{7,g}] = 1040 lists:ukeymerge(1, [{2,b},{4,d},{6,f}], 1041 [{1,a},{2,b},{3,c},{4,d},{5,e},{6,f},{7,g}]), 1042 1043 L1 = [{a,1},{a,3},{a,5},{a,7}], 1044 L2 = [{b,1},{b,3},{b,5},{b,7}], 1045 L1 = lists:ukeymerge(2, L1, L2), 1046 1047 ok. 1048 1049%% Reverse merge two lists while removing duplicates. 1050rukeymerge(Conf) when is_list(Conf) -> 1051 1052 Two = [{2,b},{1,a}], 1053 Six = [{6,f},{5,e},{4,d},{3,c},{2,b},{1,a}], 1054 1055 %% 2-way reversed unique keymerge 1056 [] = lists:rukeymerge(1, [], []), 1057 Two = lists:rukeymerge(1, Two, []), 1058 Two = lists:rukeymerge(1, [], Two), 1059 Six = lists:rukeymerge(1, [{5,e},{3,c},{1,a}], [{6,f},{4,d},{2,b}]), 1060 Six = lists:rukeymerge(1, [{6,f},{4,d},{2,b}], [{5,e},{3,c},{1,a}]), 1061 Six = lists:rukeymerge(1, [{3,c},{2,b},{1,a}], [{6,f},{5,e},{4,d}]), 1062 Six = lists:rukeymerge(1, [{6,f},{5,e},{4,d}], [{3,c},{2,b},{1,a}]), 1063 Six = lists:rukeymerge(1, [{4,d},{3,c},{2,b}],[{6,f},{5,e},{1,a}]), 1064 [{7,g},{6,f},{5,e},{3,c},{1,a}] = 1065 lists:rukeymerge(1, [{7,g},{5,e},{3,c},{1,a}], [{6,f}]), 1066 [{7,g},{6,f},{5,e},{4,d},{3,c},{1,a}] = 1067 lists:rukeymerge(1, [{7,g},{5,e},{3,c},{1,a}], [{6,f},{4,d}]), 1068 [{7,g},{6,f},{5,e},{4,d},{3,c},{2,b},{1,a}] = 1069 lists:rukeymerge(1, [{7,g},{5,e},{3,c},{1,a}], [{6,f},{4,d},{2,b}]), 1070 [{7,g},{5,e},{3,c},{2,b},{1,a}] = 1071 lists:rukeymerge(1, [{2,b}], [{7,g},{5,e},{3,c},{1,a}]), 1072 [{7,g},{5,e},{4,d},{3,c},{2,b},{1,a}] = 1073 lists:rukeymerge(1, [{4,d},{2,b}], [{7,g},{5,e},{3,c},{1,a}]), 1074 [{7,g},{6,f},{5,e},{4,d},{3,c},{2,b},{1,a}] = 1075 lists:rukeymerge(1, [{6,f},{4,d},{2,b}], [{7,g},{5,e},{3,c},{1,a}]), 1076 1077 [{7,g},{6,f},{5,e},{3,c},{1,a}] = 1078 lists:rukeymerge(1, [{7,g},{6,f},{5,e},{3,c},{1,a}], [{6,f}]), 1079 [{7,g},{6,f},{5,e},{4,d},{3,c},{1,a}] = 1080 lists:rukeymerge(1, [{7,g},{6,f},{5,e},{4,d},{3,c},{1,a}], 1081 [{6,f},{4,d}]), 1082 [{7,g},{6,f},{5,e},{4,d},{3,c},{2,b},{1,a}] = 1083 lists:rukeymerge(1, [{7,g},{6,f},{5,e},{4,d},{3,c},{2,b},{1,a}], 1084 [{6,f},{4,d},{2,b}]), 1085 [{7,g},{5,e},{3,c},{2,b},{1,a}] = 1086 lists:rukeymerge(1, [{2,b}], [{7,g},{5,e},{3,c},{2,b},{1,a}]), 1087 [{7,g},{5,e},{4,d},{3,c},{2,b},{1,a}] = 1088 lists:rukeymerge(1, [{4,d},{2,b}], 1089 [{7,g},{5,e},{4,d},{3,c},{2,b},{1,a}]), 1090 [{7,g},{6,f},{5,e},{4,d},{3,c},{2,b},{1,a}] = 1091 lists:rukeymerge(1, [{6,f},{4,d},{2,b}], 1092 [{7,g},{6,f},{5,e},{4,d},{3,c},{2,b},{1,a}]), 1093 1094 L1 = [{a,1},{a,3},{a,5},{a,7}], 1095 L2 = [{b,1},{b,3},{b,5},{b,7}], 1096 true = 1097 lists:ukeymerge(2, L1, L2) == 1098 lists:reverse(lists:rukeymerge(2, lists:reverse(L1), 1099 lists:reverse(L2))), 1100 1101 ok. 1102 1103ukeysort_1(Config) when is_list(Config) -> 1104 ok = ukeysort_check(1, [], []), 1105 ok = ukeysort_check(1, [{a,b}], [{a,b}]), 1106 ok = ukeysort_check(1, [{a,b},{a,b}], [{a,b}]), 1107 ok = ukeysort_check(1, [{a,b},{b,c}], [{a,b},{b,c}]), 1108 ok = ukeysort_check(1, [{b,c},{a,b}], [{a,b},{b,c}]), 1109 ok = ukeysort_check(1, 1110 [{1,e},{3,f},{2,y},{0,z},{x,14}], 1111 [{0,z},{1,e},{2,y},{3,f},{x,14}]), 1112 ok = ukeysort_check(1, [{1,a},{1,a},{1,a},{1,a}], [{1,a}]), 1113 1114 L1 = [{1,a},{1,b},{1,a}], 1115 L1u = lists:ukeysort(1, L1), 1116 L2 = [{1,a},{1,b},{1,a}], 1117 L2u = lists:ukeysort(1, L2), 1118 ok = ukeysort_check(1, lists:keymerge(1, L1, L2), 1119 lists:ukeymerge(1, L1u, L2u)), 1120 L3 = [{1,a},{1,b},{1,a},{2,a}], 1121 L3u = lists:ukeysort(1, L3), 1122 ok = ukeysort_check(1, lists:keymerge(1, L3, L2), 1123 lists:ukeymerge(1, L3u, L2u)), 1124 L4 = [{1,b},{1,a}], 1125 L4u = lists:ukeysort(1, L4), 1126 ok = ukeysort_check(1, lists:keymerge(1, L1, L4), 1127 lists:ukeymerge(1, L1u, L4u)), 1128 L5 = [{1,a},{1,b},{1,a},{2,a}], 1129 L5u = lists:ukeysort(1, L5), 1130 ok = ukeysort_check(1, lists:keymerge(1, [], L5), 1131 lists:ukeymerge(1, [], L5u)), 1132 ok = ukeysort_check(1, lists:keymerge(1, L5, []), 1133 lists:ukeymerge(1, L5u, [])), 1134 L6 = [{3,a}], 1135 L6u = lists:ukeysort(1, L6), 1136 ok = ukeysort_check(1, lists:keymerge(1, L5, L6), 1137 lists:ukeymerge(1, L5u, L6u)), 1138 1139 [{b,1},{c,1}] = lists:ukeysort(1, [{c,1},{c,1},{c,1},{c,1},{b,1}]), 1140 [{a,0},{b,2},{c,3},{d,4}] = 1141 lists:ukeysort(1, [{d,4},{c,3},{b,2},{b,2},{a,0}]), 1142 [{a,0},{b,1},{c,1}] = 1143 lists:ukeysort(1, [{c,1},{b,1},{b,1},{b,2},{b,2},{a,0}]), 1144 [{a,0},{b,1},{c,1},{d,4}] = 1145 lists:ukeysort(1, [{c,1},{b,1},{b,2},{a,0},{a,0},{d,4},{d,4}]), 1146 1147 SFun = fun(L) -> fun(X) -> ukeysort_check(2, X, L) end end, 1148 PL = [{a,1},{b,2},{c,3},{d,4},{e,5},{f,6}], 1149 Ps = perms([{a,1},{b,2},{c,3},{d,4},{e,5},{f,6},{b,2},{a,1}]), 1150 lists:foreach(SFun(PL), Ps), 1151 1152 M1L = [{1,a},{1,a},{2,b}], 1153 M1s = [{1,a},{2,b}], 1154 lists:foreach(SFun(M1s), perms(M1L)), 1155 M2L = [{1,a},{2,b},{2,b}], 1156 M2s = [{1,a},{2,b}], 1157 lists:foreach(SFun(M2s), perms(M2L)), 1158 M3 = [{1,a},{2,b},{3,c}], 1159 lists:foreach(SFun(M3), perms(M3)), 1160 1161 ok. 1162 1163%% ukeysort should keep the first duplicate. 1164ukeysort_stable(Config) when is_list(Config) -> 1165 ok = ukeysort_check(1, [{1,b},{1,c}], [{1,b}]), 1166 ok = ukeysort_check(1, [{1,c},{1,b}], [{1,c}]), 1167 ok = ukeysort_check(1, 1168 [{1,c},{1,b},{2,x},{3,p},{2,a}], 1169 [{1,c},{2,x},{3,p}]), 1170 1171 ok = ukeysort_check(1, [{1,a},{1,b},{1,b}], [{1,a}]), 1172 ok = ukeysort_check(1, [{2,a},{1,b},{2,a}], [{1,b},{2,a}]), 1173 1174 ok = ukeysort_check_stability(bigfunlist(3)), 1175 ok = ukeysort_check_stability(bigfunlist(10)), 1176 ok = ukeysort_check_stability(bigfunlist(100)), 1177 ok = ukeysort_check_stability(bigfunlist(1000)), 1178 case erlang:system_info(modified_timing_level) of 1179 undefined -> ok = ukeysort_check_stability(bigfunlist(10000)); 1180 _ -> ok 1181 end, 1182 ok. 1183 1184%% ukeysort should exit when given bad arguments. 1185ukeysort_error(Config) when is_list(Config) -> 1186 {'EXIT', _} = (catch lists:ukeysort(0, [{1,b},{1,c}])), 1187 {'EXIT', _} = (catch lists:ukeysort(3, [{1,b},{1,c}])), 1188 {'EXIT', _} = (catch lists:ukeysort(1.5, [{1,b},{1,c}])), 1189 {'EXIT', _} = (catch lists:ukeysort(x, [{1,b},{1,c}])), 1190 {'EXIT', _} = (catch lists:ukeysort(x, [])), 1191 {'EXIT', _} = (catch lists:ukeysort(x, [{1,b}])), 1192 {'EXIT', _} = (catch lists:ukeysort(1, [a,b])), 1193 {'EXIT', _} = (catch lists:ukeysort(1, [{1,b} | {1,c}])), 1194 ok. 1195 1196%% ukeysort with other key than first element. 1197ukeysort_i(Config) when is_list(Config) -> 1198 ok = ukeysort_check(2, [{a,2},{b,1},{c,3}], [{b,1},{a,2},{c,3}]), 1199 ok. 1200 1201%% ukeysort on big randomized lists. 1202ukeysort_rand(Config) when is_list(Config) -> 1203 ok = ukeysort_check3(2, biglist(10)), 1204 ok = ukeysort_check3(2, biglist(100)), 1205 ok = ukeysort_check3(2, biglist(1000)), 1206 ok = ukeysort_check3(2, biglist(10000)), 1207 1208 ok = gen_ukeysort_check(1, ubiglist(10)), 1209 ok = gen_ukeysort_check(1, ubiglist(100)), 1210 ok = gen_ukeysort_check(1, ubiglist(1000)), 1211 ok = gen_ukeysort_check(1, ubiglist(10000)), 1212 ok. 1213 1214%% Check that ukeysort/2 is stable and correct relative keysort/2. 1215%% (this is not affected by the fact that keysort/2 is no longer really 1216%% stable; ucheck_stability/1 checks ukeysort/2 (and usort/1, of course)) 1217gen_ukeysort_check(I, Input) -> 1218 U = lists:ukeysort(I, Input), 1219 S = lists:keysort(I, Input), 1220 case U == no_dups_keys(S, I) of 1221 true -> 1222 ok; 1223 false -> 1224 io:format("~w~n", [Input]), 1225 erlang:error(gen_ukeysort_check) 1226 end. 1227 1228%% Used for checking that the first copy is kept. 1229ukeysort_check_stability(L) -> 1230 I = 1, 1231 U = lists:ukeysort(I, L), 1232 S = no_dups_keys(lkeysort(I, L), I), 1233 check_stab(L, U, S, "ukeysort/2", "usort/2"). 1234 1235%%% Uniquely keysort a list, check that the returned list is what we 1236%%% expected, and that it is actually sorted. 1237ukeysort_check(I, Input, Expected) -> 1238 Expected = lists:ukeysort(I, Input), 1239 ucheck_sorted(I, Input, Expected). 1240 1241ukeysort_check3(I, Input) -> 1242 ucheck_sorted(I, 3, Input, lists:ukeysort(I, Input)). 1243 1244ucheck_sorted(I, Input, L) -> 1245 ucheck_sorted(I, I, Input, L). 1246 1247%%% Check that a list is ukeysorted by element I. Elements comparing 1248%%% equal should be sorted according to element J. 1249ucheck_sorted(_I, _J, _Input, []) -> 1250 ok; 1251ucheck_sorted(I, J, Input, [A | Rest]) -> 1252 case catch ucheck_sorted1(I, J, A, Rest) of 1253 {'EXIT', _} -> 1254 io:format("~w~n", [Input]), 1255 erlang:error(ucheck_sorted); 1256 Reply -> 1257 Reply 1258 end. 1259 1260ucheck_sorted1(_I, _J, _A, []) -> 1261 ok; 1262ucheck_sorted1(I, J, A, [B | Rest]) -> 1263 ok = ukeycompare(I, J, A, B), 1264 ucheck_sorted1(I, J, B, Rest). 1265 1266ukeycompare(I, _J, A, B) when element(I, A) < element(I, B) -> 1267 ok; 1268ukeycompare(I, J, A, B) when A =/= B, 1269 element(I, A) == element(I, B), 1270 element(J, A) =< element(J, B) -> 1271 ok. 1272 1273 1274 1275%% Merge two lists using a fun. 1276funmerge(Config) when is_list(Config) -> 1277 1278 Two = [1,2], 1279 Six = [1,2,3,4,5,6], 1280 F = fun(X, Y) -> X =< Y end, 1281 1282 %% 2-way merge 1283 [] = lists:merge(F, [], []), 1284 Two = lists:merge(F, Two, []), 1285 Two = lists:merge(F, [], Two), 1286 Six = lists:merge(F, [1,3,5], [2,4,6]), 1287 Six = lists:merge(F, [2,4,6], [1,3,5]), 1288 Six = lists:merge(F, [1,2,3], [4,5,6]), 1289 Six = lists:merge(F, [4,5,6], [1,2,3]), 1290 Six = lists:merge(F, [1,2,5],[3,4,6]), 1291 [1,2,3,5,7] = lists:merge(F, [1,3,5,7], [2]), 1292 [1,2,3,4,5,7] = lists:merge(F, [1,3,5,7], [2,4]), 1293 [1,2,3,4,5,6,7] = lists:merge(F, [1,3,5,7], [2,4,6]), 1294 [1,2,3,5,7] = lists:merge(F, [2], [1,3,5,7]), 1295 [1,2,3,4,5,7] = lists:merge(F, [2,4], [1,3,5,7]), 1296 [1,2,3,4,5,6,7] = lists:merge(F, [2,4,6], [1,3,5,7]), 1297 1298 F2 = fun(X,Y) -> element(1,X) =< element(1,Y) end, 1299 [{b,2},{c,11},{c,12},{c,21},{c,22},{e,5}] = 1300 lists:merge(F2,[{c,11},{c,12},{e,5}], [{b,2},{c,21},{c,22}]), 1301 1302 ok. 1303 1304%% Reverse merge two lists using a fun. 1305rfunmerge(Config) when is_list(Config) -> 1306 1307 Two = [2,1], 1308 Six = [6,5,4,3,2,1], 1309 F = fun(X, Y) -> X =< Y end, 1310 1311 %% 2-way reversed merge 1312 [] = lists:rmerge(F, [], []), 1313 Two = lists:rmerge(F, Two, []), 1314 Two = lists:rmerge(F, [], Two), 1315 Six = lists:rmerge(F, [5,3,1], [6,4,2]), 1316 Six = lists:rmerge(F, [6,4,2], [5,3,1]), 1317 Six = lists:rmerge(F, [3,2,1], [6,5,4]), 1318 Six = lists:rmerge(F, [6,5,4], [3,2,1]), 1319 Six = lists:rmerge(F, [4,3,2],[6,5,1]), 1320 [7,6,5,3,1] = lists:rmerge(F, [7,5,3,1], [6]), 1321 [7,6,5,4,3,1] = lists:rmerge(F, [7,5,3,1], [6,4]), 1322 [7,6,5,4,3,2,1] = lists:rmerge(F, [7,5,3,1], [6,4,2]), 1323 [7,5,3,2,1] = lists:rmerge(F, [2], [7,5,3,1]), 1324 [7,5,4,3,2,1] = lists:rmerge(F, [4,2], [7,5,3,1]), 1325 [7,6,5,4,3,2,1] = lists:rmerge(F, [6,4,2], [7,5,3,1]), 1326 1327 F2 = fun(X,Y) -> element(1,X) =< element(1,Y) end, 1328 L1 = [{c,11},{c,12},{e,5}], 1329 L2 = [{b,2},{c,21},{c,22}], 1330 true = 1331 lists:merge(F2, L1, L2) == 1332 lists:reverse(lists:rmerge(F2,lists:reverse(L1), lists:reverse(L2))), 1333 1334 ok. 1335 1336 1337funsort_1(Config) when is_list(Config) -> 1338 ok = funsort_check(1, [], []), 1339 ok = funsort_check(1, [{a,b}], [{a,b}]), 1340 ok = funsort_check(1, [{a,b},{a,b}], [{a,b},{a,b}]), 1341 ok = funsort_check(1, [{a,b},{b,c}], [{a,b},{b,c}]), 1342 ok = funsort_check(1, [{b,c},{a,b}], [{a,b},{b,c}]), 1343 ok = funsort_check(1, 1344 [{1,e},{3,f},{2,y},{0,z},{x,14}], 1345 [{0,z},{1,e},{2,y},{3,f},{x,14}]), 1346 F = funsort_fun(1), 1347 1348 [{b,1},{c,1}] = lists:sort(F, [{c,1},{b,1}]), 1349 [{a,0},{b,2},{c,3},{d,4}] = 1350 lists:sort(F, [{d,4},{c,3},{b,2},{a,0}]), 1351 [{a,0},{b,1},{b,2},{c,1}] = 1352 lists:sort(F, [{c,1},{b,1},{b,2},{a,0}]), 1353 [{a,0},{b,1},{b,2},{c,1},{d,4}] = 1354 lists:sort(F, [{c,1},{b,1},{b,2},{a,0},{d,4}]), 1355 1356 SFun = fun(L) -> fun(X) -> funsort_check(1, X, L) end end, 1357 L1 = [{1,a},{1,a},{2,b},{2,b},{3,c},{4,d},{5,e},{6,f}], 1358 lists:foreach(SFun(L1), perms(L1)), 1359 1360 ok. 1361 1362%% sort/2 should be stable. 1363funsort_stable(Config) when is_list(Config) -> 1364 ok = funsort_check(1, [{1,b},{1,c}], [{1,b},{1,c}]), 1365 ok = funsort_check(1, [{1,c},{1,b}], [{1,c},{1,b}]), 1366 ok = funsort_check(1, 1367 [{1,c},{1,b},{2,x},{3,p},{2,a}], 1368 [{1,c},{1,b},{2,x},{2,a},{3,p}]), 1369 ok. 1370 1371%% sort/2 should exit when given bad arguments. 1372funsort_error(Config) when is_list(Config) -> 1373 {'EXIT', _} = (catch lists:sort(1, [{1,b} , {1,c}])), 1374 {'EXIT', _} = (catch lists:sort(fun(X,Y) -> X =< Y end, 1375 [{1,b} | {1,c}])), 1376 ok. 1377 1378%% sort/2 on big randomized lists. 1379funsort_rand(Config) when is_list(Config) -> 1380 ok = funsort_check3(1, biglist(10)), 1381 ok = funsort_check3(1, biglist(100)), 1382 ok = funsort_check3(1, biglist(1000)), 1383 ok = funsort_check3(1, biglist(10000)), 1384 ok. 1385 1386%% Do a keysort 1387funsort(I, L) -> 1388 lists:sort(funsort_fun(I), L). 1389 1390funsort_check3(I, Input) -> 1391 check_sorted(I, 3, Input, funsort(I, Input)). 1392 1393%%% Keysort a list, check that the returned list is what we expected, 1394%%% and that it is actually sorted. 1395funsort_check(I, Input, Expected) -> 1396 Expected = funsort(I, Input), 1397 check_sorted(I, Input, Expected). 1398 1399 1400%% Merge two lists while removing duplicates using a fun. 1401ufunmerge(Conf) when is_list(Conf) -> 1402 1403 Two = [1,2], 1404 Six = [1,2,3,4,5,6], 1405 F = fun(X, Y) -> X =< Y end, 1406 1407 %% 2-way unique merge 1408 [] = lists:umerge(F, [], []), 1409 Two = lists:umerge(F, Two, []), 1410 Two = lists:umerge(F, [], Two), 1411 Six = lists:umerge(F, [1,3,5], [2,4,6]), 1412 Six = lists:umerge(F, [2,4,6], [1,3,5]), 1413 Six = lists:umerge(F, [1,2,3], [4,5,6]), 1414 Six = lists:umerge(F, [4,5,6], [1,2,3]), 1415 Six = lists:umerge(F, [1,2,5],[3,4,6]), 1416 [1,2,3,5,7] = lists:umerge(F, [1,3,5,7], [2]), 1417 [1,2,3,4,5,7] = lists:umerge(F, [1,3,5,7], [2,4]), 1418 [1,2,3,4,5,6,7] = lists:umerge(F, [1,3,5,7], [2,4,6]), 1419 [1,2,3,5,7] = lists:umerge(F, [2], [1,3,5,7]), 1420 [1,2,3,4,5,7] = lists:umerge(F, [2,4], [1,3,5,7]), 1421 [1,2,3,4,5,6,7] = lists:umerge(F, [2,4,6], [1,3,5,7]), 1422 1423 [1,2,3,5,7] = lists:umerge(F, [1,2,3,5,7], [2]), 1424 [1,2,3,4,5,7] = lists:umerge(F, [1,2,3,4,5,7], [2,4]), 1425 [1,2,3,4,5,6,7] = lists:umerge(F, [1,3,5,6,7], [2,4,6]), 1426 [1,2,3,5,7] = lists:umerge(F, [2], [1,2,3,5,7]), 1427 [1,2,3,4,5,7] = lists:umerge(F, [2,4], [1,2,3,4,5,7]), 1428 [1,2,3,4,5,6,7] = lists:umerge(F, [2,4,6], [1,2,3,4,5,6,7]), 1429 1430 L1 = [{a,1},{a,3},{a,5},{a,7}], 1431 L2 = [{b,1},{b,3},{b,5},{b,7}], 1432 F2 = fun(X,Y) -> element(2,X) =< element(2,Y) end, 1433 L1 = lists:umerge(F2, L1, L2), 1434 [{b,2},{e,5},{c,11},{c,12},{c,21},{c,22}] = 1435 lists:umerge(F2, [{e,5},{c,11},{c,12}], [{b,2},{c,21},{c,22}]), 1436 1437 ok. 1438 1439%% Reverse merge two lists while removing duplicates using a fun. 1440rufunmerge(Conf) when is_list(Conf) -> 1441 Two = [2,1], 1442 Six = [6,5,4,3,2,1], 1443 F = fun(X, Y) -> X =< Y end, 1444 1445 %% 2-way reversed unique merge 1446 [] = lists:rumerge(F, [], []), 1447 Two = lists:rumerge(F, Two, []), 1448 Two = lists:rumerge(F, [], Two), 1449 Six = lists:rumerge(F, [5,3,1], [6,4,2]), 1450 Six = lists:rumerge(F, [6,4,2], [5,3,1]), 1451 Six = lists:rumerge(F, [3,2,1], [6,5,4]), 1452 Six = lists:rumerge(F, [6,5,4], [3,2,1]), 1453 Six = lists:rumerge(F, [4,3,2],[6,5,1]), 1454 [7,6,5,3,1] = lists:rumerge(F, [7,5,3,1], [6]), 1455 [7,6,5,4,3,1] = lists:rumerge(F, [7,5,3,1], [6,4]), 1456 [7,6,5,4,3,2,1] = lists:rumerge(F, [7,5,3,1], [6,4,2]), 1457 [7,5,3,2,1] = lists:rumerge(F, [2], [7,5,3,1]), 1458 [7,5,4,3,2,1] = lists:rumerge(F, [4,2], [7,5,3,1]), 1459 [7,6,5,4,3,2,1] = lists:rumerge(F, [6,4,2], [7,5,3,1]), 1460 1461 [7,6,5,3,1] = lists:rumerge(F, [7,6,5,3,1], [6]), 1462 [7,6,5,4,3,1] = lists:rumerge(F, [7,6,5,4,3,1], [6,4]), 1463 [7,6,5,4,3,2,1] = lists:rumerge(F, [7,6,5,4,3,2,1], [6,4,2]), 1464 [7,5,3,2,1] = lists:rumerge(F, [2], [7,5,3,2,1]), 1465 [7,5,4,3,2,1] = lists:rumerge(F, [4,2], [7,5,4,3,2,1]), 1466 [7,6,5,4,3,2,1] = lists:rumerge(F, [6,4,2], [7,6,5,4,3,2,1]), 1467 1468 F2 = fun(X,Y) -> element(1,X) =< element(1,Y) end, 1469 L1 = [{1,a},{1,b},{1,a}], 1470 L2 = [{1,a},{1,b},{1,a}], 1471 true = lists:umerge(F2, L1, L2) == 1472 lists:reverse(lists:rumerge(F, lists:reverse(L2), lists:reverse(L1))), 1473 1474 L3 = [{c,11},{c,12},{e,5}], 1475 L4 = [{b,2},{c,21},{c,22}], 1476 true = 1477 lists:umerge(F2, L3, L4) == 1478 lists:reverse(lists:rumerge(F2,lists:reverse(L3), lists:reverse(L4))), 1479 1480 ok. 1481 1482ufunsort_1(Config) when is_list(Config) -> 1483 ok = ufunsort_check(1, [], []), 1484 ok = ufunsort_check(1, [{a,b}], [{a,b}]), 1485 ok = ufunsort_check(1, [{a,b},{a,b}], [{a,b}]), 1486 ok = ufunsort_check(1, [{a,b},{b,c}], [{a,b},{b,c}]), 1487 ok = ufunsort_check(1, [{b,c},{a,b}], [{a,b},{b,c}]), 1488 ok = ufunsort_check(1, 1489 [{1,e},{3,f},{2,y},{0,z},{x,14}], 1490 [{0,z},{1,e},{2,y},{3,f},{x,14}]), 1491 ok = ufunsort_check(1, 1492 [{1,a},{2,b},{3,c},{2,b},{1,a},{2,b},{3,c}, 1493 {2,b},{1,a}], 1494 [{1,a},{2,b},{3,c}]), 1495 ok = ufunsort_check(1, 1496 [{1,a},{1,a},{1,b},{1,b},{1,a},{2,a}], 1497 [{1,a},{2,a}]), 1498 1499 F = funsort_fun(1), 1500 L1 = [{1,a},{1,b},{1,a}], 1501 L2 = [{1,a},{1,b},{1,a}], 1502 ok = ufunsort_check(1, lists:keymerge(1, L1, L2), 1503 lists:umerge(F, lists:usort(F, L1), 1504 lists:usort(F, L2))), 1505 L3 = [{1,a},{1,b},{1,a},{2,a}], 1506 ok = ufunsort_check(1, lists:keymerge(1, L3, L2), 1507 lists:umerge(F, lists:usort(F, L3), 1508 lists:usort(F, L2))), 1509 L4 = [{1,b},{1,a}], 1510 ok = ufunsort_check(1, lists:keymerge(1, L1, L4), 1511 lists:umerge(F, lists:usort(F, L1), 1512 lists:usort(F, L4))), 1513 L5 = [{1,a},{1,b},{1,a},{2,a}], 1514 ok = ufunsort_check(1, lists:keymerge(1, L5, []), 1515 lists:umerge(F, lists:usort(F, L5), [])), 1516 L6 = [{3,a}], 1517 ok = ufunsort_check(1, lists:keymerge(1, L5, L6), 1518 lists:umerge(F, lists:usort(F, L5), 1519 lists:usort(F, L6))), 1520 1521 [{b,1},{c,1}] = lists:usort(F, [{c,1},{c,1},{b,1}]), 1522 [{a,0},{b,2},{c,3},{d,4}] = 1523 lists:usort(F, [{d,4},{c,3},{b,2},{b,2},{a,0}]), 1524 [{a,0},{b,1},{c,1}] = 1525 lists:usort(F, [{c,1},{b,1},{b,1},{b,2},{b,2},{a,0}]), 1526 [{a,0},{b,1},{c,1},{d,4}] = 1527 lists:usort(F, [{c,1},{b,1},{b,2},{a,0},{a,0},{d,4},{d,4}]), 1528 1529 SFun = fun(L) -> fun(X) -> ufunsort_check(1, X, L) end end, 1530 PL = [{1,a},{2,b},{3,c},{4,d},{5,e},{6,f}], 1531 Ps = perms([{1,a},{2,b},{3,c},{4,d},{5,e},{6,f},{2,b},{1,a}]), 1532 lists:foreach(SFun(PL), Ps), 1533 1534 ok. 1535 1536%% usort/2 should be stable. 1537ufunsort_stable(Config) when is_list(Config) -> 1538 ok = ufunsort_check(1, [{1,b},{1,c}], [{1,b}]), 1539 ok = ufunsort_check(1, [{1,c},{1,b}], [{1,c}]), 1540 ok = ufunsort_check(1, 1541 [{1,c},{1,b},{2,x},{3,p},{2,a}], 1542 [{1,c},{2,x},{3,p}]), 1543 1544 ok = ufunsort_check_stability(bigfunlist(10)), 1545 ok = ufunsort_check_stability(bigfunlist(100)), 1546 ok = ufunsort_check_stability(bigfunlist(1000)), 1547 case erlang:system_info(modified_timing_level) of 1548 undefined -> ok = ufunsort_check_stability(bigfunlist(10000)); 1549 _ -> ok 1550 end, 1551 ok. 1552 1553%% usort/2 should exit when given bad arguments. 1554ufunsort_error(Config) when is_list(Config) -> 1555 {'EXIT', _} = (catch lists:usort(1, [{1,b} , {1,c}])), 1556 {'EXIT', _} = (catch lists:usort(fun(X,Y) -> X =< Y end, 1557 [{1,b} | {1,c}])), 1558 ok. 1559 1560%% usort/2 on big randomized lists. 1561ufunsort_rand(Config) when is_list(Config) -> 1562 ok = ufunsort_check3(1, biglist(10)), 1563 ok = ufunsort_check3(1, biglist(100)), 1564 ok = ufunsort_check3(1, biglist(1000)), 1565 ok = ufunsort_check3(1, biglist(10000)), 1566 1567 ok = gen_ufunsort_check(1, ubiglist(100)), 1568 ok = gen_ufunsort_check(1, ubiglist(1000)), 1569 ok = gen_ufunsort_check(1, ubiglist(10000)), 1570 ok. 1571 1572%% Check that usort/2 is stable and correct relative sort/2. 1573gen_ufunsort_check(I, Input) -> 1574 U = ufunsort(I, Input), 1575 S = funsort(I, Input), 1576 case U == no_dups_keys(S, I) of 1577 true -> 1578 ok; 1579 false -> 1580 io:format("~w~n", [Input]), 1581 erlang:error(gen_ufunsort_check) 1582 end. 1583 1584%% Used for checking that the first copy is kept. 1585ufunsort_check_stability(L) -> 1586 I = 1, 1587 U = ufunsort(I, L), 1588 S = no_dups(funsort(I, L)), 1589 check_stab(L, U, S, "usort/2", "sort/2"). 1590 1591ufunsort_check3(I, Input) -> 1592 ucheck_sorted(I, 3, Input, ufunsort(I, Input)). 1593 1594%%% Keysort a list, check that the returned list is what we expected, 1595%%% and that it is actually sorted. 1596ufunsort_check(I, Input, Expected) -> 1597 Expected = ufunsort(I, Input), 1598 ucheck_sorted(I, Input, Expected). 1599 1600%% Do a keysort 1601ufunsort(I, L) -> 1602 lists:usort(funsort_fun(I), L). 1603 1604funsort_fun(I) -> 1605 fun(A, B) when tuple_size(A) >= I, tuple_size(B) >= I -> 1606 element(I, A) =< element(I, B) 1607 end. 1608 1609check_stab(L, U, S, US, SS) -> 1610 UP = explicit_pid(U), 1611 SP = explicit_pid(S), 1612 case UP == SP of 1613 true -> 1614 ok; 1615 false -> 1616 io:format("In: ~w~n", [explicit_pid(L)]), 1617 io:format("~s: ~w~n", [US, UP]), 1618 io:format("~s: ~w~n", [SS, SP]), 1619 erlang:error(unstable) 1620 end. 1621 1622%%%------------------------------------------------------------ 1623%%% Generate lists of given length, containing 3-tuples with 1624%%% random integer elements in the range 0..44 as elements 1 and 2. 1625%%% Element 3 in the tuple is the position of the tuple in the list. 1626 1627biglist(N) -> 1628 rand:seed(exsplus), 1629 biglist(N, []). 1630 1631biglist(0, L) -> 1632 L; 1633biglist(N, L) -> 1634 E = random_tuple(45, N), 1635 biglist(N-1, [E|L]). 1636 1637%%%------------------------------------------------------------ 1638%%% Generate lists of given length, containing 2-tuples with 1639%%% random integer elements in the range 0..10 as element 1. 1640%%% Element 2 in the tuple is a random integer in the range 0..5. 1641%%% No sequence number. 1642 1643ubiglist(N) -> 1644 rand:seed(exsplus), 1645 ubiglist(N, []). 1646 1647ubiglist(0, L) -> 1648 L; 1649ubiglist(N, L) -> 1650 E = urandom_tuple(11, 6), 1651 ubiglist(N-1, [E|L]). 1652 1653urandom_tuple(N, I) -> 1654 R1 = randint(N), 1655 R2 = randint(I), 1656 {R1, R2}. 1657 1658%%%------------------------------------------------------------ 1659%%% Generate lists of given length, containing 2-tuples with random 1660%%% integer elements in the range 0..10 as elements 1. All tuples have 1661%%% the same function as element 2, but every function is created in a 1662%%% unique process. ==/2 will return 'true' for any pair of functions, 1663%%% but erlang:fun_info(Fun, pid) can be used for distinguishing 1664%%% functions created in different processes. The pid acts like a 1665%%% sequence number. 1666 1667bigfunlist(N) -> 1668 rand:seed(exsplus), 1669 bigfunlist_1(N). 1670 1671bigfunlist_1(N) when N < 30000 -> % Now (R8) max 32000 different pids. 1672 case catch bigfunlist(N, 0, []) of 1673 {'EXIT', _} -> 1674 bigfunlist_1(N); 1675 Reply -> 1676 Reply 1677 end. 1678 1679bigfunlist(0, _P, L) -> 1680 lists:reverse(L); 1681bigfunlist(N, P, L) -> 1682 {E, NP} = random_funtuple(P, 11), 1683 bigfunlist(N-1, NP, [E | L]). 1684 1685random_funtuple(P, N) -> 1686 R = randint(N), 1687 F = make_fun(), 1688 NP = fun_pid(F), 1689 true = NP > P, 1690 {{R, F}, NP}. 1691 1692make_fun() -> 1693 Pid = spawn(?MODULE, make_fun, [self()]), 1694 receive {Pid, Fun} -> Fun end. 1695 1696make_fun(Pid) -> 1697 Pid ! {self(), fun (X) -> {X, Pid} end}. 1698 1699fun_pid(Fun) -> 1700 erlang:fun_info(Fun, pid). 1701 1702random_tuple(N, Seq) -> 1703 R1 = randint(N), 1704 R2 = randint(N), 1705 {R1, R2, Seq}. 1706 1707randint(N) -> 1708 trunc(rand:uniform() * N). 1709 1710%% The first "duplicate" is kept. 1711no_dups([]) -> 1712 []; 1713no_dups([H | T]) -> 1714 no_dups(H, T, []). 1715 1716no_dups(H, [H1 | T], L) when H == H1 -> 1717 no_dups(H, T, L); 1718no_dups(H, [H1 | T], L) -> 1719 no_dups(H1, T, [H | L]); 1720no_dups(H, [], L) -> 1721 lists:reverse([H | L]). 1722 1723%% The first "duplicate" is kept. 1724no_dups_keys([], _I) -> 1725 []; 1726no_dups_keys([H | T], I) -> 1727 no_dups_keys(H, T, [], I). 1728 1729no_dups_keys(H, [H1 | T], L, I) when element(I, H) == element(I, H1) -> 1730 no_dups_keys(H, T, L, I); 1731no_dups_keys(H, [H1 | T], L, I) -> 1732 no_dups_keys(H1, T, [H | L], I); 1733no_dups_keys(H, [], L, _I) -> 1734 lists:reverse([H | L]). 1735 1736perms([]) -> 1737 [[]]; 1738perms(L) -> 1739 [[H|T] || H <- L, T <- perms(L--[H])]. 1740 1741%%%------------------------------------------------------------ 1742%%% Test the sort routines with randomly generated lists. 1743 1744-record(state, {sort = 0, usort = 0, stable = 0}). 1745 1746%% Run it interactively. 'stop' or 'info' recognized commands. 1747sort_loop() -> 1748 sort_loop(5000). 1749 1750sort_loop(N) when is_integer(N), N > 0 -> 1751 Pid = spawn_link(?MODULE, sloop, [N]), 1752 sort_loop_1(Pid). 1753 1754sort_loop_1(Pid) -> 1755 case io:get_line('? ') of 1756 eof -> 1757 ok; 1758 "stop\n" -> 1759 Pid ! {self(), stop}, 1760 receive {Pid, S} -> display_state(S) end; 1761 "info\n" -> 1762 Pid ! {self(), info}, 1763 receive {Pid, S} -> display_state(S) end, 1764 sort_loop_1(Pid); 1765 _Other -> 1766 sort_loop_1(Pid) 1767 end. 1768 1769sloop(N) -> 1770 rand:seed(exsplus), 1771 sloop(N, #state{}). 1772 1773sloop(N, S) -> 1774 receive 1775 {From, stop} -> 1776 From ! {self(), S}; 1777 {From, info} -> 1778 From ! {self(), S}, 1779 sloop(N, S) 1780 after 0 -> 1781 Len = randint(N), 1782 NS = case randint(3) of 1783 0 -> 1784 BL = biglist(Len, []), 1785 ok = check(BL), 1786 ok = keysort_check3(1, BL), 1787 ok = funsort_check3(1, BL), 1788 S#state{sort = S#state.sort + 1}; 1789 1 -> 1790 BL = ubiglist(Len, []), 1791 ok = ucheck(BL), 1792 ok = gen_ukeysort_check(1, BL), 1793 ok = gen_ufunsort_check(1, BL), 1794 S#state{usort = S#state.usort + 1}; 1795 2 -> 1796 BL = bigfunlist(Len), 1797 %% ok = check_stability(BL), 1798 ok = ucheck_stability(BL), 1799 ok = ukeysort_check_stability(BL), 1800 ok = ufunsort_check_stability(BL), 1801 S#state{stable = S#state.stable + 1} 1802 end, 1803 sloop(N, NS) 1804 end. 1805 1806display_state(S) -> 1807 io:format("sort: ~p~n", [S#state.sort]), 1808 io:format("usort: ~p~n", [S#state.usort]), 1809 io:format("stable: ~p~n", [S#state.stable]). 1810 1811%% This version of sort/1 is really stable; the order of equal 1812%% elements is kept. It is used for checking the current 1813%% implementation of usort/1 etc. 1814 1815lsort([X, Y | L] = L0) when X =< Y -> 1816 case L of 1817 [] -> 1818 L0; 1819 [Z] when Y =< Z -> 1820 L0; 1821 [Z] when X =< Z -> 1822 [X, Z, Y]; 1823 [Z] -> 1824 [Z, X, Y]; 1825 _ -> 1826 split_1(X, Y, L, [], []) 1827 end; 1828lsort([X, Y | L]) -> 1829 case L of 1830 [] -> 1831 [Y, X]; 1832 [Z] when X =< Z -> 1833 [Y, X | L]; 1834 [Z] when Y =< Z -> 1835 [Y, Z, X]; 1836 [Z] -> 1837 [Z, Y, X]; 1838 _ -> 1839 split_2(X, Y, L, [], []) 1840 end; 1841lsort([_] = L) -> 1842 L; 1843lsort([] = L) -> 1844 L. 1845 1846split_1(X, Y, [Z | L], R, Rs) when Z >= Y -> 1847 split_1(Y, Z, L, [X | R], Rs); 1848split_1(X, Y, [Z | L], R, Rs) when Z >= X -> 1849 split_1(Z, Y, L, [X | R], Rs); 1850split_1(X, Y, [Z | L], [], Rs) -> 1851 split_1(X, Y, L, [Z], Rs); 1852split_1(X, Y, [Z | L], R, Rs) -> 1853 split_1_1(X, Y, L, R, Rs, Z); 1854split_1(X, Y, [], R, Rs) -> 1855 rmergel([[Y, X | R] | Rs], [], asc). 1856 1857split_1_1(X, Y, [Z | L], R, Rs, S) when Z >= Y -> 1858 split_1_1(Y, Z, L, [X | R], Rs, S); 1859split_1_1(X, Y, [Z | L], R, Rs, S) when Z >= X -> 1860 split_1_1(Z, Y, L, [X | R], Rs, S); 1861split_1_1(X, Y, [Z | L], R, Rs, S) when S =< Z -> 1862 split_1(S, Z, L, [], [[Y, X | R] | Rs]); 1863split_1_1(X, Y, [Z | L], R, Rs, S) -> 1864 split_1(Z, S, L, [], [[Y, X | R] | Rs]); 1865split_1_1(X, Y, [], R, Rs, S) -> 1866 rmergel([[S], [Y, X | R] | Rs], [], asc). 1867 1868split_2(X, Y, [Z | L], R, Rs) when Z < Y -> 1869 split_2(Y, Z, L, [X | R], Rs); 1870split_2(X, Y, [Z | L], R, Rs) when Z < X -> 1871 split_2(Z, Y, L, [X | R], Rs); 1872split_2(X, Y, [Z | L], [], Rs) -> 1873 split_2(X, Y, L, [Z], Rs); 1874split_2(X, Y, [Z | L], R, Rs) -> 1875 split_2_1(X, Y, L, R, Rs, Z); 1876split_2(X, Y, [], R, Rs) -> 1877 mergel([[Y, X | R] | Rs], [], desc). 1878 1879split_2_1(X, Y, [Z | L], R, Rs, S) when Z < Y -> 1880 split_2_1(Y, Z, L, [X | R], Rs, S); 1881split_2_1(X, Y, [Z | L], R, Rs, S) when Z < X -> 1882 split_2_1(Z, Y, L, [X | R], Rs, S); 1883split_2_1(X, Y, [Z | L], R, Rs, S) when S > Z -> 1884 split_2(S, Z, L, [], [[Y, X | R] | Rs]); 1885split_2_1(X, Y, [Z | L], R, Rs, S) -> 1886 split_2(Z, S, L, [], [[Y, X | R] | Rs]); 1887split_2_1(X, Y, [], R, Rs, S) -> 1888 mergel([[S], [Y, X | R] | Rs], [], desc). 1889 1890mergel([[] | L], Acc, O) -> 1891 mergel(L, Acc, O); 1892mergel([T1, [H2 | T2] | L], Acc, asc) -> 1893 mergel(L, [merge2_1(T1, H2, T2, []) | Acc], asc); 1894mergel([[H2 | T2], T1 | L], Acc, desc) -> 1895 mergel(L, [merge2_1(T1, H2, T2, []) | Acc], desc); 1896mergel([L], [], _O) -> 1897 L; 1898mergel([L], Acc, O) -> 1899 rmergel([lists:reverse(L, []) | Acc], [], O); 1900mergel([], [], _O) -> 1901 []; 1902mergel([], Acc, O) -> 1903 rmergel(Acc, [], O); 1904mergel([A, [] | L], Acc, O) -> 1905 mergel([A | L], Acc, O); 1906mergel([A, B, [] | L], Acc, O) -> 1907 mergel([A, B | L], Acc, O). 1908 1909rmergel([[H2 | T2], T1 | L], Acc, asc) -> 1910 rmergel(L, [rmerge2_1(T1, H2, T2, []) | Acc], asc); 1911rmergel([T1, [H2 | T2] | L], Acc, desc) -> 1912 rmergel(L, [rmerge2_1(T1, H2, T2, []) | Acc], desc); 1913rmergel([L], Acc, O) -> 1914 mergel([lists:reverse(L, []) | Acc], [], O); 1915rmergel([], Acc, O) -> 1916 mergel(Acc, [], O). 1917 1918merge2_1([H1 | T1], H2, T2, M) when H1 =< H2 -> 1919 merge2_1(T1, H2, T2, [H1 | M]); 1920merge2_1([H1 | T1], H2, T2, M) -> 1921 merge2_2(T1, H1, T2, [H2 | M]); 1922merge2_1([], H2, T2, M) -> 1923 lists:reverse(T2, [H2 | M]). 1924 1925merge2_2(T1, H1, [H2 | T2], M) when H1 =< H2 -> 1926 merge2_1(T1, H2, T2, [H1 | M]); 1927merge2_2(T1, H1, [H2 | T2], M) -> 1928 merge2_2(T1, H1, T2, [H2 | M]); 1929merge2_2(T1, H1, [], M) -> 1930 lists:reverse(T1, [H1 | M]). 1931 1932rmerge2_1([H1 | T1], H2, T2, M) when H1 =< H2 -> 1933 rmerge2_2(T1, H1, T2, [H2 | M]); 1934rmerge2_1([H1 | T1], H2, T2, M) -> 1935 rmerge2_1(T1, H2, T2, [H1 | M]); 1936rmerge2_1([], H2, T2, M) -> 1937 lists:reverse(T2, [H2 | M]). 1938 1939rmerge2_2(T1, H1, [H2 | T2], M) when H1 =< H2 -> 1940 rmerge2_2(T1, H1, T2, [H2 | M]); 1941rmerge2_2(T1, H1, [H2 | T2], M) -> 1942 rmerge2_1(T1, H2, T2, [H1 | M]); 1943rmerge2_2(T1, H1, [], M) -> 1944 lists:reverse(T1, [H1 | M]). 1945 1946 1947 1948%% This version of keysort/2 is really stable; the order of equal 1949%% elements is kept. It is used for checking the current 1950%% implementation of ukeysort/2 etc. 1951 1952lkeysort(Index, L) when is_integer(Index), Index > 0 -> 1953 case L of 1954 [] -> L; 1955 [_] -> L; 1956 [X, Y | T] -> 1957 EX = element(Index, X), 1958 EY = element(Index, Y), 1959 if 1960 EX =< EY -> 1961 keysplit_1(Index, X, EX, Y, EY, T, [], []); 1962 true -> 1963 keysplit_2(Index, Y, EY, T, [X]) 1964 end 1965 end. 1966 1967keysplit_1(I, X, EX, Y, EY, [Z | L], R, Rs) -> 1968 EZ = element(I, Z), 1969 if 1970 EY =< EZ -> 1971 keysplit_1(I, Y, EY, Z, EZ, L, [X | R], Rs); 1972 EX =< EZ -> 1973 keysplit_1(I, Z, EZ, Y, EY, L, [X | R], Rs); 1974 true, R == [] -> 1975 keysplit_1(I, X, EX, Y, EY, L, [Z], Rs); 1976 true -> 1977 keysplit_1_1(I, X, EX, Y, EY, L, R, Rs, Z, EZ) 1978 end; 1979keysplit_1(I, X, _EX, Y, _EY, [], R, Rs) -> 1980 rkeymergel(I, [[Y, X | R] | Rs], []). 1981 1982%% One out-of-order element, S. 1983keysplit_1_1(I, X, EX, Y, EY, [Z | L], R, Rs, S, ES) -> 1984 EZ = element(I, Z), 1985 if 1986 EY =< EZ -> 1987 keysplit_1_1(I, Y, EY, Z, EZ, L, [X | R], Rs, S, ES); 1988 EX =< EZ -> 1989 keysplit_1_1(I, Z, EZ, Y, EY, L, [X | R], Rs, S, ES); 1990 ES =< EZ -> 1991 keysplit_1(I, S, ES, Z, EZ, L, [], [[Y, X | R] | Rs]); 1992 true -> 1993 keysplit_1(I, Z, EZ, S, ES, L, [], [[Y, X | R] | Rs]) 1994 end; 1995keysplit_1_1(I, X, _EX, Y, _EY, [], R, Rs, S, _ES) -> 1996 rkeymergel(I, [[S], [Y, X | R] | Rs], []). 1997 1998%% Descending. 1999keysplit_2(I, Y, EY, [Z | L], R) -> 2000 EZ = element(I, Z), 2001 if 2002 EY =< EZ -> 2003 keysplit_1(I, Y, EY, Z, EZ, L, [], [lists:reverse(R, [])]); 2004 true -> 2005 keysplit_2(I, Z, EZ, L, [Y | R]) 2006 end; 2007keysplit_2(_I, Y, _EY, [], R) -> 2008 [Y | R]. 2009 2010keymergel(I, [T1, [H2 | T2] | L], Acc) -> 2011 keymergel(I, L, [keymerge2_1(I, T1, element(I, H2), H2, T2, []) | Acc]); 2012keymergel(_I, [L], []) -> 2013 L; 2014keymergel(I, [L], Acc) -> 2015 rkeymergel(I, [lists:reverse(L, []) | Acc], []); 2016keymergel(I, [], Acc) -> 2017 rkeymergel(I, Acc, []). 2018 2019rkeymergel(I, [[H2 | T2], T1 | L], Acc) -> 2020 rkeymergel(I, L, [rkeymerge2_1(I, T1, element(I, H2), H2, T2, []) | Acc]); 2021rkeymergel(I, [L], Acc) -> 2022 keymergel(I, [lists:reverse(L, []) | Acc], []); 2023rkeymergel(I, [], Acc) -> 2024 keymergel(I, Acc, []). 2025 2026keymerge2_1(I, [H1 | T1], E2, H2, T2, M) -> 2027 E1 = element(I, H1), 2028 if 2029 E1 =< E2 -> 2030 keymerge2_1(I, T1, E2, H2, T2, [H1 | M]); 2031 true -> 2032 keymerge2_2(I, T1, E1, H1, T2, [H2 | M]) 2033 end; 2034keymerge2_1(_I, [], _E2, H2, T2, M) -> 2035 lists:reverse(T2, [H2 | M]). 2036 2037keymerge2_2(I, T1, E1, H1, [H2 | T2], M) -> 2038 E2 = element(I, H2), 2039 if 2040 E1 =< E2 -> 2041 keymerge2_1(I, T1, E2, H2, T2, [H1 | M]); 2042 true -> 2043 keymerge2_2(I, T1, E1, H1, T2, [H2 | M]) 2044 end; 2045keymerge2_2(_I, T1, _E1, H1, [], M) -> 2046 lists:reverse(T1, [H1 | M]). 2047 2048rkeymerge2_1(I, [H1 | T1], E2, H2, T2, M) -> 2049 E1 = element(I, H1), 2050 if 2051 E1 =< E2 -> 2052 rkeymerge2_2(I, T1, E1, T2, [H2 | M], H1); 2053 true -> 2054 rkeymerge2_1(I, T1, E2, H2, T2, [H1 | M]) 2055 end; 2056rkeymerge2_1(_I, [], _E2, H2, T2, M) -> 2057 lists:reverse(T2, [H2 | M]). 2058 2059rkeymerge2_2(I, T1, E1, [H2 | T2], M, H1) -> 2060 E2 = element(I, H2), 2061 if 2062 E1 =< E2 -> 2063 rkeymerge2_2(I, T1, E1, T2, [H2 | M], H1); 2064 true -> 2065 rkeymerge2_1(I, T1, E2, H2, T2, [H1 | M]) 2066 end; 2067rkeymerge2_2(_I, T1, _E1, [], M, H1) -> 2068 lists:reverse(T1, [H1 | M]). 2069 2070 2071%%%------------------------------------------------------------ 2072 2073 2074%% Test for infinite loop (OTP-2404). 2075seq_loop(Config) when is_list(Config) -> 2076 _ = (catch lists:seq(1, 5, -1)), 2077 ok. 2078 2079%% Non-error cases for seq/2. 2080seq_2(Config) when is_list(Config) -> 2081 [1,2,3] = lists:seq(1,3), 2082 [1] = lists:seq(1,1), 2083 Big = 748274827583793785928592859, 2084 Big1 = Big+1, 2085 Big2 = Big+2, 2086 [Big, Big1, Big2] = lists:seq(Big, Big+2), 2087 ok. 2088 2089%% Error cases for seq/2. 2090seq_2_e(Config) when is_list(Config) -> 2091 seq_error([4, 2]), 2092 seq_error([1, a]), 2093 seq_error([1.0, 2.0]), 2094 ok. 2095 2096seq_error(Args) -> 2097 {'EXIT', _} = (catch apply(lists, seq, Args)). 2098 2099%% Non-error cases for seq/3. 2100seq_3(Config) when is_list(Config) -> 2101 [1,2,3] = lists:seq(1,3,1), 2102 [1] = lists:seq(1,1,1), 2103 Big = 748274827583793785928592859, 2104 Big1 = Big+1, 2105 Big2 = Big+2, 2106 [Big, Big1, Big2] = lists:seq(Big, Big+2,1), 2107 2108 [3,2,1] = lists:seq(3,1,-1), 2109 [1] = lists:seq(1,1,-1), 2110 2111 [3,1] = lists:seq(3,1,-2), 2112 [1] = lists:seq(1, 10, 10), 2113 [1, 4, 7, 10, 13, 16, 19] = lists:seq(1, 19, 3), 2114 [1, 4, 7, 10, 13, 16, 19] = lists:seq(1, 20, 3), 2115 [1, 4, 7, 10, 13, 16, 19] = lists:seq(1, 21, 3), 2116 2117 [1] = lists:seq(1, 1, 0), %OTP-2613 2118 ok. 2119 2120%% Error cases for seq/3. 2121seq_3_e(Config) when is_list(Config) -> 2122 seq_error([4, 2, 1]), 2123 seq_error([3, 5, -1]), 2124 seq_error([1, a, 1]), 2125 seq_error([1.0, 2.0, 1]), 2126 2127 seq_error([1, 3, 1.0]), 2128 seq_error([1, 3, a]), 2129 seq_error([1, 3, 0]), 2130 2131 seq_error([a, a, 0]), 2132 ok. 2133 2134%% OTP-7230. seq/1,2 returns the empty list. 2135otp_7230(Config) when is_list(Config) -> 2136 From = -10, 2137 To = 10, 2138 StepFrom = -10, 2139 StepTo = 10, 2140 2141 L = lists:seq(From, To), 2142 SL = lists:seq(StepFrom, StepTo), 2143 [] = 2144 [{F, T, S} || 2145 F <- L, T <- L, S <- SL, 2146 not check_seq(F, T, S, catch lists:seq(F, T, S)) 2147 orelse 2148 S =:= 1 andalso not check_seq(F, T, S, catch lists:seq(F, T)) 2149 ]. 2150 2151check_seq(From, To, 0, R) -> 2152 From =:= To andalso R =:= [From] 2153 orelse 2154 From =/= To andalso is_tuple(R) andalso element(1, R) =:= 'EXIT'; 2155check_seq(From, To, Step, []) when Step =/= 0 -> 2156 0 =:= property(From, To, Step) 2157 andalso 2158 ( 2159 Step > 0 andalso To < From andalso From-To =< Step 2160 orelse 2161 Step < 0 andalso To > From andalso To-From =< -Step 2162 ); 2163check_seq(From, To, Step, R) when R =/= [], To < From, Step > 0 -> 2164 is_tuple(R) andalso element(1, R) =:= 'EXIT'; 2165check_seq(From, To, Step, R) when R =/= [], To > From, Step < 0 -> 2166 is_tuple(R) andalso element(1, R) =:= 'EXIT'; 2167check_seq(From, To, Step, L) when is_list(L), L =/= [], Step =/= 0 -> 2168 First = hd(L), 2169 Last = lists:last(L), 2170 Min = lists:min(L), 2171 Max = lists:max(L), 2172 2173 [] =:= [E || E <- L, not is_integer(E)] 2174 andalso 2175 %% The difference between two consecutive elements is Step: 2176 begin 2177 LS = [First-Step]++L, 2178 LR = L++[Last+Step], 2179 [Step] =:= lists:usort([B-A || {A,B} <- lists:zip(LS, LR)]) 2180 end 2181 andalso 2182 %% The first element of L is From: 2183 From =:= First 2184 andalso 2185 %% No element outside the given interval: 2186 Min >= lists:min([From, To]) 2187 andalso 2188 Max =< lists:max([From, To]) 2189 andalso 2190 %% All elements are present: 2191 abs(To-Last) < abs(Step) 2192 andalso 2193 length(L) =:= property(From, To, Step); 2194check_seq(_From, _To, _Step, _R) -> 2195 false. 2196 2197property(From, To, Step) -> 2198 ((To-From+Step) div Step). 2199 2200%%%------------------------------------------------------------ 2201 2202 2203-define(sublist_error2(X,Y), {'EXIT', _} = (catch lists:sublist(X,Y))). 2204-define(sublist_error3(X,Y,Z), {'EXIT', _} = (catch lists:sublist(X,Y,Z))). 2205 2206sublist_2(Config) when is_list(Config) -> 2207 [] = lists:sublist([], 0), 2208 [] = lists:sublist([], 1), 2209 [] = lists:sublist([a], 0), 2210 [a] = lists:sublist([a], 1), 2211 [a] = lists:sublist([a], 2), 2212 [a] = lists:sublist([a|b], 1), 2213 2214 [a,b] = lists:sublist([a,b|c], 2), 2215 2216 ok. 2217 2218%% sublist/2 error cases. 2219sublist_2_e(Config) when is_list(Config) -> 2220 ?sublist_error2([], -1), 2221 ?sublist_error2(a, -1), 2222 ?sublist_error2(a, 0), 2223 ?sublist_error2([a|b], 2), 2224 ?sublist_error2([a], x), 2225 ?sublist_error2([a], 1.5), 2226 ?sublist_error2([], x), 2227 ?sublist_error2([], 1.5), 2228 ok. 2229 2230sublist_3(Config) when is_list(Config) -> 2231 [] = lists:sublist([], 1, 0), 2232 [] = lists:sublist([], 1, 1), 2233 [] = lists:sublist([], 2, 0), 2234 [] = lists:sublist([a], 1, 0), 2235 [a] = lists:sublist([a], 1, 1), 2236 [a] = lists:sublist([a], 1, 2), 2237 [a] = lists:sublist([a|b], 1, 1), 2238 2239 [] = lists:sublist([], 1, 0), 2240 [] = lists:sublist([], 1, 1), 2241 [] = lists:sublist([a], 1, 0), 2242 [a] = lists:sublist([a], 1, 1), 2243 [a] = lists:sublist([a], 1, 2), 2244 [] = lists:sublist([a], 2, 1), 2245 [] = lists:sublist([a], 2, 2), 2246 [] = lists:sublist([a], 2, 79), 2247 [] = lists:sublist([a], 3, 1), 2248 [] = lists:sublist([a,b|c], 1, 0), 2249 [] = lists:sublist([a,b|c], 2, 0), 2250 [a] = lists:sublist([a,b|c], 1, 1), 2251 [b] = lists:sublist([a,b|c], 2, 1), 2252 [a,b] = lists:sublist([a,b|c], 1, 2), 2253 2254 [] = lists:sublist([a], 2, 0), 2255 2256 ok. 2257 2258%% sublist/3 error cases 2259sublist_3_e(Config) when is_list(Config) -> 2260 ?sublist_error3([], 1, -1), 2261 ?sublist_error3(a, 1, -1), 2262 ?sublist_error3(a, 1, 0), 2263 ?sublist_error3([a|b], 1, 2), 2264 ?sublist_error3([a], 1, x), 2265 ?sublist_error3([a], 1, 1.5), 2266 ?sublist_error3([], 1, x), 2267 ?sublist_error3([], 1, 1.5), 2268 2269 ?sublist_error3([], -1, 0), 2270 ?sublist_error3(a, x, -1), 2271 ?sublist_error3([a,b], 0.5, 1), 2272 ?sublist_error3([a,b], 1.5, 1), 2273 ?sublist_error3([a], 1, x), 2274 ?sublist_error3([a], 1, 1.5), 2275 ?sublist_error3([], 1, x), 2276 ?sublist_error3([], 1, 1.5), 2277 2278 ?sublist_error3([a], 0, -1), 2279 ?sublist_error3([a], 1, -1), 2280 ?sublist_error3([a], 2, -1), 2281 ?sublist_error3([a], 0, 0), 2282 ?sublist_error3([a], 0, 1), 2283 2284 ?sublist_error3([a,b|c], 2, 2), 2285 ?sublist_error3([a,b|c], 3, 0), 2286 ?sublist_error3([a,b|c], 3, 1), 2287 ok. 2288 2289%%%------------------------------------------------------------ 2290 2291 2292-define(flatten_error1(X), {'EXIT', _} = (catch lists:flatten(X))). 2293-define(flatten_error2(X,Y), {'EXIT', _} = (catch lists:flatten(X,Y))). 2294 2295%% Test lists:flatten/1,2 and lists:flatlength/1. 2296flatten_1(Config) when is_list(Config) -> 2297 [] = lists_flatten([]), 2298 [1,2] = lists_flatten([1,2]), 2299 [1,2] = lists_flatten([1,[2]]), 2300 [1,2] = lists_flatten([[1],2]), 2301 [1,2] = lists_flatten([[1],[2]]), 2302 [1,2] = lists_flatten([[1,2]]), 2303 [a,b,c,d] = lists_flatten([[a],[b,c,[d]]]), 2304 2305 ok. 2306 2307lists_flatten(List) -> 2308 Flat = lists:flatten(List), 2309 Flat = lists:flatten(List, []), 2310 Len = lists:flatlength(List), 2311 Len = length(Flat), 2312 Flat. 2313 2314%% flatten/1 error cases 2315flatten_1_e(Config) when is_list(Config) -> 2316 ?flatten_error1(a), 2317 ?flatten_error1([a|b]), 2318 ?flatten_error1([[a],[b|c],[d]]), 2319 ok. 2320 2321%%% [arndt] What if second arg isn't a proper list? This issue isn't 2322%%% clear-cut. Right now, I think that any term should be allowed. 2323%%% But I also wish this function didn't exist at all. 2324 2325%% Test lists:flatten/2. 2326flatten_2(Config) when is_list(Config) -> 2327 [] = lists:flatten([], []), 2328 [a] = lists:flatten([a], []), 2329 [a,b,c,[no,flatten]] = lists:flatten([[a,[b,c]]], [[no,flatten]]), 2330 ok. 2331 2332%% flatten/2 error cases. 2333flatten_2_e(Config) when is_list(Config) -> 2334 ok. 2335 2336%% Test lists:zip/2, lists:unzip/1. 2337zip_unzip(Config) when is_list(Config) -> 2338 [] = lists:zip([], []), 2339 [{a,b}] = lists:zip([a], [b]), 2340 [{42.0,{kalle,nisse}},{a,b}] = lists:zip([42.0,a], [{kalle,nisse},b]), 2341 2342 %% Longer lists. 2343 SeqA = lists:seq(45, 200), 2344 SeqB = [A*A || A <- SeqA], 2345 AB = lists:zip(SeqA, SeqB), 2346 SeqA = [A || {A,_} <- AB], 2347 SeqB = [B || {_,B} <- AB], 2348 {SeqA,SeqB} = lists:unzip(AB), 2349 2350 %% Some more unzip/1. 2351 {[],[]} = lists:unzip([]), 2352 {[a],[b]} = lists:unzip([{a,b}]), 2353 {[a,c],[b,d]} = lists:unzip([{a,b},{c,d}]), 2354 2355 %% Error cases. 2356 {'EXIT',{function_clause,_}} = (catch lists:zip([], [b])), 2357 {'EXIT',{function_clause,_}} = (catch lists:zip([a], [])), 2358 {'EXIT',{function_clause,_}} = (catch lists:zip([a], [b,c])), 2359 {'EXIT',{function_clause,_}} = (catch lists:zip([a], [b,c])), 2360 ok. 2361 2362%% Test lists:zip3/3, lists:unzip3/1. 2363zip_unzip3(Config) when is_list(Config) -> 2364 [] = lists:zip3([], [], []), 2365 [{a,b,c}] = lists:zip3([a], [b], [c]), 2366 2367 %% Longer lists. 2368 SeqA = lists:seq(45, 200), 2369 SeqB = [2*A || A <- SeqA], 2370 SeqC = [A*A || A <- SeqA], 2371 ABC = lists:zip3(SeqA, SeqB, SeqC), 2372 SeqA = [A || {A,_,_} <- ABC], 2373 SeqB = [B || {_,B,_} <- ABC], 2374 SeqC = [C || {_,_,C} <- ABC], 2375 {SeqA,SeqB,SeqC} = lists:unzip3(ABC), 2376 2377 %% Some more unzip3/1. 2378 {[],[],[]} = lists:unzip3([]), 2379 {[a],[b],[c]} = lists:unzip3([{a,b,c}]), 2380 2381 %% Error cases. 2382 {'EXIT',{function_clause,_}} = (catch lists:zip3([], [], [c])), 2383 {'EXIT',{function_clause,_}} = (catch lists:zip3([], [b], [])), 2384 {'EXIT',{function_clause,_}} = (catch lists:zip3([a], [], [])), 2385 2386 ok. 2387 2388%% Test lists:zipwith/3. 2389zipwith(Config) when is_list(Config) -> 2390 Zip = fun(A, B) -> [A|B] end, 2391 2392 [] = lists:zipwith(Zip, [], []), 2393 [[a|b]] = lists:zipwith(Zip, [a], [b]), 2394 2395 %% Longer lists. 2396 SeqA = lists:seq(77, 300), 2397 SeqB = [A*A || A <- SeqA], 2398 AB = lists:zipwith(Zip, SeqA, SeqB), 2399 SeqA = [A || [A|_] <- AB], 2400 SeqB = [B || [_|B] <- AB], 2401 2402 %% Error cases. 2403 {'EXIT',{function_clause,_}} = (catch lists:zipwith(badfun, [], [])), 2404 {'EXIT',{function_clause,_}} = (catch lists:zipwith(Zip, [], [b])), 2405 {'EXIT',{function_clause,_}} = (catch lists:zipwith(Zip, [a], [])), 2406 {'EXIT',{function_clause,_}} = (catch lists:zipwith(Zip, [a], [b,c])), 2407 {'EXIT',{function_clause,_}} = (catch lists:zipwith(Zip, [a], [b,c])), 2408 ok. 2409 2410%% Test lists:zipwith3/4. 2411zipwith3(Config) when is_list(Config) -> 2412 Zip = fun(A, B, C) -> [A,B,C] end, 2413 2414 [] = lists:zipwith3(Zip, [], [], []), 2415 [[a,b,c]] = lists:zipwith3(Zip, [a], [b], [c]), 2416 2417 %% Longer lists. 2418 SeqA = lists:seq(45, 200), 2419 SeqB = [2*A || A <- SeqA], 2420 SeqC = [A*A || A <- SeqA], 2421 ABC = lists:zipwith3(Zip, SeqA, SeqB, SeqC), 2422 SeqA = [A || [A,_,_] <- ABC], 2423 SeqB = [B || [_,B,_] <- ABC], 2424 SeqC = [C || [_,_,C] <- ABC], 2425 2426 %% Error cases. 2427 {'EXIT',{function_clause,_}} = (catch lists:zipwith3(badfun, [], [], [])), 2428 {'EXIT',{function_clause,_}} = (catch lists:zipwith3(Zip, [], [], [c])), 2429 {'EXIT',{function_clause,_}} = (catch lists:zipwith3(Zip, [], [b], [])), 2430 {'EXIT',{function_clause,_}} = (catch lists:zipwith3(Zip, [a], [], [])), 2431 2432 ok. 2433 2434%% Test lists:join/2 2435join(Config) when is_list(Config) -> 2436 A = [a,b,c], 2437 Sep = x, 2438 [a,x,b,x,c] = lists:join(Sep, A), 2439 2440 B = [b], 2441 [b] = lists:join(Sep, B), 2442 2443 C = [], 2444 [] = lists:join(Sep, C), 2445 ok. 2446 2447%% Test lists:filter/2, lists:partition/2. 2448filter_partition(Config) when is_list(Config) -> 2449 F = fun(I) -> I rem 2 =:= 0 end, 2450 filpart(F, [], []), 2451 filpart(F, [1], []), 2452 filpart(F, [1,3,17], []), 2453 filpart(F, [1,2,3,17], [2]), 2454 filpart(F, [6,8,1,2,3,17], [6,8,2]), 2455 filpart(F, [6,8,1,2,42,3,17], [6,8,2,42]), 2456 2457 %% Error cases. 2458 {'EXIT',{function_clause,_}} = (catch lists:filter(badfun, [])), 2459 {'EXIT',{function_clause,_}} = (catch lists:partition(badfun, [])), 2460 ok. 2461 2462filpart(F, All, Exp) -> 2463 Exp = lists:filter(F, All), 2464 Other = lists:filter(fun(E) -> not F(E) end, All), 2465 {Exp,Other} = lists:partition(F, All). 2466 2467 2468%% OTP-5939. Guard tests added. 2469otp_5939(Config) when is_list(Config) -> 2470 Fun1 = fun(A) -> A end, 2471 Fun2 = fun(A, B) -> {A,B} end, 2472 Fun3 = fun(A, B, C) -> {A,B,C} end, 2473 Pred = fun(_A) -> true end, 2474 Fold = fun(_E, A) -> A end, 2475 MapFold = fun(E, A) -> {E,A} end, 2476 2477 {'EXIT', _} = (catch lists:usort( [asd], [qwe])), 2478 2479 {'EXIT', _} = (catch lists:zipwith(func, [], [])), 2480 [] = lists:zipwith(Fun2, [], []), 2481 {'EXIT', _} = (catch lists:zipwith3(func, [], [], [])), 2482 [] = lists:zipwith3(Fun3, [], [], []), 2483 {'EXIT', _} = (catch lists:keymap(func, 1, [])), 2484 {'EXIT', _} = (catch lists:keymap(Fun1, 0, [])), 2485 [] = lists:keymap(Fun1, 1, []), 2486 {'EXIT', _} = (catch lists:merge(func, [], [1])), 2487 {'EXIT', _} = (catch lists:merge(func, [1], [])), 2488 [] = lists:merge(Fun2, [], []), 2489 {'EXIT', _} = (catch lists:rmerge(func, [], [1])), 2490 {'EXIT', _} = (catch lists:rmerge(func, [1], [])), 2491 [] = lists:rmerge(Fun2, [], []), 2492 {'EXIT', _} = (catch lists:usort(func, [])), 2493 {'EXIT', _} = (catch lists:usort(func, [a])), 2494 {'EXIT', _} = (catch lists:usort(func, [a, b])), 2495 [] = lists:usort(Fun2, []), 2496 {'EXIT', _} = (catch lists:umerge(func, [], [1])), 2497 {'EXIT', _} = (catch lists:merge(func, [1], [])), 2498 [] = lists:umerge(Fun2, [], []), 2499 {'EXIT', _} = (catch lists:rumerge(func, [], [1])), 2500 {'EXIT', _} = (catch lists:rumerge(func, [1], [])), 2501 [] = lists:rumerge(Fun2, [], []), 2502 {'EXIT', _} = (catch lists:all(func, [])), 2503 true = lists:all(Pred, []), 2504 {'EXIT', _} = (catch lists:any(func, [])), 2505 false = lists:any(Pred, []), 2506 {'EXIT', _} = (catch lists:map(func, [])), 2507 [] = lists:map(Fun1, []), 2508 {'EXIT', _} = (catch lists:flatmap(func, [])), 2509 [] = lists:flatmap(Fun1, []), 2510 {'EXIT', _} = (catch lists:foldl(func, [], [])), 2511 [] = lists:foldl(Fold, [], []), 2512 {'EXIT', _} = (catch lists:foldr(func, [], [])), 2513 [] = lists:foldr(Fold, [], []), 2514 {'EXIT', _} = (catch lists:filter(func, [])), 2515 [] = lists:filter(Pred, []), 2516 {'EXIT', _} = (catch lists:partition(func, [])), 2517 {[],[]} = lists:partition(Pred, []), 2518 {'EXIT', _} = (catch lists:filtermap(func, [])), 2519 [] = lists:filtermap(Fun1, []), 2520 {'EXIT', _} = (catch lists:foreach(func, [])), 2521 ok = lists:foreach(Fun1, []), 2522 {'EXIT', _} = (catch lists:mapfoldl(func, [], [])), 2523 {[],[]} = lists:mapfoldl(MapFold, [], []), 2524 {'EXIT', _} = (catch lists:mapfoldr(func, [], [])), 2525 {[],[]} = lists:mapfoldr(MapFold, [], []), 2526 {'EXIT', _} = (catch lists:takewhile(func, [])), 2527 [] = lists:takewhile(Pred, []), 2528 {'EXIT', _} = (catch lists:dropwhile(func, [])), 2529 [] = lists:dropwhile(Pred, []), 2530 {'EXIT', _} = (catch lists:splitwith(func, [])), 2531 {[],[]} = lists:splitwith(Pred, []), 2532 2533 ok. 2534 2535%% OTP-6023. lists:keyreplace/4, a typecheck. 2536otp_6023(Config) when is_list(Config) -> 2537 {'EXIT', _} = (catch lists:keyreplace(a, 2, [{1,a}], b)), 2538 [{2,b}] = lists:keyreplace(a, 2, [{1,a}], {2,b}), 2539 2540 ok. 2541 2542%% OTP-6606. sort and keysort bug. 2543otp_6606(Config) when is_list(Config) -> 2544 I = 1, 2545 F = float(1), 2546 L1 = [{F,I},{F,F},{I,I},{I,F}], 2547 L1 = lists:keysort(1, L1), 2548 L1 = lists:sort(L1), 2549 L2 = [{I,I},{I,F},{F,I},{F,F}], 2550 L2 = lists:keysort(1, L2), 2551 L2 = lists:sort(L2), 2552 ok. 2553 2554%% Test lists:suffix/2. 2555suffix(Config) when is_list(Config) -> 2556 true = lists:suffix([], []), 2557 true = lists:suffix([], [a]), 2558 true = lists:suffix([], [a,b]), 2559 true = lists:suffix([], [a,b,c]), 2560 true = lists:suffix([a], lists:duplicate(200000, a)), 2561 true = lists:suffix(lists:seq(1, 1024), 2562 lists:seq(2, 64000) ++ lists:seq(1, 1024)), 2563 true = lists:suffix(lists:duplicate(20000, a), 2564 lists:duplicate(200000, a)), 2565 true = lists:suffix([2.0,3.0], [1.0,2.0,3.0]), 2566 2567 %% False cases. 2568 false = lists:suffix([a], []), 2569 false = lists:suffix([a,b,c], []), 2570 false = lists:suffix([a,b,c], [b,c]), 2571 false = lists:suffix([a,b,c], [a,b,c,a,b]), 2572 false = lists:suffix(lists:duplicate(199999, a)++[b], 2573 lists:duplicate(200000, a)), 2574 false = lists:suffix([2.0,3.0], [1,2,3]), 2575 2576 %% Error cases. 2577 {'EXIT',_} = (catch lists:suffix({a,b,c}, [])), 2578 {'EXIT',_} = (catch lists:suffix([], {a,b})), 2579 {'EXIT',_} = (catch lists:suffix([a|b], [])), 2580 {'EXIT',_} = (catch lists:suffix([a,b|c], [a|b])), 2581 {'EXIT',_} = (catch lists:suffix([a|b], [a,b|c])), 2582 {'EXIT',_} = (catch lists:suffix([a|b], [a|b])), 2583 2584 ok. 2585 2586%% Test lists:subtract/2 and the '--' operator. 2587subtract(Config) when is_list(Config) -> 2588 [] = sub([], []), 2589 [] = sub([], [a]), 2590 [] = sub([], lists:seq(1, 1024)), 2591 sub_non_matching([a], []), 2592 sub_non_matching([1,2], [make_ref()]), 2593 sub_non_matching(lists:seq(1, 1024), [make_ref(),make_ref()]), 2594 2595 %% Matching subtracts. 2596 [] = sub([a], [a]), 2597 [a] = sub([a,b], [b]), 2598 [a] = sub([a,b], [b,c]), 2599 [a] = sub([a,b,c], [b,c]), 2600 [a] = sub([a,b,c], [b,c]), 2601 [d,a,a] = sub([a,b,c,d,a,a], [a,b,c]), 2602 [d,x,a] = sub([a,b,c,d,a,x,a], [a,b,c,a]), 2603 [1,2,3,4,5,6,7,8,9,9999,10000,20,21,22] = 2604 sub(lists:seq(1, 10000)++[20,21,22], lists:seq(10, 9998)), 2605 2606 %% ERL-986; an integer overflow relating to term comparison 2607 %% caused subtraction to be inconsistent. 2608 Ids = [2985095936,47540628,135460048,1266126295,240535295, 2609 115724671,161800351,4187206564,4178142725,234897063, 2610 14773162,6662515191,133150693,378034895,1874402262, 2611 3507611978,22850922,415521280,253360400,71683243], 2612 2613 [] = id(Ids) -- id(Ids), 2614 2615 %% Floats/integers. 2616 [42.0,42.0] = sub([42.0,42,42.0], [42,42,42]), 2617 [1,2,3,4,43.0] = sub([1,2,3,4,5,42.0,43.0], [42.0,5]), 2618 2619 %% Crashing subtracts. 2620 {'EXIT',_} = (catch sub([], [a|b])), 2621 {'EXIT',_} = (catch sub([a], [a|b])), 2622 {'EXIT',_} = (catch sub([a|b], [])), 2623 {'EXIT',_} = (catch sub([a|b], [])), 2624 {'EXIT',_} = (catch sub([a|b], [a])), 2625 2626 %% Trapping, both crashing and otherwise. 2627 [sub_trapping(N) || N <- lists:seq(0, 18)], 2628 2629 %% The current implementation chooses which algorithm to use based on 2630 %% certain thresholds, and we need proper coverage for all corner cases. 2631 [sub_thresholds(N) || N <- lists:seq(0, 32)], 2632 2633 %% Trapping, both crashing and otherwise. 2634 [sub_trapping(N) || N <- lists:seq(0, 18)], 2635 2636 %% The current implementation chooses which algorithm to use based on 2637 %% certain thresholds, and we need proper coverage for all corner cases. 2638 [sub_thresholds(N) || N <- lists:seq(0, 32)], 2639 2640 ok. 2641 2642id(I) -> I. 2643 2644sub_non_matching(A, B) -> 2645 A = sub(A, B). 2646 2647sub(A, B) -> 2648 Res = A -- B, 2649 Res = lists:subtract(A, B). 2650 2651sub_trapping(N) -> 2652 List = lists:duplicate(N + (1 bsl N), gurka), 2653 ImproperList = List ++ crash, 2654 2655 {'EXIT',_} = (catch sub_trapping_1(ImproperList, [])), 2656 {'EXIT',_} = (catch sub_trapping_1(List, ImproperList)), 2657 2658 List = List -- lists:duplicate(N + (1 bsl N), gaffel), 2659 ok = sub_trapping_1(List, []). 2660 2661sub_trapping_1([], _) -> ok; 2662sub_trapping_1(L, R) -> sub_trapping_1(L -- R, [gurka | R]). 2663 2664sub_thresholds(N) -> 2665 %% This needs to be long enough to cause trapping. 2666 OtherLen = 1 bsl 18, 2667 Other = lists:seq(0, OtherLen - 1), 2668 2669 Disjoint = lists:seq(-N, -1), 2670 Subset = lists:seq(1, N), 2671 2672 %% LHS is disjoint from RHS, so all elements must be retained. 2673 Disjoint = Disjoint -- Other, 2674 2675 %% LHS is covered by RHS, so all elements must be removed. 2676 [] = Subset -- Other, 2677 2678 %% RHS is disjoint from LHS, so all elements must be retained. 2679 Other = Other -- Disjoint, 2680 2681 %% RHS is covered by LHS, so N elements must be removed. 2682 N = OtherLen - length(Other -- Subset), 2683 2684 ok. 2685 2686%% Test lists:droplast/1 2687droplast(Config) when is_list(Config) -> 2688 [] = lists:droplast([x]), 2689 [x] = lists:droplast([x, y]), 2690 {'EXIT', {function_clause, _}} = (catch lists:droplast([])), 2691 {'EXIT', {function_clause, _}} = (catch lists:droplast(x)), 2692 2693 ok. 2694 2695%% Test lists:search/2 2696search(Config) when is_list(Config) -> 2697 F = fun(I) -> I rem 2 =:= 0 end, 2698 F2 = fun(A, B) -> A > B end, 2699 2700 {value, 2} = lists:search(F, [1,2,3,4]), 2701 false = lists:search(F, [1,3,5,7]), 2702 false = lists:search(F, []), 2703 2704 %% Error cases. 2705 {'EXIT',{function_clause,_}} = (catch lists:search(badfun, [])), 2706 {'EXIT',{function_clause,_}} = (catch lists:search(F2, [])), 2707 ok. 2708 2709%% Briefly test the common high-order functions to ensure they 2710%% are covered. 2711hof(Config) when is_list(Config) -> 2712 L = [1,2,3], 2713 [1,4,9] = lists:map(fun(N) -> N*N end, L), 2714 [1,4,5,6] = lists:flatmap(fun(1) -> [1]; 2715 (2) -> []; 2716 (3) -> [4,5,6] 2717 end, L), 2718 [{1,[a]},{2,[b]},{3,[c]}] = 2719 lists:keymap(fun(A) -> [A] end, 2, [{1,a},{2,b},{3,c}]), 2720 2721 [1,3] = lists:filter(fun(N) -> N rem 2 =:= 1 end, L), 2722 FilterMapFun = fun(1) -> true; 2723 (2) -> {true,42}; 2724 (3) -> false 2725 end, 2726 [1,42] = lists:filtermap(FilterMapFun, L), 2727 [1,42] = lists:zf(FilterMapFun, L), 2728 2729 [3,2,1] = lists:foldl(fun(E, A) -> [E|A] end, [], L), 2730 [1,2,3] = lists:foldr(fun(E, A) -> [E|A] end, [], L), 2731 {[1,4,9],[3,2,1]} = lists:mapfoldl(fun(E, A) -> 2732 {E*E,[E|A]} 2733 end, [], L), 2734 {[1,4,9],[1,2,3]} = lists:mapfoldr(fun(E, A) -> 2735 {E*E,[E|A]} 2736 end, [], L), 2737 2738 true = lists:any(fun(N) -> N =:= 2 end, L), 2739 false = lists:any(fun(N) -> N =:= 42 end, L), 2740 2741 true = lists:all(fun(N) -> is_integer(N) end, L), 2742 false = lists:all(fun(N) -> N rem 2 =:= 0 end, L), 2743 2744 ok. 2745 2746error_info(_Config) -> 2747 L = [{keyfind, [whatever, bad_position, bad_list], [{2,".*"},{3,".*"}]}, 2748 {keymember, [key, 0, bad_list], [{2,".*"}, {3,".*"}]}, 2749 {keysearch, [key, bad_position, {no,list}], [{2,".*"}, {3,".*"}]}, 2750 {member, [whatever, not_a_list]}, 2751 {member, [whatever, [a|b]]}, 2752 {reverse, [not_a_list, whatever]} 2753 ], 2754 do_error_info(L). 2755 2756do_error_info(L0) -> 2757 L1 = lists:foldl(fun({_,A}, Acc) when is_integer(A) -> Acc; 2758 ({F,A}, Acc) -> [{F,A,[]}|Acc]; 2759 ({F,A,Opts}, Acc) -> [{F,A,Opts}|Acc] 2760 end, [], L0), 2761 Tests = ordsets:from_list([{F,length(A)} || {F,A,_} <- L1] ++ 2762 [{F,A} || {F,A} <- L0, is_integer(A)]), 2763 Bifs0 = [{F,A} || {M,F,A} <- erlang:system_info(snifs), 2764 M =:= lists, 2765 A =/= 0], 2766 Bifs = ordsets:from_list(Bifs0), 2767 NYI = [{F,lists:duplicate(A, '*'),nyi} || {F,A} <- Bifs -- Tests], 2768 L = lists:sort(NYI ++ L1), 2769 error_info_lib:test_error_info(lists, L, [snifs_only]). 2770