Use shlex for compiler flags

Author: krystophny

src/fpm_compiler.F90

@@ -39,12 +39,15 @@ module fpm_compiler
         OS_UNKNOWN
 use fpm_filesystem, only: join_path, basename, get_temp_filename, delete_file, unix_path, &
     & getline, run
-use fpm_strings, only: split, string_cat, string_t, str_ends_with, str_begins_with_str
+use fpm_strings, only: split, string_cat, string_t, str_ends_with, str_begins_with_str, &
+    & string_array_contains
 use fpm_manifest, only : package_config_t
 use fpm_error, only: error_t, fatal_error
 use fpm_toml, only: serializable_t, toml_table, set_string, set_value, toml_stat, get_value
+use shlex_module, only: shlex_split => split
 implicit none
 public :: compiler_t, new_compiler, archiver_t, new_archiver, get_macros
+public :: append_clean_flags, append_clean_flags_array
 public :: debug
 
 enum, bind(C)
@@ -1071,17 +1074,17 @@ subroutine new_archiver(self, ar, echo, verbose)
         ! Attempt "ar"
         call execute_command_line("ar --version > "//get_temp_filename()//" 2>&1", &
           & exitstat=estat)
-          
-        if (estat == 0) then 
-            
+
+        if (estat == 0) then
+
             self%ar = "ar"//arflags
-            
+
         else
-            
+
             ! Then "gcc-ar"
             call execute_command_line("gcc-ar --version > "//get_temp_filename()//" 2>&1", &
-               & exitstat=estat)            
-            
+               & exitstat=estat)
+
             if (estat /= 0) then
               self%ar = "lib"//libflags
             else
@@ -1440,38 +1443,38 @@ end function compiler_name
 logical function check_fortran_source_runs(self, input) result(success)
     !> Instance of the compiler object
     class(compiler_t), intent(in) :: self
-    !> Program Source 
+    !> Program Source
     character(len=*), intent(in) :: input
-    
+
     integer :: stat,unit
     character(:), allocatable :: source,object,logf,exe
-    
+
     success = .false.
-   
+
     !> Create temporary source file
     exe    = get_temp_filename()
     source = exe//'.f90'
     object = exe//'.o'
     logf   = exe//'.log'
     open(newunit=unit, file=source, action='readwrite', iostat=stat)
     if (stat/=0) return
-   
+
     !> Write contents
     write(unit,*) input
