@@ -4,8 +4,9 @@ module test_compiler
4
4
& check_string
5
5
use fpm_environment, only : OS_WINDOWS, OS_LINUX
6
6
use fpm_compiler , only : compiler_t, new_compiler, tokenize_flags
7
- use fpm_strings , only : string_t
7
+ use fpm_strings , only : string_t, operator (==)
8
8
use fpm_command_line, only: get_fpm_env
9
+ use fpm_compile_commands, only: compile_command_table_t
9
10
implicit none
10
11
private
11
12
@@ -21,7 +22,9 @@ subroutine collect_compiler(testsuite)
21
22
22
23
testsuite = [ &
23
24
& new_unittest(" check-fortran-source-runs" , test_check_fortran_source_runs), &
24
- & new_unittest(" tokenize-flags" , test_tokenize_flags)]
25
+ & new_unittest(" tokenize-flags" , test_tokenize_flags), &
26
+ & new_unittest(" compile-commands-unix" , test_register_compile_command_unix), &
27
+ & new_unittest(" compile-commands-windows" , test_register_compile_command_windows)]
25
28
26
29
end subroutine collect_compiler
27
30
@@ -127,4 +130,68 @@ subroutine test_tokenize_flags(error)
127
130
128
131
end subroutine test_tokenize_flags
129
132
133
+ subroutine test_register_compile_command_unix (error )
134
+ type (error_t), allocatable , intent (out ) :: error
135
+
136
+ type (compile_command_table_t) :: table
137
+ type (string_t), allocatable :: expected(:)
138
+ integer :: i
139
+
140
+ call table% register(' gfortran -c -I/usr/include -O2 -Wall main.f90' , OS_LINUX, error)
141
+ if (allocated (error)) return
142
+
143
+ if (size (table% command) /= 1 ) then
144
+ call test_failed(error, " Expected 1 command registered" )
145
+ return
146
+ end if
147
+
148
+ associate(c = > table% command(1 ))
149
+ ! Expect these arguments in order
150
+ expected = [ string_t(' gfortran' ), string_t(' -c' ), &
151
+ string_t(' -I/usr/include' ), string_t(' -O2' ), &
152
+ string_t(' -Wall' ), string_t(' main.f90' ) ]
153
+
154
+ if (.not. c% arguments == expected) then
155
+ do i = 1 , size (c% arguments)
156
+ print * , " Argument" , i, " :" , c% arguments(i)% s
157
+ end do
158
+ call test_failed(error, " Unix compile command arguments did not match expected tokens" )
159
+ return
160
+ end if
161
+ end associate
162
+ end subroutine test_register_compile_command_unix
163
+
164
+ subroutine test_register_compile_command_windows (error )
165
+ type (error_t), allocatable , intent (out ) :: error
166
+
167
+ type (compile_command_table_t) :: table
168
+ type (string_t), allocatable :: expected(:)
169
+ integer :: i
170
+
171
+ call table% register(' ifort /c /I"C:\Program Files\Libs" /O2 /W4 main.f90' , OS_WINDOWS, error)
172
+ if (allocated (error)) return
173
+
174
+ if (size (table% command) /= 1 ) then
175
+ call test_failed(error, " Expected 1 command registered" )
176
+ return
177
+ end if
178
+
179
+ associate(c = > table% command(1 ))
180
+ ! Expected Windows-style tokens
181
+ expected = [ string_t(' ifort' ), string_t(' /c' ), &
182
+ string_t(' /IC:\Program Files\Libs' ), string_t(' /O2' ), &
183
+ string_t(' /W4' ), string_t(' main.f90' ) ]
184
+
185
+ if (.not. c% arguments == expected) then
186
+ do i = 1 , size (c% arguments)
187
+ print * , " Argument" , i, " :" , c% arguments(i)% s
188
+ end do
189
+ call test_failed(error, " Windows compile command arguments did not match expected tokens" )
190
+ return
191
+ end if
192
+ end associate
193
+ end subroutine test_register_compile_command_windows
194
+
195
+
196
+
130
197
end module test_compiler
0 commit comments