1
+ #:include "common.fypp"
2
+ #:set INT_INDEX_TYPES_ALT_NAME = list(zip(["int_index", "int_index_low"], ["integer(int_index)", "integer(int_index_low)"], ["default", "low"]))
3
+
1
4
module test_sorting
2
5
3
6
use, intrinsic :: iso_fortran_env, only: compiler_version, error_unit
@@ -54,14 +57,17 @@ module test_sorting
54
57
type(string_type) :: string_dummy(0:string_size-1)
55
58
type(bitset_large) :: bitsetl_dummy(0:bitset_size-1)
56
59
type(bitset_64) :: bitset64_dummy(0:bitset_size-1)
57
- integer (int_index) :: index (0 :max (test_size, char_size, string_size)- 1 )
60
+ integer(int_index) :: index_default(0:max(test_size, char_size, string_size)-1)
61
+ integer(int_index_low) :: index_low(0:max(test_size, char_size, string_size)-1)
58
62
integer(int32) :: work(0:test_size/2-1)
59
63
character(len=4) :: char_work(0:char_size/2-1)
60
64
type(string_type) :: string_work(0:string_size/2-1)
61
65
type(bitset_large) :: bitsetl_work(0:bitset_size/2-1)
62
66
type(bitset_64) :: bitset64_work(0:bitset_size/2-1)
63
- integer (int_index) :: iwork (0 :max (test_size, char_size, &
67
+ integer(int_index) :: iwork_default (0:max(test_size, char_size, &
64
68
string_size)/2-1)
69
+ integer(int_index_low) :: iwork_low(0:max(test_size, char_size, &
70
+ string_size)/2-1)
65
71
integer :: count, i, index1, index2, j, k, l, temp
66
72
real(sp) :: arand, brand
67
73
character(*), parameter :: filename = 'test_sorting.txt'
@@ -82,7 +88,6 @@ subroutine collect_sorting(testsuite)
82
88
type(unittest_type), allocatable, intent(out) :: testsuite(:)
83
89
84
90
testsuite = [ &
85
- new_unittest(' int_ord_sorts' , test_int_ord_sorts), &
86
91
new_unittest('char_ord_sorts', test_char_ord_sorts), &
87
92
new_unittest('string_ord_sorts', test_string_ord_sorts), &
88
93
new_unittest('bitset_large_ord_sorts', test_bitsetl_ord_sorts), &
@@ -94,11 +99,14 @@ subroutine collect_sorting(testsuite)
94
99
new_unittest('string_sorts', test_string_sorts), &
95
100
new_unittest('bitset_large_sorts', test_bitsetl_sorts), &
96
101
new_unittest('bitset_64_sorts', test_bitset64_sorts), &
97
- new_unittest(' int_sort_indexes' , test_int_sort_indexes), &
98
- new_unittest(' char_sort_indexes' , test_char_sort_indexes), &
99
- new_unittest(' string_sort_indexes' , test_string_sort_indexes), &
100
- new_unittest(' bitset_large_sort_indexes' , test_bitsetl_sort_indexes), &
101
- new_unittest(' bitset_64_sort_indexes' , test_bitset64_sort_indexes) &
102
+ #:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME
103
+ new_unittest('int_sort_indexes_${namei}$', test_int_sort_indexes_${namei}$), &
104
+ new_unittest('char_sort_indexes_${namei}$', test_char_sort_indexes_${namei}$), &
105
+ new_unittest('string_sort_indexes_${namei}$', test_string_sort_indexes_${namei}$), &
106
+ new_unittest('bitset_large_sort_indexes_${namei}$', test_bitsetl_sort_indexes_${namei}$), &
107
+ new_unittest('bitset_64_sort_indexes_${namei}$', test_bitset64_sort_indexes_${namei}$), &
108
+ #:endfor
109
+ new_unittest('int_ord_sorts', test_int_ord_sorts) &
102
110
]
103
111
104
112
end subroutine collect_sorting
@@ -1207,47 +1215,48 @@ subroutine test_bitset64_sort( a, a_name, ltest )
1207
1215
end if
1208
1216
end subroutine test_bitset64_sort
1209
1217
1210
- subroutine test_int_sort_indexes (error )
1218
+ #:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME
1219
+ subroutine test_int_sort_indexes_${namei}$(error)
1211
1220
!> Error handling
1212
1221
type(error_type), allocatable, intent(out) :: error
1213
1222
integer(int64) :: i
1214
1223
integer(int32), allocatable :: d1(:)
1215
- integer (int64) , allocatable :: index (:)
1224
+ ${ti}$ , allocatable :: index(:)
1216
1225
logical :: ltest
1217
1226
1218
- call test_int_sort_index ( blocks, " Blocks" , ltest )
1227
+ call test_int_sort_index_${namei}$ ( blocks, "Blocks", ltest )
1219
1228
call check(error, ltest)
1220
1229
if (allocated(error)) return
1221
1230
1222
- call test_int_sort_index ( decrease, " Decreasing" , ltest )
1231
+ call test_int_sort_index_${namei}$ ( decrease, "Decreasing", ltest )
1223
1232
call check(error, ltest)
1224
1233
if (allocated(error)) return
1225
1234
1226
- call test_int_sort_index ( identical, " Identical" , ltest )
1235
+ call test_int_sort_index_${namei}$ ( identical, "Identical", ltest )
1227
1236
call check(error, ltest)
1228
1237
if (allocated(error)) return
1229
1238
1230
- call test_int_sort_index ( increase, " Increasing" , ltest )
1239
+ call test_int_sort_index_${namei}$ ( increase, "Increasing", ltest )
1231
1240
call check(error, ltest)
1232
1241
if (allocated(error)) return
1233
1242
1234
- call test_int_sort_index ( rand1, " Random dense" , ltest )
1243
+ call test_int_sort_index_${namei}$ ( rand1, "Random dense", ltest )
1235
1244
call check(error, ltest)
1236
1245
if (allocated(error)) return
1237
1246
1238
- call test_int_sort_index ( rand2, " Random order" , ltest )
1247
+ call test_int_sort_index_${namei}$ ( rand2, "Random order", ltest )
1239
1248
call check(error, ltest)
1240
1249
if (allocated(error)) return
1241
1250
1242
- call test_int_sort_index ( rand0, " Random sparse" , ltest )
1251
+ call test_int_sort_index_${namei}$ ( rand0, "Random sparse", ltest )
1243
1252
call check(error, ltest)
1244
1253
if (allocated(error)) return
1245
1254
1246
- call test_int_sort_index ( rand3, " Random 3" , ltest )
1255
+ call test_int_sort_index_${namei}$ ( rand3, "Random 3", ltest )
1247
1256
call check(error, ltest)
1248
1257
if (allocated(error)) return
1249
1258
1250
- call test_int_sort_index ( rand10, " Random 10" , ltest )
1259
+ call test_int_sort_index_${namei}$ ( rand10, "Random 10", ltest )
1251
1260
call check(error, ltest)
1252
1261
if (allocated(error)) return
1253
1262
@@ -1257,9 +1266,9 @@ subroutine test_int_sort_indexes(error)
1257
1266
call verify_sort( d1, ltest, i )
1258
1267
call check(error, ltest)
1259
1268
1260
- end subroutine test_int_sort_indexes
1269
+ end subroutine test_int_sort_indexes_${namei}$
1261
1270
1262
- subroutine test_int_sort_index ( a , a_name , ltest )
1271
+ subroutine test_int_sort_index_${namei}$ ( a, a_name, ltest )
1263
1272
integer(int32), intent(inout) :: a(:)
1264
1273
character(*), intent(in) :: a_name
1265
1274
logical, intent(out) :: ltest
@@ -1275,57 +1284,57 @@ subroutine test_int_sort_index( a, a_name, ltest )
1275
1284
do i = 1, repeat
1276
1285
dummy = a
1277
1286
call system_clock( t0, rate )
1278
- call sort_index( dummy, index , work, iwork )
1287
+ call sort_index( dummy, index_${namei}$ , work, iwork_${namei}$ )
1279
1288
call system_clock( t1, rate )
1280
1289
tdiff = tdiff + t1 - t0
1281
1290
end do
1282
1291
tdiff = tdiff/repeat
1283
1292
1284
- dummy = a(index (0 :size (a)- 1 ))
1293
+ dummy = a(index_${namei}$ (0:size(a)-1))
1285
1294
call verify_sort( dummy, valid, i )
1286
1295
ltest = (ltest .and. valid)
1287
1296
if ( .not. valid ) then
1288
1297
write( *, * ) "SORT_INDEX did not sort " // a_name // "."
1289
1298
write(*,*) 'i = ', i
1290
- write (* ,' (a18, 2i7)' ) ' a(index (i-1:i)) = ' , a(index (i-1 :i))
1299
+ write(*,'(a18, 2i7)') 'a(index_${namei}$ (i-1:i)) = ', a(index_${namei}$ (i-1:i))
1291
1300
end if
1292
1301
write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
1293
1302
'a12, " |", F10.6, " |" )' ) &
1294
1303
test_size, a_name, "Sort_Index", tdiff/rate
1295
1304
1296
1305
dummy = a
1297
- call sort_index( dummy, index , work, iwork , reverse= .true. )
1298
- dummy = a(index (size (a)- 1 ))
1306
+ call sort_index( dummy, index_${namei}$ , work, iwork_${namei}$ , reverse=.true. )
1307
+ dummy = a(index_${namei}$ (size(a)-1))
1299
1308
call verify_reverse_sort( dummy, valid, i )
1300
1309
ltest = (ltest .and. valid)
1301
1310
if ( .not. valid ) then
1302
1311
write( *, * ) "SORT_INDEX did not reverse sort " // &
1303
1312
a_name // "."
1304
1313
write(*,*) 'i = ', i
1305
- write (* ,' (a18, 2i7)' ) ' a(index (i-1:i)) = ' , a(index (i-1 :i))
1314
+ write(*,'(a18, 2i7)') 'a(index_${namei}$ (i-1:i)) = ', a(index_${namei}$ (i-1:i))
1306
1315
end if
1307
1316
1308
- end subroutine test_int_sort_index
1317
+ end subroutine test_int_sort_index_${namei}$
1309
1318
1310
- subroutine test_char_sort_indexes (error )
1319
+ subroutine test_char_sort_indexes_${namei}$ (error)
1311
1320
!> Error handling
1312
1321
type(error_type), allocatable, intent(out) :: error
1313
1322
logical :: ltest
1314
1323
1315
- call test_char_sort_index ( char_decrease, " Char. Decrease" , ltest )
1324
+ call test_char_sort_index_${namei}$ ( char_decrease, "Char. Decrease", ltest )
1316
1325
call check(error, ltest)
1317
1326
if (allocated(error)) return
1318
1327
1319
- call test_char_sort_index ( char_increase, " Char. Increase" , ltest )
1328
+ call test_char_sort_index_${namei}$ ( char_increase, "Char. Increase", ltest )
1320
1329
call check(error, ltest)
1321
1330
if (allocated(error)) return
1322
1331
1323
- call test_char_sort_index ( char_rand, " Char. Random" , ltest )
1332
+ call test_char_sort_index_${namei}$ ( char_rand, "Char. Random", ltest )
1324
1333
call check(error, ltest)
1325
1334
1326
- end subroutine test_char_sort_indexes
1335
+ end subroutine test_char_sort_indexes_${namei}$
1327
1336
1328
- subroutine test_char_sort_index ( a , a_name , ltest )
1337
+ subroutine test_char_sort_index_${namei}$ ( a, a_name, ltest )
1329
1338
character(len=4), intent(in) :: a(0:)
1330
1339
character(*), intent(in) :: a_name
1331
1340
logical, intent(out) :: ltest
@@ -1342,7 +1351,7 @@ subroutine test_char_sort_index( a, a_name, ltest )
1342
1351
char_dummy = a
1343
1352
call system_clock( t0, rate )
1344
1353
1345
- call sort_index( char_dummy, index , char_work, iwork )
1354
+ call sort_index( char_dummy, index_${namei}$ , char_work, iwork_${namei}$ )
1346
1355
1347
1356
call system_clock( t1, rate )
1348
1357
@@ -1362,27 +1371,27 @@ subroutine test_char_sort_index( a, a_name, ltest )
1362
1371
'a12, " |", F10.6, " |" )' ) &
1363
1372
char_size, a_name, "Sort_Index", tdiff/rate
1364
1373
1365
- end subroutine test_char_sort_index
1374
+ end subroutine test_char_sort_index_${namei}$
1366
1375
1367
- subroutine test_string_sort_indexes (error )
1376
+ subroutine test_string_sort_indexes_${namei}$ (error)
1368
1377
!> Error handling
1369
1378
type(error_type), allocatable, intent(out) :: error
1370
1379
logical :: ltest
1371
1380
1372
- call test_string_sort_index ( string_decrease, " String Decrease" , ltest )
1381
+ call test_string_sort_index_${namei}$ ( string_decrease, "String Decrease", ltest )
1373
1382
call check(error, ltest)
1374
1383
if (allocated(error)) return
1375
1384
1376
- call test_string_sort_index ( string_increase, " String Increase" , ltest )
1385
+ call test_string_sort_index_${namei}$ ( string_increase, "String Increase", ltest )
1377
1386
call check(error, ltest)
1378
1387
if (allocated(error)) return
1379
1388
1380
- call test_string_sort_index ( string_rand, " String Random" , ltest )
1389
+ call test_string_sort_index_${namei}$ ( string_rand, "String Random", ltest )
1381
1390
call check(error, ltest)
1382
1391
1383
- end subroutine test_string_sort_indexes
1392
+ end subroutine test_string_sort_indexes_${namei}$
1384
1393
1385
- subroutine test_string_sort_index ( a , a_name , ltest )
1394
+ subroutine test_string_sort_index_${namei}$ ( a, a_name, ltest )
1386
1395
type(string_type), intent(in) :: a(0:)
1387
1396
character(*), intent(in) :: a_name
1388
1397
logical, intent(out) :: ltest
@@ -1398,7 +1407,7 @@ subroutine test_string_sort_index( a, a_name, ltest )
1398
1407
do i = 1, repeat
1399
1408
string_dummy = a
1400
1409
call system_clock( t0, rate )
1401
- call sort_index( string_dummy, index , string_work, iwork )
1410
+ call sort_index( string_dummy, index_${namei}$ , string_work, iwork_${namei}$ )
1402
1411
call system_clock( t1, rate )
1403
1412
tdiff = tdiff + t1 - t0
1404
1413
end do
@@ -1416,27 +1425,27 @@ subroutine test_string_sort_index( a, a_name, ltest )
1416
1425
'a12, " |", F10.6, " |" )' ) &
1417
1426
string_size, a_name, "Sort_Index", tdiff/rate
1418
1427
1419
- end subroutine test_string_sort_index
1428
+ end subroutine test_string_sort_index_${namei}$
1420
1429
1421
- subroutine test_bitsetl_sort_indexes (error )
1430
+ subroutine test_bitsetl_sort_indexes_${namei}$ (error)
1422
1431
!> Error handling
1423
1432
type(error_type), allocatable, intent(out) :: error
1424
1433
logical :: ltest
1425
1434
1426
- call test_bitsetl_sort_index ( bitsetl_decrease, " Bitset Decrease" , ltest )
1435
+ call test_bitsetl_sort_index_${namei}$ ( bitsetl_decrease, "Bitset Decrease", ltest )
1427
1436
call check(error, ltest)
1428
1437
if (allocated(error)) return
1429
1438
1430
- call test_bitsetl_sort_index ( bitsetl_increase, " Bitset Increase" , ltest )
1439
+ call test_bitsetl_sort_index_${namei}$ ( bitsetl_increase, "Bitset Increase", ltest )
1431
1440
call check(error, ltest)
1432
1441
if (allocated(error)) return
1433
1442
1434
- call test_bitsetl_sort_index ( bitsetl_rand, " Bitset Random" , ltest )
1443
+ call test_bitsetl_sort_index_${namei}$ ( bitsetl_rand, "Bitset Random", ltest )
1435
1444
call check(error, ltest)
1436
1445
1437
- end subroutine test_bitsetl_sort_indexes
1446
+ end subroutine test_bitsetl_sort_indexes_${namei}$
1438
1447
1439
- subroutine test_bitsetl_sort_index ( a , a_name , ltest )
1448
+ subroutine test_bitsetl_sort_index_${namei}$ ( a, a_name, ltest )
1440
1449
type(bitset_large), intent(in) :: a(0:)
1441
1450
character(*), intent(in) :: a_name
1442
1451
logical, intent(out) :: ltest
@@ -1453,7 +1462,7 @@ subroutine test_bitsetl_sort_index( a, a_name, ltest )
1453
1462
do i = 1, repeat
1454
1463
bitsetl_dummy = a
1455
1464
call system_clock( t0, rate )
1456
- call sort_index( bitsetl_dummy, index , bitsetl_work, iwork )
1465
+ call sort_index( bitsetl_dummy, index_${namei}$ , bitsetl_work, iwork_${namei}$ )
1457
1466
call system_clock( t1, rate )
1458
1467
tdiff = tdiff + t1 - t0
1459
1468
end do
@@ -1473,27 +1482,27 @@ subroutine test_bitsetl_sort_index( a, a_name, ltest )
1473
1482
'a12, " |", F10.6, " |" )' ) &
1474
1483
bitset_size, a_name, "Sort_Index", tdiff/rate
1475
1484
1476
- end subroutine test_bitsetl_sort_index
1485
+ end subroutine test_bitsetl_sort_index_${namei}$
1477
1486
1478
- subroutine test_bitset64_sort_indexes (error )
1487
+ subroutine test_bitset64_sort_indexes_${namei}$ (error)
1479
1488
!> Error handling
1480
1489
type(error_type), allocatable, intent(out) :: error
1481
1490
logical :: ltest
1482
1491
1483
- call test_bitset64_sort_index ( bitset64_decrease, " Bitset Decrease" , ltest )
1492
+ call test_bitset64_sort_index_${namei}$ ( bitset64_decrease, "Bitset Decrease", ltest )
1484
1493
call check(error, ltest)
1485
1494
if (allocated(error)) return
1486
1495
1487
- call test_bitset64_sort_index ( bitset64_increase, " Bitset Increase" , ltest )
1496
+ call test_bitset64_sort_index_${namei}$ ( bitset64_increase, "Bitset Increase", ltest )
1488
1497
call check(error, ltest)
1489
1498
if (allocated(error)) return
1490
1499
1491
- call test_bitset64_sort_index ( bitset64_rand, " Bitset Random" , ltest )
1500
+ call test_bitset64_sort_index_${namei}$ ( bitset64_rand, "Bitset Random", ltest )
1492
1501
call check(error, ltest)
1493
1502
1494
- end subroutine test_bitset64_sort_indexes
1503
+ end subroutine test_bitset64_sort_indexes_${namei}$
1495
1504
1496
- subroutine test_bitset64_sort_index ( a , a_name , ltest )
1505
+ subroutine test_bitset64_sort_index_${namei}$ ( a, a_name, ltest )
1497
1506
type(bitset_64), intent(in) :: a(0:)
1498
1507
character(*), intent(in) :: a_name
1499
1508
logical, intent(out) :: ltest
@@ -1510,7 +1519,7 @@ subroutine test_bitset64_sort_index( a, a_name, ltest )
1510
1519
do i = 1, repeat
1511
1520
bitset64_dummy = a
1512
1521
call system_clock( t0, rate )
1513
- call sort_index( bitset64_dummy, index , bitset64_work, iwork )
1522
+ call sort_index( bitset64_dummy, index_${namei}$ , bitset64_work, iwork_${namei}$ )
1514
1523
call system_clock( t1, rate )
1515
1524
tdiff = tdiff + t1 - t0
1516
1525
end do
@@ -1530,7 +1539,8 @@ subroutine test_bitset64_sort_index( a, a_name, ltest )
1530
1539
'a12, " |", F10.6, " |" )' ) &
1531
1540
bitset_size, a_name, "Sort_Index", tdiff/rate
1532
1541
1533
- end subroutine test_bitset64_sort_index
1542
+ end subroutine test_bitset64_sort_index_${namei}$
1543
+ #:endfor
1534
1544
1535
1545
subroutine verify_sort( a, valid, i )
1536
1546
integer(int32), intent(in) :: a(0:)
0 commit comments