diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 451c6f5b91..bfc0d7715d 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -191,6 +191,33 @@ subroutine parse_cpp_condition(lower_line, line, preprocess, is_active, macro_na macro_name = trim(adjustl(line(start_pos:end_pos))) is_active = macro_in_list(macro_name, preprocess%macros) end if + elseif (index(lower_line, '#elif') == 1) then + ! #elif defined(MACRO) or #elif !defined(MACRO) + if (index(lower_line, 'defined(') > 0) then + start_pos = index(lower_line, 'defined(') + 8 + end_pos = index(lower_line(start_pos:), ')') - 1 + + start_pos = start_pos + heading_blanks + end_pos = end_pos + heading_blanks + + if (end_pos > 0) then + macro_name = line(start_pos:start_pos + end_pos - 1) + if (index(lower_line, '!defined(') > 0) then + is_active = .not. macro_in_list(macro_name, preprocess%macros) + else + is_active = macro_in_list(macro_name, preprocess%macros) + end if + else + is_active = .false. + macro_name = "" + end if + else + ! simple form: #elif MACRO + start_pos = 6 + heading_blanks ! skip "#elif " + end_pos = len_trim(lower_line) + heading_blanks + macro_name = trim(adjustl(line(start_pos:end_pos))) + is_active = macro_in_list(macro_name, preprocess%macros) + end if else is_active = .false. end if diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90 index 36ccda4913..2586feb063 100644 --- a/test/fpm_test/test_source_parsing.f90 +++ b/test/fpm_test/test_source_parsing.f90 @@ -51,6 +51,9 @@ subroutine collect_source_parsing(testsuite) test_invalid_submodule, should_fail=.true.), & & new_unittest("use-statement",test_use_statement), & & new_unittest("conditional-compilation", test_conditional_compilation), & + & new_unittest("conditional-compilation-elif", test_conditional_compilation_elif), & + & new_unittest("conditional-compilation-elif-else", test_conditional_compilation_elif_else), & + & new_unittest("conditional-compilation_ifdef_else", test_conditional_compilation_ifdef_else), & & new_unittest("conditional-if-defined", test_conditional_if_defined) & ] @@ -1361,6 +1364,242 @@ subroutine test_conditional_compilation(error) end if end subroutine test_conditional_compilation + !> Test conditional compilation parsing with CPP preprocessing + subroutine test_conditional_compilation_elif(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(srcfile_t) :: f_source + character(:), allocatable :: temp_file + integer :: unit + type(preprocess_config_t) :: cpp_config + + ! Test 1: Without preprocessing, should include dependencies from #ifdef blocks + temp_file = get_temp_filename() + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + 'module test_mod', & + '#ifdef SOME_FEATURE', & + ' use nonexistent_module', & + '#elif defined(ANOTHER_FEATURE)', & + ' use another_nonexistent_module', & + '#endif', & + ' implicit none', & + 'contains', & + ' subroutine test_sub()', & + ' print *, "test"', & + ' end subroutine', & + 'end module test_mod' + close(unit) + + ! Parse without preprocessing - should detect the use statement + f_source = parse_f_source(temp_file, error) + if (allocated(error)) return + + if (size(f_source%modules_used) /= 2) then + call test_failed(error, 'Expected 2 module dependency without preprocessing, got different count') + return + end if + + if (f_source%modules_used(1)%s /= 'nonexistent_module') then + call test_failed(error, 'Expected nonexistent_module, got: '//f_source%modules_used(1)%s) + return + end if + + if (f_source%modules_used(2)%s /= 'another_nonexistent_module') then + call test_failed(error, 'Expected another_nonexistent_module, got: '//f_source%modules_used(2)%s) + return + end if + + ! Test 2: With preprocessing enabled, should skip dependencies from #ifdef blocks + call cpp_config%new([string_t::]) + cpp_config%name = "cpp" + + f_source = parse_f_source(temp_file, error, preprocess=cpp_config) + if (allocated(error)) return + + if (size(f_source%modules_used) /= 0) then + call test_failed(error, 'Expected 0 module dependencies with preprocessing, got some dependencies') + return + end if + + if (f_source%unit_type /= FPM_UNIT_MODULE) then + call test_failed(error, 'Expected module unit type') + return + end if + + if (size(f_source%modules_provided) /= 1) then + call test_failed(error, 'Expected 1 provided module') + return + end if + + if (f_source%modules_provided(1)%s /= 'test_mod') then + call test_failed(error, 'Expected test_mod, got: '//f_source%modules_provided(1)%s) + return + end if + + end subroutine test_conditional_compilation_elif + !> Test conditional compilation parsing with CPP preprocessing + subroutine test_conditional_compilation_elif_else(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(srcfile_t) :: f_source + character(:), allocatable :: temp_file + integer :: unit + type(preprocess_config_t) :: cpp_config + + ! Test 1: Without preprocessing, should include dependencies from #ifdef blocks + temp_file = get_temp_filename() + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + 'module test_mod', & + '#ifdef SOME_FEATURE', & + ' use nonexistent_module', & + '#elif defined(ANOTHER_FEATURE)', & + ' use another_nonexistent_module', & + '#else',& + ' use a_third_module',& + '#endif', & + ' implicit none', & + 'contains', & + ' subroutine test_sub()', & + ' print *, "test"', & + ' end subroutine', & + 'end module test_mod' + close(unit) + + ! Parse without preprocessing - should detect the use statement + f_source = parse_f_source(temp_file, error) + if (allocated(error)) return + + if (size(f_source%modules_used) /= 3) then + call test_failed(error, 'Expected 3 module dependency without preprocessing, got different count') + return + end if + + if (f_source%modules_used(1)%s /= 'nonexistent_module') then + call test_failed(error, 'Expected nonexistent_module, got: '//f_source%modules_used(1)%s) + return + end if + if (f_source%modules_used(2)%s /= 'another_nonexistent_module') then + call test_failed(error, 'Expected another_nonexistent_module, got: '//f_source%modules_used(2)%s) + return + end if + if (f_source%modules_used(3)%s /= 'a_third_module') then + call test_failed(error, 'Expected a_third_module, got: '//f_source%modules_used(3)%s) + return + end if + + ! Test 2: With preprocessing enabled, should skip dependencies from #ifdef blocks + call cpp_config%new([string_t::]) + cpp_config%name = "cpp" + + f_source = parse_f_source(temp_file, error, preprocess=cpp_config) + if (allocated(error)) return + + if (size(f_source%modules_used) /= 1) then + call test_failed(error, 'Expected 1 module dependencies with preprocessing, got some dependencies') + return + end if + + if (f_source%unit_type /= FPM_UNIT_MODULE) then + call test_failed(error, 'Expected module unit type') + return + end if + + if (size(f_source%modules_provided) /= 1) then + call test_failed(error, 'Expected 1 provided module') + return + end if + + if (f_source%modules_provided(1)%s /= 'test_mod') then + call test_failed(error, 'Expected test_mod, got: '//f_source%modules_provided(1)%s) + return + end if + + end subroutine test_conditional_compilation_elif_else + + subroutine test_conditional_compilation_ifdef_else(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(srcfile_t) :: f_source + character(:), allocatable :: temp_file + integer :: unit + type(preprocess_config_t) :: cpp_config + + ! Test 1: Without preprocessing, should include dependencies from #ifdef blocks + temp_file = get_temp_filename() + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + 'module test_mod', & + '#ifdef SOME_FEATURE', & + ' use nonexistent_module', & + '#else',& + ' use a_second_module',& + '#endif', & + ' implicit none', & + 'contains', & + ' subroutine test_sub()', & + ' print *, "test"', & + ' end subroutine', & + 'end module test_mod' + close(unit) + + ! Parse without preprocessing - should detect the use statement + f_source = parse_f_source(temp_file, error) + if (allocated(error)) return + + if (size(f_source%modules_used) /= 2) then + call test_failed(error, 'Expected 2 module dependency without preprocessing, got different count') + return + end if + + if (f_source%modules_used(1)%s /= 'nonexistent_module') then + call test_failed(error, 'Expected nonexistent_module, got: '//f_source%modules_used(1)%s) + return + end if + + if (f_source%modules_used(2)%s /= 'a_second_module') then + call test_failed(error, 'Expected a_second_module, got: '//f_source%modules_used(2)%s) + return + end if + + ! Test 2: With preprocessing enabled, should skip dependencies from #ifdef blocks + call cpp_config%new([string_t::]) + cpp_config%name = "cpp" + + f_source = parse_f_source(temp_file, error, preprocess=cpp_config) + if (allocated(error)) return + + if (size(f_source%modules_used) /= 1) then + call test_failed(error, 'Expected 1 module dependencies with preprocessing, got some dependencies') + return + end if + + if (f_source%unit_type /= FPM_UNIT_MODULE) then + call test_failed(error, 'Expected module unit type') + return + end if + + if (size(f_source%modules_provided) /= 1) then + call test_failed(error, 'Expected 1 provided module') + return + end if + + if (f_source%modules_provided(1)%s /= 'test_mod') then + call test_failed(error, 'Expected test_mod, got: '//f_source%modules_provided(1)%s) + return + end if + + end subroutine test_conditional_compilation_ifdef_else !> Test conditional compilation parsing with #if defined() syntax subroutine test_conditional_if_defined(error)