-    close(unit)  
-    
-    !> Compile and link program 
+    close(unit)
+
+    !> Compile and link program
     call self%compile_fortran(source, object, self%get_default_flags(release=.false.), logf, stat)
     if (stat==0) &
     call self%link(exe, self%get_default_flags(release=.false.)//" "//object, logf, stat)
-        
-    !> Run and retrieve exit code 
+
+    !> Run and retrieve exit code
     if (stat==0) &
     call run(exe,echo=.false., exitstat=stat, verbose=.false., redirect=logf)
-    
+
     !> Successful exit on 0 exit code
     success = stat==0
-    
+
     !> Delete files
     open(newunit=unit, file=source, action='readwrite', iostat=stat)
     close(unit,status='delete')
@@ -1481,23 +1484,76 @@ logical function check_fortran_source_runs(self, input) result(success)
     close(unit,status='delete')
     open(newunit=unit, file=exe, action='readwrite', iostat=stat)
     close(unit,status='delete')
-            
+
 end function check_fortran_source_runs
 
-!> Check if the current compiler supports 128-bit real precision 
+!> Check if the current compiler supports 128-bit real precision
 logical function with_qp(self)
     !> Instance of the compiler object
     class(compiler_t), intent(in) :: self
     with_qp = self%check_fortran_source_runs &
               ('if (selected_real_kind(33) == -1) stop 1; end')
 end function with_qp
 
-!> Check if the current compiler supports 80-bit "extended" real precision 
+!> Check if the current compiler supports 80-bit "extended" real precision
 logical function with_xdp(self)
     !> Instance of the compiler object
     class(compiler_t), intent(in) :: self
     with_xdp = self%check_fortran_source_runs &
                ('if (any(selected_real_kind(18) == [-1, selected_real_kind(33)])) stop 1; end')
 end function with_xdp
 
+!> Append new flags to existing flags, removing duplicates and empty flags (string version)
+subroutine append_clean_flags(flags, new_flags)
+    character(:), intent(inout), allocatable :: flags
+    character(*), intent(in) :: new_flags
+
+    type(string_t), allocatable :: flags_array(:), new_flags_array(:)
+    integer :: i
+
+    call tokenize_flags(flags, flags_array)
+    call tokenize_flags(new_flags, new_flags_array)
+
+    call append_clean_flags_array(flags_array, new_flags_array)
+
+    do i = 1, size(flags_array)
+        flags = flags // " " // flags_array(i)%s
+    end do
+end subroutine append_clean_flags
+
+!> Append new flags to existing flags, removing duplicates and empty flags (array version)
+subroutine append_clean_flags_array(flags_array, new_flags_array)
+    type(string_t), allocatable, intent(inout) :: flags_array(:)
+    type(string_t), intent(in) :: new_flags_array(:)
+
+    integer :: i
+
+    do i = 1, size(new_flags_array)
+        if (string_array_contains(new_flags_array(i)%s, flags_array)) cycle
+        ! Filter out empty flags and arguments
+        if (new_flags_array(i)%s == "") cycle
+        if (trim(new_flags_array(i)%s) == "-l") cycle
+        if (trim(new_flags_array(i)%s) == "-L") cycle
+        if (trim(new_flags_array(i)%s) == "-I") cycle
+        if (trim(new_flags_array(i)%s) == "-J") cycle
+        if (trim(new_flags_array(i)%s) == "-M") cycle
+        flags_array = [flags_array, new_flags_array(i)]
+    end do
+end subroutine append_clean_flags_array
+
+!> Tokenize a string into an array of compiler flags
+subroutine tokenize_flags(flags, flags_array)
+    character(*), intent(in) :: flags
+    type(string_t), allocatable, intent(out) :: flags_array(:)
+    character(len=:), allocatable :: flags_char_array(:)
+
+    integer :: i
+
+    flags_char_array = shlex_split(flags)
+    allocate(flags_array(size(flags_char_array)))
+    do i = 1, size(flags_char_array)
+        flags_array(i)%s = trim(adjustl(flags_char_array(i)))
+    end do
+end subroutine tokenize_flags
+
 end module fpm_compiler

src/metapackage/fpm_meta_base.f90

@@ -6,6 +6,7 @@ module fpm_meta_base
     use fpm_manifest_dependency, only: dependency_config_t
     use fpm_manifest, only: package_config_t
     use fpm_strings, only: string_t, len_trim, split, join
+    use fpm_compiler, only: append_clean_flags, append_clean_flags_array
 
     implicit none
 
@@ -111,30 +112,30 @@ subroutine resolve_model(self,model,error)
 
         ! Add global build flags, to apply to all sources
         if (self%has_build_flags) then
-            call append_flags_without_duplicates(model%fortran_compile_flags, self%flags%s)
-            call append_flags_without_duplicates(model%c_compile_flags, self%flags%s)
-            call append_flags_without_duplicates(model%cxx_compile_flags, self%flags%s)
+            call append_clean_flags(model%fortran_compile_flags, self%flags%s)
+            call append_clean_flags(model%c_compile_flags, self%flags%s)
+            call append_clean_flags(model%cxx_compile_flags, self%flags%s)
         endif
 
         ! Add language-specific flags
-        if (self%has_fortran_flags) call append_flags_without_duplicates(model%fortran_compile_flags, self%fflags%s)
-        if (self%has_c_flags)       call append_flags_without_duplicates(model%c_compile_flags, self%cflags%s)
-        if (self%has_cxx_flags)     call append_flags_without_duplicates(model%cxx_compile_flags, self%cxxflags%s)
+        if (self%has_fortran_flags) call append_clean_flags(model%fortran_compile_flags, self%fflags%s)
+        if (self%has_c_flags)       call append_clean_flags(model%c_compile_flags, self%cflags%s)
+        if (self%has_cxx_flags)     call append_clean_flags(model%cxx_compile_flags, self%cxxflags%s)
 
         if (self%has_link_flags) then
-            call append_flags_without_duplicates(model%link_flags, self%link_flags%s)
+            call append_clean_flags(model%link_flags, self%link_flags%s)
         end if
 
         if (self%has_link_libraries) then
-            call append_array_without_duplicates(model%link_libraries, self%link_libs)
+            call append_clean_flags_array(model%link_libraries, self%link_libs)
         end if
 
         if (self%has_include_dirs) then
-            call append_array_without_duplicates(model%include_dirs, self%incl_dirs)
+            call append_clean_flags_array(model%include_dirs, self%incl_dirs)
         end if
 
         if (self%has_external_modules) then
-            call append_array_without_duplicates(model%external_modules, self%external_modules)
+            call append_clean_flags_array(model%external_modules, self%external_modules)
         end if
 
     end subroutine resolve_model
@@ -187,70 +188,4 @@ end function dn
 
     end subroutine resolve_package_config
 
-    subroutine append_flags_without_duplicates(flags, new_flags)
-        character(:), intent(inout), allocatable :: flags
-        character(*), intent(in) :: new_flags
-
-        character(len=:), allocatable :: flags_array(:), new_flags_array(:)
-        type(string_t), allocatable :: flags_str_array(:), new_flags_str_array(:)
-        integer :: i, max_len
-
-        call split(flags, flags_array, " ")
-        call split(new_flags, new_flags_array, " ")
-
-        allocate(flags_str_array(size(flags_array, 1)))
-        allocate(new_flags_str_array(size(new_flags_array, 1)))
-        do i = 1, size(flags_array)
-            flags_str_array(i) = string_t(flags_array(i))
-        end do
-        do i = 1, size(new_flags_array)
-            new_flags_str_array(i) = string_t(new_flags_array(i))
-        end do
-
-        call append_array_without_duplicates(flags_str_array, new_flags_str_array)
-
-        max_len = 0
-        do i = 1, size(flags_str_array)
-            max_len = max(max_len, len_trim(flags_str_array(i)%s))
-        end do
-        deallocate(flags_array)
-        allocate(character(len=max_len) :: flags_array(size(flags_str_array)))
-        do i = 1, size(flags_str_array)
-            flags_array(i) = flags_str_array(i)%s
-        end do
-
-        flags = join(flags_array, " ")
-
-    end subroutine append_flags_without_duplicates
-
-    subroutine append_array_without_duplicates(str_array, new_elements)
-        type(string_t), allocatable, intent(inout) :: str_array(:)
-        type(string_t), intent(in) :: new_elements(:)
-        integer :: i
-
-        do i = 1, size(new_elements)
-            if (contains_element(str_array, new_elements(i))) cycle
-            ! Filter out empty flags
-            if (new_elements(i)%s == "") cycle
-            if (new_elements(i)%s == "-l") cycle
-            if (new_elements(i)%s == "-L") cycle
-            if (new_elements(i)%s == "-I") cycle
-            if (new_elements(i)%s == "-J") cycle
-            str_array = [str_array, new_elements(i)]
-        end do
-    end subroutine append_array_without_duplicates
-
-    function contains_element(str_array, element)
-        logical :: contains_element
-        type(string_t), intent(in) :: str_array(:), element
-        integer :: i
-
-        contains_element = .false.
-        do i = 1, size(str_array)
-            if (str_array(i)%s == element%s) then
-                contains_element = .true.
-                exit
-            end if
-        end do
-    end function contains_element
 end module fpm_meta_base