Skip to content

Commit b80ce7c

Browse files
committed
add Windows, UNIX command tests
1 parent fd1c609 commit b80ce7c

File tree

2 files changed

+71
-3
lines changed

2 files changed

+71
-3
lines changed

test/fpm_test/test_backend.f90

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ module test_backend
88
add_target, add_dependency
99
use fpm_backend, only: sort_target, schedule_targets
1010
use fpm_strings, only: string_t
11+
use fpm_environment, only: OS_LINUX
1112
use fpm_compile_commands, only: compile_command_t, compile_command_table_t
1213
implicit none
1314
private
@@ -433,7 +434,7 @@ subroutine compile_commands_register_from_string(error)
433434
character(len=*), parameter :: cmd_line = "gfortran -c example.f90 -o example.o"
434435

435436
! Register a raw command line string
436-
call table%register(cmd_line, error)
437+
call table%register(cmd_line, OS_LINUX, error)
437438
if (allocated(error)) return
438439

439440
if (.not.allocated(table%command)) then

test/fpm_test/test_compiler.f90

Lines changed: 69 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4,8 +4,9 @@ module test_compiler
44
& check_string
55
use fpm_environment, only : OS_WINDOWS, OS_LINUX
66
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(==)
88
use fpm_command_line, only: get_fpm_env
9+
use fpm_compile_commands, only: compile_command_table_t
910
implicit none
1011
private
1112

@@ -21,7 +22,9 @@ subroutine collect_compiler(testsuite)
2122

2223
testsuite = [ &
2324
& 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)]
2528

2629
end subroutine collect_compiler
2730

@@ -127,4 +130,68 @@ subroutine test_tokenize_flags(error)
127130

128131
end subroutine test_tokenize_flags
129132

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+
130197
end module test_compiler

0 commit comments

Comments
 (0)