1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
module test_path
use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test
use stdlib_system, only: join_path, operator(/), split_path, OS_TYPE, OS_WINDOWS
implicit none
contains
!> Collect all exported unit tests
subroutine collect_suite(testsuite)
!> Collection of tests
type(unittest_type), allocatable, intent(out) :: testsuite(:)
testsuite = [ &
new_unittest('test_join_path', test_join_path), &
new_unittest('test_join_path_operator', test_join_path_op), &
new_unittest('test_split_path', test_split_path) &
]
end subroutine collect_suite
subroutine checkpath(error, funcname, expected, got)
type(error_type), allocatable, intent(out) :: error
character(len=*), intent(in) :: funcname
character(len=*), intent(in) :: expected
character(len=:), allocatable :: got
character(len=:), allocatable :: message
message = "'"//funcname//"'"//" error: Expected '"// expected // "' but got '" // got // "'"
call check(error, expected == got, message)
end subroutine checkpath
subroutine test_join_path(error)
type(error_type), allocatable, intent(out) :: error
character(len=:), allocatable :: path
character(len=20) :: paths(5)
if (OS_TYPE() == OS_WINDOWS) then
path = join_path('C:\Users', 'Alice')
call checkpath(error, 'join_path', 'C:\Users\Alice', path)
if (allocated(error)) return
paths = [character(20) :: 'C:','Users','Bob','Pictures','2025']
path = join_path(paths)
call checkpath(error, 'join_path', 'C:\Users\Bob\Pictures\2025', path)
if (allocated(error)) return
path = join_path('"C:\Users\John Doe"', 'Pictures\2025') ! path with spaces
call checkpath(error, 'join_path', '"C:\Users\John Doe"\Pictures\2025', path)
if (allocated(error)) return
else
path = join_path('/home', 'Alice')
call checkpath(error, 'join_path', '/home/Alice', path)
if (allocated(error)) return
paths = [character(20) :: '','home','Bob','Pictures','2025']
path = join_path(paths)
call checkpath(error, 'join_path', '/home/Bob/Pictures/2025', path)
if (allocated(error)) return
end if
end subroutine test_join_path
!> Test the operator
subroutine test_join_path_op(error)
type(error_type), allocatable, intent(out) :: error
character(len=:), allocatable :: path
if (OS_TYPE() == OS_WINDOWS) then
path = 'C:'/'Users'/'Alice'/'Desktop'
call checkpath(error, 'join_path operator', 'C:\Users\Alice\Desktop', path)
if (allocated(error)) return
else
path = ''/'home'/'Alice'/'.config'
call checkpath(error, 'join_path operator', '/home/Alice/.config', path)
if (allocated(error)) return
end if
end subroutine test_join_path_op
subroutine test_split_path(error)
type(error_type), allocatable, intent(out) :: error
character(len=:), allocatable :: head, tail
call split_path('', head, tail)
call checkpath(error, 'split_path-head', '.', head)
if (allocated(error)) return
call checkpath(error, 'split_path-tail', '', tail)
if (allocated(error)) return
if (OS_TYPE() == OS_WINDOWS) then
call split_path('\\\\', head, tail)
call checkpath(error, 'split_path-head', '\', head)
if (allocated(error)) return
call checkpath(error, 'split_path-tail', '', tail)
if (allocated(error)) return
call split_path('C:\', head, tail)
call checkpath(error, 'split_path-head', 'C:\', head)
if (allocated(error)) return
call checkpath(error, 'split_path-tail', '', tail)
if (allocated(error)) return
call split_path('C:\Users\Alice\\\\\', head, tail)
call checkpath(error, 'split_path-head', 'C:\Users', head)
if (allocated(error)) return
call checkpath(error, 'split_path-tail', 'Alice', tail)
if (allocated(error)) return
else
call split_path('/////', head, tail)
call checkpath(error, 'split_path-head', '/', head)
if (allocated(error)) return
call checkpath(error, 'split_path-tail', '', tail)
if (allocated(error)) return
call split_path('/home/Alice/foo/bar.f90///', head, tail)
call checkpath(error, 'split_path-head', '/home/Alice/foo', head)
if (allocated(error)) return
call checkpath(error, 'split_path-tail', 'bar.f90', tail)
if (allocated(error)) return
end if
end subroutine test_split_path
end module test_path
program tester
use, intrinsic :: iso_fortran_env, only : error_unit
use testdrive, only : run_testsuite, new_testsuite, testsuite_type
use test_path, only : collect_suite
implicit none
integer :: stat, is
type(testsuite_type), allocatable :: testsuites(:)
character(len=*), parameter :: fmt = '("#", *(1x, a))'
stat = 0
testsuites = [ &
new_testsuite("path", collect_suite) &
]
do is = 1, size(testsuites)
write(error_unit, fmt) "Testing:", testsuites(is)%name
call run_testsuite(testsuites(is)%collect, error_unit, stat)
end do
if (stat > 0) then
write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
error stop
end if
end program tester
|
