From 436573bc4d110d7a9881d4dd3ae1d56ac99d9144 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 31 Oct 2020 12:04:01 +0000 Subject: Refactor fpm_sources: separate out parsing routines --- fpm/src/fpm_source_parsing.f90 | 425 +++++++++++++++++++++++++++++ fpm/src/fpm_sources.f90 | 426 +----------------------------- fpm/test/fpm_test/test_source_parsing.f90 | 2 +- 3 files changed, 433 insertions(+), 420 deletions(-) create mode 100644 fpm/src/fpm_source_parsing.f90 diff --git a/fpm/src/fpm_source_parsing.f90 b/fpm/src/fpm_source_parsing.f90 new file mode 100644 index 0000000..abbe716 --- /dev/null +++ b/fpm/src/fpm_source_parsing.f90 @@ -0,0 +1,425 @@ +module fpm_source_parsing +use fpm_error, only: error_t, file_parse_error +use fpm_model, only: srcfile_t, & + FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & + FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & + FPM_UNIT_CSOURCE, FPM_UNIT_CHEADER + +use fpm_filesystem, only: basename, read_lines +use fpm_strings, only: lower, split, str_ends_with, string_t +implicit none + +private +public :: parse_source, parse_f_source, parse_c_source + +character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & + ['iso_c_binding ', & + 'iso_fortran_env', & + 'ieee_arithmetic', & + 'ieee_exceptions', & + 'ieee_features '] + +contains + +function parse_source(source_file_path,error) result(source) + character(*), intent(in) :: source_file_path + type(error_t), allocatable, intent(out) :: error + type(srcfile_t) :: source + + if (str_ends_with(lower(source_file_path), ".f90")) then + + source = parse_f_source(source_file_path, error) + + if (source%unit_type == FPM_UNIT_PROGRAM) then + source%exe_name = basename(source_file_path,suffix=.false.) + end if + + else if (str_ends_with(lower(source_file_path), ".c") .or. & + str_ends_with(lower(source_file_path), ".h")) then + + source = parse_c_source(source_file_path,error) + + end if + + if (allocated(error)) then + return + end if + +end function parse_source + +function parse_f_source(f_filename,error) result(f_source) + ! Rudimentary scan of Fortran source file and + ! extract program unit name and use/include dependencies + ! + character(*), intent(in) :: f_filename + type(srcfile_t) :: f_source + type(error_t), allocatable, intent(out) :: error + + integer :: stat + integer :: fh, n_use, n_include, n_mod, i, j, ic, pass + type(string_t), allocatable :: file_lines(:) + character(:), allocatable :: temp_string, mod_name + + f_source%file_name = f_filename + + open(newunit=fh,file=f_filename,status='old') + file_lines = read_lines(fh) + close(fh) + + do pass = 1,2 + n_use = 0 + n_include = 0 + n_mod = 0 + file_loop: do i=1,size(file_lines) + + ! Skip lines that are continued: not statements + if (i > 1) then + ic = index(file_lines(i-1)%s,'!') + if (ic < 1) then + ic = len(file_lines(i-1)%s) + end if + temp_string = trim(file_lines(i-1)%s(1:ic)) + if (len(temp_string) > 0 .and. index(temp_string,'&') == len(temp_string)) then + cycle + end if + end if + + ! Process 'USE' statements + if (index(adjustl(lower(file_lines(i)%s)),'use ') == 1 .or. & + index(adjustl(lower(file_lines(i)%s)),'use::') == 1) then + + if (index(file_lines(i)%s,'::') > 0) then + + temp_string = split_n(file_lines(i)%s,delims=':',n=2,stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find used module name',i, & + file_lines(i)%s,index(file_lines(i)%s,'::')) + return + end if + + mod_name = split_n(temp_string,delims=' ,',n=1,stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find used module name',i, & + file_lines(i)%s) + return + end if + mod_name = lower(mod_name) + + else + + mod_name = split_n(file_lines(i)%s,n=2,delims=' ,',stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find used module name',i, & + file_lines(i)%s) + return + end if + mod_name = lower(mod_name) + + end if + + if (.not.validate_name(mod_name)) then + cycle + end if + + if (any([(index(mod_name,trim(INTRINSIC_MODULE_NAMES(j)))>0, & + j=1,size(INTRINSIC_MODULE_NAMES))])) then + cycle + end if + + n_use = n_use + 1 + + if (pass == 2) then + + f_source%modules_used(n_use)%s = mod_name + + end if + + end if + + ! Process 'INCLUDE' statements + ic = index(adjustl(lower(file_lines(i)%s)),'include') + if ( ic == 1 ) then + ic = index(lower(file_lines(i)%s),'include') + if (index(adjustl(file_lines(i)%s(ic+7:)),'"') == 1 .or. & + index(adjustl(file_lines(i)%s(ic+7:)),"'") == 1 ) then + + + n_include = n_include + 1 + + if (pass == 2) then + f_source%include_dependencies(n_include)%s = & + & split_n(file_lines(i)%s,n=2,delims="'"//'"',stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find include file name',i, & + file_lines(i)%s) + return + end if + end if + end if + end if + + ! Extract name of module if is module + if (index(adjustl(lower(file_lines(i)%s)),'module ') == 1) then + + mod_name = lower(split_n(file_lines(i)%s,n=2,delims=' ',stat=stat)) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find module name',i, & + file_lines(i)%s) + return + end if + + if (mod_name == 'procedure' .or. & + mod_name == 'subroutine' .or. & + mod_name == 'function') then + ! Ignore these cases + cycle + end if + + if (.not.validate_name(mod_name)) then + call file_parse_error(error,f_filename, & + 'empty or invalid name for module',i, & + file_lines(i)%s, index(file_lines(i)%s,mod_name)) + return + end if + + n_mod = n_mod + 1 + + if (pass == 2) then + f_source%modules_provided(n_mod) = string_t(mod_name) + end if + + f_source%unit_type = FPM_UNIT_MODULE + + end if + + ! Extract name of submodule if is submodule + if (index(adjustl(lower(file_lines(i)%s)),'submodule') == 1) then + + mod_name = split_n(file_lines(i)%s,n=3,delims='()',stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to get submodule name',i, & + file_lines(i)%s) + return + end if + if (.not.validate_name(mod_name)) then + call file_parse_error(error,f_filename, & + 'empty or invalid name for submodule',i, & + file_lines(i)%s, index(file_lines(i)%s,mod_name)) + return + end if + + n_mod = n_mod + 1 + + temp_string = split_n(file_lines(i)%s,n=2,delims='()',stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to get submodule ancestry',i, & + file_lines(i)%s) + return + end if + + f_source%unit_type = FPM_UNIT_SUBMODULE + + n_use = n_use + 1 + + if (pass == 2) then + + if (index(temp_string,':') > 0) then + + temp_string = temp_string(index(temp_string,':')+1:) + + end if + + if (.not.validate_name(temp_string)) then + call file_parse_error(error,f_filename, & + 'empty or invalid name for submodule parent',i, & + file_lines(i)%s, index(file_lines(i)%s,temp_string)) + return + end if + + f_source%modules_used(n_use)%s = lower(temp_string) + + f_source%modules_provided(n_mod)%s = lower(mod_name) + + end if + + end if + + ! Detect if contains a program + ! (no modules allowed after program def) + if (index(adjustl(lower(file_lines(i)%s)),'program') == 1) then + + f_source%unit_type = FPM_UNIT_PROGRAM + + end if + + end do file_loop + + ! Default to subprogram unit type + if (f_source%unit_type == FPM_UNIT_UNKNOWN) then + f_source%unit_type = FPM_UNIT_SUBPROGRAM + end if + + if (pass == 1) then + allocate(f_source%modules_used(n_use)) + allocate(f_source%include_dependencies(n_include)) + allocate(f_source%modules_provided(n_mod)) + end if + + end do + + contains + + function validate_name(name) result(valid) + character(*), intent(in) :: name + logical :: valid + + integer :: i + + if (len_trim(name) < 1) then + valid = .false. + return + end if + + if (lower(name(1:1)) < 'a' .or. & + lower(name(1:1)) > 'z') then + + valid = .false. + return + end if + + do i=1,len(name) + + if (.not.( & + (name(i:i) >= '0' .and. name(i:i) <= '9').or. & + (lower(name(i:i)) >= 'a' .and. lower(name(i:i)) <= 'z').or. & + name(i:i) == '_') ) then + + valid = .false. + return + end if + + end do + + valid = .true. + return + + end function validate_name + +end function parse_f_source + + +function parse_c_source(c_filename,error) result(c_source) + ! Rudimentary scan of c source file and + ! extract include dependencies + ! + character(*), intent(in) :: c_filename + type(srcfile_t) :: c_source + type(error_t), allocatable, intent(out) :: error + + integer :: fh, n_include, i, pass, stat + type(string_t), allocatable :: file_lines(:) + + c_source%file_name = c_filename + + if (str_ends_with(lower(c_filename), ".c")) then + + c_source%unit_type = FPM_UNIT_CSOURCE + + elseif (str_ends_with(lower(c_filename), ".h")) then + + c_source%unit_type = FPM_UNIT_CHEADER + + end if + + allocate(c_source%modules_used(0)) + allocate(c_source%modules_provided(0)) + + open(newunit=fh,file=c_filename,status='old') + file_lines = read_lines(fh) + close(fh) + + do pass = 1,2 + n_include = 0 + file_loop: do i=1,size(file_lines) + + ! Process 'INCLUDE' statements + if (index(adjustl(lower(file_lines(i)%s)),'#include') == 1 .and. & + index(file_lines(i)%s,'"') > 0) then + + n_include = n_include + 1 + + if (pass == 2) then + + c_source%include_dependencies(n_include)%s = & + & split_n(file_lines(i)%s,n=2,delims='"',stat=stat) + if (stat /= 0) then + call file_parse_error(error,c_filename, & + 'unable to get c include file',i, & + file_lines(i)%s,index(file_lines(i)%s,'"')) + return + end if + + end if + + end if + + end do file_loop + + if (pass == 1) then + allocate(c_source%include_dependencies(n_include)) + end if + + end do + +end function parse_c_source + + +function split_n(string,delims,n,stat) result(substring) + ! Split a string on one or more delimeters + ! and return the nth substring if it exists + ! + ! n=0 will return the last item + ! n=-1 will return the penultimate item etc. + ! + ! stat = 1 on return if the index + ! is not found + ! + character(*), intent(in) :: string + character(*), intent(in) :: delims + integer, intent(in) :: n + integer, intent(out) :: stat + character(:), allocatable :: substring + + integer :: i + character(:), allocatable :: string_parts(:) + + call split(string,string_parts,delims) + + if (n<1) then + i = size(string_parts) + n + if (i < 1) then + stat = 1 + return + end if + else + i = n + end if + + if (i>size(string_parts)) then + stat = 1 + return + end if + + substring = trim(adjustl(string_parts(i))) + stat = 0 + +end function split_n + +end module fpm_source_parsing \ No newline at end of file diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index 393c799..6ad8815 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -1,56 +1,20 @@ module fpm_sources -use fpm_error, only: error_t, file_parse_error, fatal_error -use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t, & - FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & - FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & - FPM_UNIT_CSOURCE, FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, & +use fpm_error, only: error_t, fatal_error +use fpm_model, only: srcfile_ptr, srcfile_t, & + FPM_UNIT_PROGRAM, & FPM_SCOPE_LIB, FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST -use fpm_filesystem, only: basename, canon_path, dirname, join_path, read_lines, list_files -use fpm_strings, only: lower, split, str_ends_with, string_t, operator(.in.) +use fpm_filesystem, only: basename, canon_path, dirname, join_path, list_files +use fpm_strings, only: lower, str_ends_with, string_t, operator(.in.) use fpm_manifest_executable, only: executable_t +use fpm_source_parsing, only: parse_source implicit none private -public :: add_sources_from_dir, add_executable_sources -public :: parse_f_source, parse_c_source, resolve_module_dependencies - -character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & - ['iso_c_binding ', & - 'iso_fortran_env', & - 'ieee_arithmetic', & - 'ieee_exceptions', & - 'ieee_features '] +public :: add_sources_from_dir, add_executable_sources, resolve_module_dependencies contains -function parse_source(source_file_path,error) result(source) - character(*), intent(in) :: source_file_path - type(error_t), allocatable, intent(out) :: error - type(srcfile_t) :: source - - if (str_ends_with(lower(source_file_path), ".f90")) then - - source = parse_f_source(source_file_path, error) - - if (source%unit_type == FPM_UNIT_PROGRAM) then - source%exe_name = basename(source_file_path,suffix=.false.) - end if - - else if (str_ends_with(lower(source_file_path), ".c") .or. & - str_ends_with(lower(source_file_path), ".h")) then - - source = parse_c_source(source_file_path,error) - - end if - - if (allocated(error)) then - return - end if - -end function parse_source - - subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) ! Enumerate sources in a directory ! @@ -207,382 +171,6 @@ subroutine get_executable_source_dirs(exe_dirs,executables) end subroutine get_executable_source_dirs -function parse_f_source(f_filename,error) result(f_source) - ! Rudimentary scan of Fortran source file and - ! extract program unit name and use/include dependencies - ! - character(*), intent(in) :: f_filename - type(srcfile_t) :: f_source - type(error_t), allocatable, intent(out) :: error - - integer :: stat - integer :: fh, n_use, n_include, n_mod, i, j, ic, pass - type(string_t), allocatable :: file_lines(:) - character(:), allocatable :: temp_string, mod_name - - f_source%file_name = f_filename - - open(newunit=fh,file=f_filename,status='old') - file_lines = read_lines(fh) - close(fh) - - do pass = 1,2 - n_use = 0 - n_include = 0 - n_mod = 0 - file_loop: do i=1,size(file_lines) - - ! Skip lines that are continued: not statements - if (i > 1) then - ic = index(file_lines(i-1)%s,'!') - if (ic < 1) then - ic = len(file_lines(i-1)%s) - end if - temp_string = trim(file_lines(i-1)%s(1:ic)) - if (len(temp_string) > 0 .and. index(temp_string,'&') == len(temp_string)) then - cycle - end if - end if - - ! Process 'USE' statements - if (index(adjustl(lower(file_lines(i)%s)),'use ') == 1 .or. & - index(adjustl(lower(file_lines(i)%s)),'use::') == 1) then - - if (index(file_lines(i)%s,'::') > 0) then - - temp_string = split_n(file_lines(i)%s,delims=':',n=2,stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to find used module name',i, & - file_lines(i)%s,index(file_lines(i)%s,'::')) - return - end if - - mod_name = split_n(temp_string,delims=' ,',n=1,stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to find used module name',i, & - file_lines(i)%s) - return - end if - mod_name = lower(mod_name) - - else - - mod_name = split_n(file_lines(i)%s,n=2,delims=' ,',stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to find used module name',i, & - file_lines(i)%s) - return - end if - mod_name = lower(mod_name) - - end if - - if (.not.validate_name(mod_name)) then - cycle - end if - - if (any([(index(mod_name,trim(INTRINSIC_MODULE_NAMES(j)))>0, & - j=1,size(INTRINSIC_MODULE_NAMES))])) then - cycle - end if - - n_use = n_use + 1 - - if (pass == 2) then - - f_source%modules_used(n_use)%s = mod_name - - end if - - end if - - ! Process 'INCLUDE' statements - ic = index(adjustl(lower(file_lines(i)%s)),'include') - if ( ic == 1 ) then - ic = index(lower(file_lines(i)%s),'include') - if (index(adjustl(file_lines(i)%s(ic+7:)),'"') == 1 .or. & - index(adjustl(file_lines(i)%s(ic+7:)),"'") == 1 ) then - - - n_include = n_include + 1 - - if (pass == 2) then - f_source%include_dependencies(n_include)%s = & - & split_n(file_lines(i)%s,n=2,delims="'"//'"',stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to find include file name',i, & - file_lines(i)%s) - return - end if - end if - end if - end if - - ! Extract name of module if is module - if (index(adjustl(lower(file_lines(i)%s)),'module ') == 1) then - - mod_name = lower(split_n(file_lines(i)%s,n=2,delims=' ',stat=stat)) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to find module name',i, & - file_lines(i)%s) - return - end if - - if (mod_name == 'procedure' .or. & - mod_name == 'subroutine' .or. & - mod_name == 'function') then - ! Ignore these cases - cycle - end if - - if (.not.validate_name(mod_name)) then - call file_parse_error(error,f_filename, & - 'empty or invalid name for module',i, & - file_lines(i)%s, index(file_lines(i)%s,mod_name)) - return - end if - - n_mod = n_mod + 1 - - if (pass == 2) then - f_source%modules_provided(n_mod) = string_t(mod_name) - end if - - f_source%unit_type = FPM_UNIT_MODULE - - end if - - ! Extract name of submodule if is submodule - if (index(adjustl(lower(file_lines(i)%s)),'submodule') == 1) then - - mod_name = split_n(file_lines(i)%s,n=3,delims='()',stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to get submodule name',i, & - file_lines(i)%s) - return - end if - if (.not.validate_name(mod_name)) then - call file_parse_error(error,f_filename, & - 'empty or invalid name for submodule',i, & - file_lines(i)%s, index(file_lines(i)%s,mod_name)) - return - end if - - n_mod = n_mod + 1 - - temp_string = split_n(file_lines(i)%s,n=2,delims='()',stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to get submodule ancestry',i, & - file_lines(i)%s) - return - end if - - f_source%unit_type = FPM_UNIT_SUBMODULE - - n_use = n_use + 1 - - if (pass == 2) then - - if (index(temp_string,':') > 0) then - - temp_string = temp_string(index(temp_string,':')+1:) - - end if - - if (.not.validate_name(temp_string)) then - call file_parse_error(error,f_filename, & - 'empty or invalid name for submodule parent',i, & - file_lines(i)%s, index(file_lines(i)%s,temp_string)) - return - end if - - f_source%modules_used(n_use)%s = lower(temp_string) - - f_source%modules_provided(n_mod)%s = lower(mod_name) - - end if - - end if - - ! Detect if contains a program - ! (no modules allowed after program def) - if (index(adjustl(lower(file_lines(i)%s)),'program') == 1) then - - f_source%unit_type = FPM_UNIT_PROGRAM - - end if - - end do file_loop - - ! Default to subprogram unit type - if (f_source%unit_type == FPM_UNIT_UNKNOWN) then - f_source%unit_type = FPM_UNIT_SUBPROGRAM - end if - - if (pass == 1) then - allocate(f_source%modules_used(n_use)) - allocate(f_source%include_dependencies(n_include)) - allocate(f_source%modules_provided(n_mod)) - end if - - end do - - contains - - function validate_name(name) result(valid) - character(*), intent(in) :: name - logical :: valid - - integer :: i - - if (len_trim(name) < 1) then - valid = .false. - return - end if - - if (lower(name(1:1)) < 'a' .or. & - lower(name(1:1)) > 'z') then - - valid = .false. - return - end if - - do i=1,len(name) - - if (.not.( & - (name(i:i) >= '0' .and. name(i:i) <= '9').or. & - (lower(name(i:i)) >= 'a' .and. lower(name(i:i)) <= 'z').or. & - name(i:i) == '_') ) then - - valid = .false. - return - end if - - end do - - valid = .true. - return - - end function validate_name - -end function parse_f_source - - -function parse_c_source(c_filename,error) result(c_source) - ! Rudimentary scan of c source file and - ! extract include dependencies - ! - character(*), intent(in) :: c_filename - type(srcfile_t) :: c_source - type(error_t), allocatable, intent(out) :: error - - integer :: fh, n_include, i, pass, stat - type(string_t), allocatable :: file_lines(:) - - c_source%file_name = c_filename - - if (str_ends_with(lower(c_filename), ".c")) then - - c_source%unit_type = FPM_UNIT_CSOURCE - - elseif (str_ends_with(lower(c_filename), ".h")) then - - c_source%unit_type = FPM_UNIT_CHEADER - - end if - - allocate(c_source%modules_used(0)) - allocate(c_source%modules_provided(0)) - - open(newunit=fh,file=c_filename,status='old') - file_lines = read_lines(fh) - close(fh) - - do pass = 1,2 - n_include = 0 - file_loop: do i=1,size(file_lines) - - ! Process 'INCLUDE' statements - if (index(adjustl(lower(file_lines(i)%s)),'#include') == 1 .and. & - index(file_lines(i)%s,'"') > 0) then - - n_include = n_include + 1 - - if (pass == 2) then - - c_source%include_dependencies(n_include)%s = & - & split_n(file_lines(i)%s,n=2,delims='"',stat=stat) - if (stat /= 0) then - call file_parse_error(error,c_filename, & - 'unable to get c include file',i, & - file_lines(i)%s,index(file_lines(i)%s,'"')) - return - end if - - end if - - end if - - end do file_loop - - if (pass == 1) then - allocate(c_source%include_dependencies(n_include)) - end if - - end do - -end function parse_c_source - - -function split_n(string,delims,n,stat) result(substring) - ! Split a string on one or more delimeters - ! and return the nth substring if it exists - ! - ! n=0 will return the last item - ! n=-1 will return the penultimate item etc. - ! - ! stat = 1 on return if the index - ! is not found - ! - character(*), intent(in) :: string - character(*), intent(in) :: delims - integer, intent(in) :: n - integer, intent(out) :: stat - character(:), allocatable :: substring - - integer :: i - character(:), allocatable :: string_parts(:) - - call split(string,string_parts,delims) - - if (n<1) then - i = size(string_parts) + n - if (i < 1) then - stat = 1 - return - end if - else - i = n - end if - - if (i>size(string_parts)) then - stat = 1 - return - end if - - substring = trim(adjustl(string_parts(i))) - stat = 0 - -end function split_n - - subroutine resolve_module_dependencies(sources,error) ! After enumerating all source files: resolve file dependencies ! by searching on module names diff --git a/fpm/test/fpm_test/test_source_parsing.f90 b/fpm/test/fpm_test/test_source_parsing.f90 index d1d3e12..4463c07 100644 --- a/fpm/test/fpm_test/test_source_parsing.f90 +++ b/fpm/test/fpm_test/test_source_parsing.f90 @@ -2,7 +2,7 @@ module test_source_parsing use testsuite, only : new_unittest, unittest_t, error_t, test_failed use fpm_filesystem, only: get_temp_filename - use fpm_sources, only: parse_f_source, parse_c_source + use fpm_source_parsing, only: parse_f_source, parse_c_source use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE use fpm_strings, only: operator(.in.) -- cgit v1.2.3 From 8096ba728f770fb0eb9fcea863d5177bb294770f Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 1 Nov 2020 09:16:52 +0000 Subject: Intermediate: separate out build targets from sources A new module and type for build targets. List of build targets is generated from the list of sources. --- fpm/src/fpm.f90 | 28 ++- fpm/src/fpm_backend.f90 | 166 ++++++------- fpm/src/fpm_model.f90 | 36 ++- fpm/src/fpm_sources.f90 | 105 +-------- fpm/src/fpm_targets.f90 | 220 +++++++++++++++++ fpm/test/fpm_test/test_module_dependencies.f90 | 315 +++++++++++++++++-------- 6 files changed, 549 insertions(+), 321 deletions(-) create mode 100644 fpm/src/fpm_targets.f90 diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 575b654..571eb10 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -5,12 +5,12 @@ use fpm_command_line, only: fpm_build_settings, fpm_new_settings, & fpm_run_settings, fpm_install_settings, fpm_test_settings use fpm_environment, only: run use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename -use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t, & +use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, & FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST -use fpm_sources, only: add_executable_sources, add_sources_from_dir, & - resolve_module_dependencies +use fpm_sources, only: add_executable_sources, add_sources_from_dir +use fpm_targets, only: targets_from_sources, resolve_module_dependencies use fpm_manifest, only : get_package_data, default_executable, & default_library, package_t, default_test use fpm_error, only : error_t, fatal_error @@ -150,6 +150,7 @@ subroutine build_model(model, settings, package, error) type(error_t), allocatable, intent(out) :: error integer :: i + type(srcfile_t), allocatable :: sources(:) type(string_t), allocatable :: package_list(:) model%package_name = package%name @@ -180,7 +181,7 @@ subroutine build_model(model, settings, package, error) ! Add sources from executable directories if (is_dir('app') .and. package%build_config%auto_executables) then - call add_sources_from_dir(model%sources,'app', FPM_SCOPE_APP, & + call add_sources_from_dir(sources,'app', FPM_SCOPE_APP, & with_executables=.true., error=error) if (allocated(error)) then @@ -189,7 +190,7 @@ subroutine build_model(model, settings, package, error) end if if (is_dir('test') .and. package%build_config%auto_tests) then - call add_sources_from_dir(model%sources,'test', FPM_SCOPE_TEST, & + call add_sources_from_dir(sources,'test', FPM_SCOPE_TEST, & with_executables=.true., error=error) if (allocated(error)) then @@ -198,7 +199,7 @@ subroutine build_model(model, settings, package, error) end if if (allocated(package%executable)) then - call add_executable_sources(model%sources, package%executable, FPM_SCOPE_APP, & + call add_executable_sources(sources, package%executable, FPM_SCOPE_APP, & auto_discover=package%build_config%auto_executables, & error=error) @@ -208,7 +209,7 @@ subroutine build_model(model, settings, package, error) end if if (allocated(package%test)) then - call add_executable_sources(model%sources, package%test, FPM_SCOPE_TEST, & + call add_executable_sources(sources, package%test, FPM_SCOPE_TEST, & auto_discover=package%build_config%auto_tests, & error=error) @@ -219,20 +220,23 @@ subroutine build_model(model, settings, package, error) endif ! Add library sources, including local dependencies - call add_libsources_from_package(model%sources,package_list,package, & + call add_libsources_from_package(sources,package_list,package, & package_root='.',dev_depends=.true.,error=error) if (allocated(error)) then return end if if(settings%list)then - do i=1,size(model%sources) - write(stderr,'(*(g0,1x))')'fpm::build:file expected at',model%sources(i)%file_name, & - & merge('exists ','does not exist',exists(model%sources(i)%file_name) ) + do i=1,size(sources) + write(stderr,'(*(g0,1x))')'fpm::build:file expected at',sources(i)%file_name, & + & merge('exists ','does not exist',exists(sources(i)%file_name) ) enddo stop else - call resolve_module_dependencies(model%sources,error) + + call targets_from_sources(model%targets,sources,model%package_name) + + call resolve_module_dependencies(model%targets,error) endif end subroutine build_model diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index d7005bf..2706b79 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -7,7 +7,7 @@ use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir use fpm_model, only: fpm_model_t, srcfile_t, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM, & - FPM_SCOPE_TEST + FPM_SCOPE_TEST, build_target_t use fpm_strings, only: split @@ -22,137 +22,107 @@ contains subroutine build_package(model) type(fpm_model_t), intent(inout) :: model - integer :: i - character(:), allocatable :: base, linking, subdir + ! integer :: i + ! character(:), allocatable :: base, linking, subdir - if (.not.exists(model%output_directory)) then - call mkdir(model%output_directory) - end if - if (.not.exists(join_path(model%output_directory,model%package_name))) then - call mkdir(join_path(model%output_directory,model%package_name)) - end if + ! if (.not.exists(model%output_directory)) then + ! call mkdir(model%output_directory) + ! end if + ! if (.not.exists(join_path(model%output_directory,model%package_name))) then + ! call mkdir(join_path(model%output_directory,model%package_name)) + ! end if - linking = "" - do i=1,size(model%sources) + ! linking = "" + ! do i=1,size(model%targets) - if (model%sources(i)%unit_type == FPM_UNIT_MODULE .or. & - model%sources(i)%unit_type == FPM_UNIT_SUBMODULE .or. & - model%sources(i)%unit_type == FPM_UNIT_SUBPROGRAM .or. & - model%sources(i)%unit_type == FPM_UNIT_CSOURCE) then + ! ! if (model%sources(i)%unit_type == FPM_UNIT_MODULE .or. & + ! ! model%sources(i)%unit_type == FPM_UNIT_SUBMODULE .or. & + ! ! model%sources(i)%unit_type == FPM_UNIT_SUBPROGRAM .or. & + ! ! model%sources(i)%unit_type == FPM_UNIT_CSOURCE) then - call build_source(model,model%sources(i),linking) + ! call build_source(model,model%sources(i),linking) - end if + ! ! end if - end do + ! end do - if (any([(model%sources(i)%unit_type == FPM_UNIT_PROGRAM,i=1,size(model%sources))])) then - if (.not.exists(join_path(model%output_directory,'test'))) then - call mkdir(join_path(model%output_directory,'test')) - end if - if (.not.exists(join_path(model%output_directory,'app'))) then - call mkdir(join_path(model%output_directory,'app')) - end if - end if + ! if (any([(model%sources(i)%unit_type == FPM_UNIT_PROGRAM,i=1,size(model%sources))])) then + ! if (.not.exists(join_path(model%output_directory,'test'))) then + ! call mkdir(join_path(model%output_directory,'test')) + ! end if + ! if (.not.exists(join_path(model%output_directory,'app'))) then + ! call mkdir(join_path(model%output_directory,'app')) + ! end if + ! end if - do i=1,size(model%sources) + ! do i=1,size(model%sources) - if (model%sources(i)%unit_type == FPM_UNIT_PROGRAM) then + ! if (model%sources(i)%unit_type == FPM_UNIT_PROGRAM) then - base = basename(model%sources(i)%file_name,suffix=.false.) + ! base = basename(model%sources(i)%file_name,suffix=.false.) - if (model%sources(i)%unit_scope == FPM_SCOPE_TEST) then - subdir = 'test' - else - subdir = 'app' - end if + ! if (model%sources(i)%unit_scope == FPM_SCOPE_TEST) then + ! subdir = 'test' + ! else + ! subdir = 'app' + ! end if - call run("gfortran -c " // model%sources(i)%file_name // ' '//model%fortran_compile_flags & - // " -o " // join_path(model%output_directory,subdir,base) // ".o") + ! call run("gfortran -c " // model%sources(i)%file_name // ' '//model%fortran_compile_flags & + ! // " -o " // join_path(model%output_directory,subdir,base) // ".o") - call run("gfortran " // join_path(model%output_directory, subdir, base) // ".o "// & - linking //" " //model%link_flags // " -o " // & - join_path(model%output_directory,subdir,model%sources(i)%exe_name) ) + ! call run("gfortran " // join_path(model%output_directory, subdir, base) // ".o "// & + ! linking //" " //model%link_flags // " -o " // & + ! join_path(model%output_directory,subdir,model%sources(i)%exe_name) ) - end if + ! end if - end do + ! end do end subroutine build_package -recursive subroutine build_source(model,source_file,linking) +recursive subroutine build_target(model,target,linking) ! Compile Fortran source, called recursively on it dependents ! type(fpm_model_t), intent(in) :: model - type(srcfile_t), intent(inout) :: source_file + type(build_target_t), intent(inout) :: target character(:), allocatable, intent(inout) :: linking - integer :: i - character(:), allocatable :: object_file + ! integer :: i + ! character(:), allocatable :: object_file - if (source_file%built) then - return - end if + ! if (source_file%built) then + ! return + ! end if - if (source_file%touched) then - write(*,*) '(!) Circular dependency found with: ',source_file%file_name - stop - else - source_file%touched = .true. - end if + ! if (source_file%touched) then + ! write(*,*) '(!) Circular dependency found with: ',source_file%file_name + ! stop + ! else + ! source_file%touched = .true. + ! end if - do i=1,size(source_file%file_dependencies) + ! do i=1,size(source_file%file_dependencies) - if (associated(source_file%file_dependencies(i)%ptr)) then - call build_source(model,source_file%file_dependencies(i)%ptr,linking) - end if + ! if (associated(source_file%file_dependencies(i)%ptr)) then + ! call build_source(model,source_file%file_dependencies(i)%ptr,linking) + ! end if - end do + ! end do - object_file = get_object_name(model,source_file%file_name) + ! object_file = get_object_name(model,source_file%file_name) - if (.not.exists(dirname(object_file))) then - call mkdir(dirname(object_file)) - end if + ! if (.not.exists(dirname(object_file))) then + ! call mkdir(dirname(object_file)) + ! end if - call run("gfortran -c " // source_file%file_name // model%fortran_compile_flags & - // " -o " // object_file) - linking = linking // " " // object_file + ! call run("gfortran -c " // source_file%file_name // model%fortran_compile_flags & + ! // " -o " // object_file) + ! linking = linking // " " // object_file - source_file%built = .true. + ! source_file%built = .true. -end subroutine build_source - - -function get_object_name(model,source_file_name) result(object_file) - ! Generate object target path from source name and model params - ! - ! src/test.f90 -> //test.o - ! src/subdir/test.f90 -> //subdir_test.o - ! - type(fpm_model_t), intent(in) :: model - character(*), intent(in) :: source_file_name - character(:), allocatable :: object_file - - integer :: i - character(1) :: filesep - - select case(get_os_type()) - case (OS_WINDOWS) - filesep = '\' - case default - filesep = '/' - end select - - ! Exclude first directory level from path - object_file = source_file_name(index(source_file_name,filesep)+1:) - - ! Construct full target path - object_file = join_path(model%output_directory, model%package_name, & - object_file//'.o') - -end function get_object_name +end subroutine build_target end module fpm_backend diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 36086df..44b7d39 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -4,12 +4,14 @@ use fpm_strings, only: string_t implicit none private -public :: srcfile_ptr, srcfile_t, fpm_model_t +public :: fpm_model_t, srcfile_t, build_target_t, build_target_ptr public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, & - FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST + FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST, & + FPM_TARGET_UNKNOWN, FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE, & + FPM_TARGET_OBJECT integer, parameter :: FPM_UNIT_UNKNOWN = -1 integer, parameter :: FPM_UNIT_PROGRAM = 1 @@ -25,10 +27,10 @@ integer, parameter :: FPM_SCOPE_DEP = 2 integer, parameter :: FPM_SCOPE_APP = 3 integer, parameter :: FPM_SCOPE_TEST = 4 -type srcfile_ptr - ! For constructing arrays of src_file pointers - type(srcfile_t), pointer :: ptr => null() -end type srcfile_ptr +integer, parameter :: FPM_TARGET_UNKNOWN = -1 +integer, parameter :: FPM_TARGET_EXECUTABLE = 1 +integer, parameter :: FPM_TARGET_ARCHIVE = 2 +integer, parameter :: FPM_TARGET_OBJECT = 3 type srcfile_t ! Type for encapsulating a source file @@ -49,17 +51,31 @@ type srcfile_t ! Modules USEd by this source file (lowerstring) type(string_t), allocatable :: include_dependencies(:) ! Files INCLUDEd by this source file - type(srcfile_ptr), allocatable :: file_dependencies(:) - ! Resolved source file dependencies +end type srcfile_t + +type build_target_ptr + ! For constructing arrays of build_target_t pointers + type(build_target_t), pointer :: ptr => null() +end type build_target_ptr + +type build_target_t + character(:), allocatable :: output_file + ! File path of build target object relative to cwd + type(srcfile_t), allocatable :: source + ! Primary source for this build target + type(build_target_ptr), allocatable :: dependencies(:) + ! Resolved build dependencies + integer :: target_type = FPM_TARGET_UNKNOWN logical :: built = .false. logical :: touched = .false. -end type srcfile_t + +end type build_target_t type :: fpm_model_t character(:), allocatable :: package_name ! Name of package - type(srcfile_t), allocatable :: sources(:) + type(build_target_ptr), allocatable :: targets(:) ! Array of sources with module-dependencies resolved character(:), allocatable :: fortran_compiler ! Command line name to invoke fortran compiler diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index 6ad8815..35b769b 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -1,7 +1,6 @@ module fpm_sources use fpm_error, only: error_t, fatal_error -use fpm_model, only: srcfile_ptr, srcfile_t, & - FPM_UNIT_PROGRAM, & +use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM, & FPM_SCOPE_LIB, FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST use fpm_filesystem, only: basename, canon_path, dirname, join_path, list_files @@ -11,7 +10,7 @@ use fpm_source_parsing, only: parse_source implicit none private -public :: add_sources_from_dir, add_executable_sources, resolve_module_dependencies +public :: add_sources_from_dir, add_executable_sources contains @@ -171,104 +170,4 @@ subroutine get_executable_source_dirs(exe_dirs,executables) end subroutine get_executable_source_dirs -subroutine resolve_module_dependencies(sources,error) - ! After enumerating all source files: resolve file dependencies - ! by searching on module names - ! - type(srcfile_t), intent(inout), target :: sources(:) - type(error_t), allocatable, intent(out) :: error - - type(srcfile_ptr) :: dep - - integer :: n_depend, i, pass, j - - do i=1,size(sources) - - do pass=1,2 - - n_depend = 0 - - do j=1,size(sources(i)%modules_used) - - if (sources(i)%modules_used(j)%s .in. sources(i)%modules_provided) then - ! Dependency satisfied in same file, skip - cycle - end if - - if (sources(i)%unit_scope == FPM_SCOPE_APP .OR. & - sources(i)%unit_scope == FPM_SCOPE_TEST ) then - dep%ptr => & - find_module_dependency(sources,sources(i)%modules_used(j)%s, & - include_dir = dirname(sources(i)%file_name)) - else - dep%ptr => & - find_module_dependency(sources,sources(i)%modules_used(j)%s) - end if - - if (.not.associated(dep%ptr)) then - call fatal_error(error, & - 'Unable to find source for module dependency: "' // & - sources(i)%modules_used(j)%s // & - '" used by "'//sources(i)%file_name//'"') - return - end if - - n_depend = n_depend + 1 - - if (pass == 2) then - sources(i)%file_dependencies(n_depend) = dep - end if - - end do - - if (pass == 1) then - allocate(sources(i)%file_dependencies(n_depend)) - end if - - end do - - end do - -end subroutine resolve_module_dependencies - -function find_module_dependency(sources,module_name,include_dir) result(src_ptr) - ! Find a module dependency in the library or a dependency library - ! - ! 'include_dir' specifies an allowable non-library search directory - ! (Used for executable dependencies) - ! - type(srcfile_t), intent(in), target :: sources(:) - character(*), intent(in) :: module_name - character(*), intent(in), optional :: include_dir - type(srcfile_t), pointer :: src_ptr - - integer :: k, l - - src_ptr => NULL() - - do k=1,size(sources) - - do l=1,size(sources(k)%modules_provided) - - if (module_name == sources(k)%modules_provided(l)%s) then - select case(sources(k)%unit_scope) - case (FPM_SCOPE_LIB, FPM_SCOPE_DEP) - src_ptr => sources(k) - exit - case default - if (present(include_dir)) then - if (dirname(sources(k)%file_name) == include_dir) then - src_ptr => sources(k) - exit - end if - end if - end select - end if - - end do - - end do - -end function find_module_dependency - end module fpm_sources diff --git a/fpm/src/fpm_targets.f90 b/fpm/src/fpm_targets.f90 new file mode 100644 index 0000000..dfdc9af --- /dev/null +++ b/fpm/src/fpm_targets.f90 @@ -0,0 +1,220 @@ +module fpm_targets +use fpm_error, only: error_t, fatal_error +use fpm_model!, only: srcfile_t, build_target_t, FPM_UNIT_PROGRAM, & + ! FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE, FPM_TARGET_OBJECT +use fpm_environment, only: get_os_type, OS_WINDOWS +use fpm_filesystem, only: dirname, join_path +use fpm_strings, only: operator(.in.) +implicit none + +contains + +subroutine targets_from_sources(targets,sources,package_name) + type(build_target_ptr), allocatable, intent(out), target :: targets(:) + type(srcfile_t), intent(in) :: sources(:) + character(*), intent(in) :: package_name + + integer :: i + type(build_target_t), pointer :: dep + logical :: with_lib + + with_lib = any([(sources(i)%unit_scope == FPM_SCOPE_LIB,i=1,size(sources))]) + + if (with_lib) call add_target(targets,type = FPM_TARGET_ARCHIVE,& + output_file = package_name//'.a') + + do i=1,size(sources) + + select case (sources(i)%unit_type) + case (FPM_UNIT_MODULE,FPM_UNIT_SUBMODULE,FPM_UNIT_SUBPROGRAM,FPM_UNIT_CSOURCE) + + call add_target(targets,source = sources(i), & + type = FPM_TARGET_OBJECT,& + output_file = get_object_name(sources(i)%file_name)) + + if (with_lib .and. sources(i)%unit_scope == FPM_SCOPE_LIB) then + ! Archive depends on object + call add_dependency(targets(1)%ptr, targets(size(targets))%ptr) + end if + + case (FPM_UNIT_PROGRAM) + + call add_target(targets,type = FPM_TARGET_OBJECT,& + output_file = get_object_name(sources(i)%file_name), & + source = sources(i) & + ) + + call add_target(targets,type = FPM_TARGET_EXECUTABLE,& + output_file = join_path('app',sources(i)%exe_name)) + + + ! Executable depends on object + call add_dependency(targets(size(targets))%ptr, targets(size(targets)-1)%ptr) + + if (with_lib) then + ! Executable depends on library + call add_dependency(targets(size(targets))%ptr, targets(1)%ptr) + end if + + end select + + end do + +end subroutine targets_from_sources + + +subroutine add_target(targets,type,output_file,source) + type(build_target_ptr), allocatable, intent(inout) :: targets(:) + integer, intent(in) :: type + character(*), intent(in) :: output_file + type(srcfile_t), intent(in), optional :: source + + type(build_target_ptr), allocatable :: temp(:) + type(build_target_t), pointer :: new_target + + allocate(new_target) + new_target%target_type = type + new_target%output_file = output_file + if (present(source)) new_target%source = source + allocate(new_target%dependencies(0)) + + if (.not.allocated(targets)) allocate(targets(0)) + targets = [targets, build_target_ptr(new_target)] + +end subroutine add_target + + +subroutine add_dependency(target, dependency) + type(build_target_t), intent(inout) :: target + type(build_target_t) , intent(in), target :: dependency + + type(build_target_ptr) :: depend + + depend%ptr => dependency + + ! if (.not.allocated(target%dependencies)) then + ! allocate(target%dependencies(0)) + ! end if + + target%dependencies = [target%dependencies, depend] + ! target%dependencies(size(target%dependencies))%ptr => dependency + +end subroutine add_dependency + + +function get_object_name(source_file_name) result(object_file) + ! Generate object target path from source name and model params + ! + ! src/test.f90 -> //test.o + ! src/subdir/test.f90 -> //subdir_test.o + ! + character(*), intent(in) :: source_file_name + character(:), allocatable :: object_file + + integer :: i + character(1) :: filesep + + select case(get_os_type()) + case (OS_WINDOWS) + filesep = '\' + case default + filesep = '/' + end select + + ! Exclude first directory level from path + object_file = source_file_name(index(source_file_name,filesep)+1:)//'.o' + +end function get_object_name + + +subroutine resolve_module_dependencies(targets,error) + ! After enumerating all source files: resolve file dependencies + ! by searching on module names + ! + type(build_target_ptr), intent(inout), target :: targets(:) + type(error_t), allocatable, intent(out) :: error + + type(build_target_ptr) :: dep + + integer :: i, j + + do i=1,size(targets) + + if (.not.allocated(targets(i)%ptr%source)) cycle + + do j=1,size(targets(i)%ptr%source%modules_used) + + if (targets(i)%ptr%source%modules_used(j)%s .in. targets(i)%ptr%source%modules_provided) then + ! Dependency satisfied in same file, skip + cycle + end if + + if (targets(i)%ptr%source%unit_scope == FPM_SCOPE_APP .OR. & + targets(i)%ptr%source%unit_scope == FPM_SCOPE_TEST ) then + dep%ptr => & + find_module_dependency(targets,targets(i)%ptr%source%modules_used(j)%s, & + include_dir = dirname(targets(i)%ptr%source%file_name)) + else + dep%ptr => & + find_module_dependency(targets,targets(i)%ptr%source%modules_used(j)%s) + end if + + if (.not.associated(dep%ptr)) then + call fatal_error(error, & + 'Unable to find source for module dependency: "' // & + targets(i)%ptr%source%modules_used(j)%s // & + '" used by "'//targets(i)%ptr%source%file_name//'"') + return + end if + + call add_dependency(targets(i)%ptr, dep%ptr) + + end do + + end do + +end subroutine resolve_module_dependencies + +function find_module_dependency(targets,module_name,include_dir) result(target_ptr) + ! Find a module dependency in the library or a dependency library + ! + ! 'include_dir' specifies an allowable non-library search directory + ! (Used for executable dependencies) + ! + type(build_target_ptr), intent(in), target :: targets(:) + character(*), intent(in) :: module_name + character(*), intent(in), optional :: include_dir + type(build_target_t), pointer :: target_ptr + + integer :: k, l + + target_ptr => NULL() + + do k=1,size(targets) + + if (.not.allocated(targets(k)%ptr%source)) cycle + + do l=1,size(targets(k)%ptr%source%modules_provided) + + if (module_name == targets(k)%ptr%source%modules_provided(l)%s) then + select case(targets(k)%ptr%source%unit_scope) + case (FPM_SCOPE_LIB, FPM_SCOPE_DEP) + target_ptr => targets(k)%ptr + exit + case default + if (present(include_dir)) then + if (dirname(targets(k)%ptr%source%file_name) == include_dir) then + target_ptr => targets(k)%ptr + exit + end if + end if + end select + end if + + end do + + end do + +end function find_module_dependency + +end module fpm_targets \ No newline at end of file diff --git a/fpm/test/fpm_test/test_module_dependencies.f90 b/fpm/test/fpm_test/test_module_dependencies.f90 index 481dfb3..1292a39 100644 --- a/fpm/test/fpm_test/test_module_dependencies.f90 +++ b/fpm/test/fpm_test/test_module_dependencies.f90 @@ -1,12 +1,13 @@ !> Define tests for the `fpm_sources` module (module dependency checking) module test_module_dependencies use testsuite, only : new_unittest, unittest_t, error_t, test_failed - use fpm_sources, only: resolve_module_dependencies - use fpm_model, only: srcfile_t, srcfile_ptr, & + use fpm_targets, only: targets_from_sources, resolve_module_dependencies + use fpm_model, only: srcfile_t, build_target_t, build_target_ptr, & FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, & - FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST + FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST, & + FPM_TARGET_EXECUTABLE, FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE use fpm_strings, only: string_t implicit none private @@ -14,7 +15,7 @@ module test_module_dependencies public :: collect_module_dependencies interface operator(.in.) - module procedure srcfile_in + module procedure target_in end interface contains @@ -51,91 +52,123 @@ contains type(error_t), allocatable, intent(out) :: error type(srcfile_t) :: sources(2) + type(build_target_ptr), allocatable :: targets(:) - sources(1) = new_test_module(file_name="src/my_mod_1.f90", & + sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_1.f90", & scope = FPM_SCOPE_LIB, & provides=[string_t('my_mod_1')]) - sources(2) = new_test_module(file_name="src/my_mod_2.f90", & + sources(2) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_2.f90", & scope = FPM_SCOPE_LIB, & provides=[string_t('my_mod_2')], & uses=[string_t('my_mod_1')]) - call resolve_module_dependencies(sources,error) + call targets_from_sources(targets,sources,'test_package') + call resolve_module_dependencies(targets,error) if (allocated(error)) then return end if - if (size(sources(1)%file_dependencies)>0) then - call test_failed(error,'Incorrect number of file_dependencies - expecting zero') + if (size(targets) /= 3) then + call test_failed(error,'Incorrect number of targets - expecting three') return end if - if (size(sources(2)%file_dependencies) /= 1) then - call test_failed(error,'Incorrect number of file_dependencies - expecting one') - return - end if + call check_target(targets(1)%ptr,type=FPM_TARGET_ARCHIVE,n_depends=2, & + deps = [targets(2),targets(3)],error=error) + + if (allocated(error)) return - if (.not.(sources(1) .in. sources(2)%file_dependencies)) then - call test_failed(error,'Missing file in file_dependencies') - return - end if + + call check_target(targets(2)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, & + source=sources(1),error=error) + + if (allocated(error)) return + + + call check_target(targets(3)%ptr,type=FPM_TARGET_OBJECT,n_depends=1, & + deps=[targets(2)],source=sources(2),error=error) + + if (allocated(error)) return end subroutine test_library_module_use - !> Check program using a library module + !> Check a program using a library module + !> Each program generates two targets: object file and executable + !> subroutine test_program_module_use(error) !> Error handling type(error_t), allocatable, intent(out) :: error + call test_scope(FPM_SCOPE_APP,error) + if (allocated(error)) return + + call test_scope(FPM_SCOPE_TEST,error) + if (allocated(error)) return + + contains + + subroutine test_scope(exe_scope,error) + integer, intent(in) :: exe_scope + type(error_t), allocatable, intent(out) :: error + integer :: i type(srcfile_t) :: sources(3) + type(build_target_ptr), allocatable :: targets(:) + character(:), allocatable :: scope_str + + scope_str = merge('FPM_SCOPE_APP ','FPM_SCOPE_TEST',exe_scope==FPM_SCOPE_APP)//' - ' - sources(1) = new_test_module(file_name="src/my_mod_1.f90", & + sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_1.f90", & scope = FPM_SCOPE_LIB, & provides=[string_t('my_mod_1')]) - sources(2) = new_test_program(file_name="app/my_program.f90", & - scope=FPM_SCOPE_APP, & + sources(2) = new_test_source(FPM_UNIT_PROGRAM,file_name="app/my_program.f90", & + scope=exe_scope, & uses=[string_t('my_mod_1')]) - sources(3) = new_test_program(file_name="test/my_test.f90", & - scope=FPM_SCOPE_TEST, & - uses=[string_t('my_mod_1')]) - - call resolve_module_dependencies(sources,error) + call targets_from_sources(targets,sources,'') + call resolve_module_dependencies(targets,error) if (allocated(error)) then return end if - if (size(sources(1)%file_dependencies)>0) then - call test_failed(error,'Incorrect number of file_dependencies - expecting zero') + if (size(targets) /= 4) then + call test_failed(error,scope_str//'Incorrect number of targets - expecting three') return end if - do i=2,3 + call check_target(targets(1)%ptr,type=FPM_TARGET_ARCHIVE,n_depends=1, & + deps=[targets(2)],error=error) + + if (allocated(error)) return - if (size(sources(i)%file_dependencies) /= 1) then - call test_failed(error,'Incorrect number of file_dependencies - expecting one') - return - end if + call check_target(targets(2)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, & + source=sources(1),error=error) - if (.not.(sources(1) .in. sources(i)%file_dependencies)) then - call test_failed(error,'Missing file in file_dependencies') - return - end if + if (allocated(error)) return + + call check_target(targets(3)%ptr,type=FPM_TARGET_OBJECT,n_depends=1, & + deps=[targets(2)],source=sources(2),error=error) + + if (allocated(error)) return + + call check_target(targets(4)%ptr,type=FPM_TARGET_EXECUTABLE,n_depends=2, & + deps=[targets(1),targets(3)],error=error) + + if (allocated(error)) return + + end subroutine test_scope - end do - end subroutine test_program_module_use !> Check program with module in single source file - !> (Resulting source object should not include itself as a file dependency) + !> (Resulting target should not include itself as a dependency) subroutine test_program_with_module(error) !> Error handling @@ -143,22 +176,35 @@ contains integer :: i type(srcfile_t) :: sources(1) + type(build_target_ptr), allocatable :: targets(:) - sources(1) = new_test_module(file_name="app/my_program.f90", & + sources(1) = new_test_source(FPM_UNIT_PROGRAM,file_name="app/my_program.f90", & scope = FPM_SCOPE_APP, & provides=[string_t('app_mod')], & uses=[string_t('app_mod')]) - call resolve_module_dependencies(sources,error) + call targets_from_sources(targets,sources,'') + call resolve_module_dependencies(targets,error) if (allocated(error)) then return end if - if (size(sources(1)%file_dependencies)>0) then - call test_failed(error,'Incorrect number of file_dependencies - expecting zero') + if (size(targets) /= 2) then + write(*,*) size(targets) + call test_failed(error,'Incorrect number of targets - expecting two') return end if + + call check_target(targets(1)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, & + source=sources(1),error=error) + + if (allocated(error)) return + + call check_target(targets(2)%ptr,type=FPM_TARGET_EXECUTABLE,n_depends=1, & + deps=[targets(1)],error=error) + + if (allocated(error)) return end subroutine test_program_with_module @@ -169,37 +215,61 @@ contains !> Error handling type(error_t), allocatable, intent(out) :: error + call test_scope(FPM_SCOPE_APP,error) + if (allocated(error)) return + + call test_scope(FPM_SCOPE_TEST,error) + if (allocated(error)) return + + contains + + subroutine test_scope(exe_scope,error) + integer, intent(in) :: exe_scope + type(error_t), allocatable, intent(out) :: error + type(srcfile_t) :: sources(2) + type(build_target_ptr), allocatable :: targets(:) + character(:), allocatable :: scope_str - sources(1) = new_test_module(file_name="app/app_mod.f90", & - scope = FPM_SCOPE_APP, & + scope_str = merge('FPM_SCOPE_APP ','FPM_SCOPE_TEST',exe_scope==FPM_SCOPE_APP)//' - ' + + sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="app/app_mod.f90", & + scope = exe_scope, & provides=[string_t('app_mod')]) - sources(2) = new_test_program(file_name="app/my_program.f90", & - scope=FPM_SCOPE_APP, & + sources(2) = new_test_source(FPM_UNIT_PROGRAM,file_name="app/my_program.f90", & + scope=exe_scope, & uses=[string_t('app_mod')]) - call resolve_module_dependencies(sources,error) + call targets_from_sources(targets,sources,'') + call resolve_module_dependencies(targets,error) if (allocated(error)) then return end if - if (size(sources(1)%file_dependencies)>0) then - call test_failed(error,'Incorrect number of file_dependencies - expecting zero') + if (size(targets) /= 3) then + call test_failed(error,scope_str//'Incorrect number of targets - expecting three') return end if - if (size(sources(2)%file_dependencies) /= 1) then - call test_failed(error,'Incorrect number of file_dependencies - expecting one') - return - end if - if (.not.(sources(1) .in. sources(2)%file_dependencies)) then - call test_failed(error,'Missing file in file_dependencies') - return - end if + call check_target(targets(1)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, & + source=sources(1),error=error) + + if (allocated(error)) return + + call check_target(targets(2)%ptr,type=FPM_TARGET_OBJECT,n_depends=1, & + source=sources(2),deps=[targets(1)],error=error) + if (allocated(error)) return + + call check_target(targets(3)%ptr,type=FPM_TARGET_EXECUTABLE,n_depends=1, & + deps=[targets(2)],error=error) + + if (allocated(error)) return + + end subroutine test_scope end subroutine test_program_own_module_use @@ -210,17 +280,19 @@ contains type(error_t), allocatable, intent(out) :: error type(srcfile_t) :: sources(2) + type(build_target_ptr), allocatable :: targets(:) - sources(1) = new_test_module(file_name="src/my_mod_1.f90", & + sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_1.f90", & scope = FPM_SCOPE_LIB, & provides=[string_t('my_mod_1')]) - sources(2) = new_test_module(file_name="src/my_mod_2.f90", & + sources(2) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_2.f90", & scope = FPM_SCOPE_LIB, & provides=[string_t('my_mod_2')], & uses=[string_t('my_mod_3')]) - call resolve_module_dependencies(sources,error) + call targets_from_sources(targets,sources,'') + call resolve_module_dependencies(targets,error) end subroutine test_missing_library_use @@ -232,16 +304,18 @@ contains type(error_t), allocatable, intent(out) :: error type(srcfile_t) :: sources(2) + type(build_target_ptr), allocatable :: targets(:) - sources(1) = new_test_module(file_name="src/my_mod_1.f90", & + sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_1.f90", & scope = FPM_SCOPE_LIB, & provides=[string_t('my_mod_1')]) - sources(2) = new_test_program(file_name="app/my_program.f90", & + sources(2) = new_test_source(FPM_UNIT_PROGRAM,file_name="app/my_program.f90", & scope=FPM_SCOPE_APP, & uses=[string_t('my_mod_2')]) - call resolve_module_dependencies(sources,error) + call targets_from_sources(targets,sources,'') + call resolve_module_dependencies(targets,error) end subroutine test_missing_program_use @@ -253,17 +327,19 @@ contains type(error_t), allocatable, intent(out) :: error type(srcfile_t) :: sources(2) + type(build_target_ptr), allocatable :: targets(:) - sources(1) = new_test_module(file_name="app/app_mod.f90", & + sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="app/app_mod.f90", & scope = FPM_SCOPE_APP, & provides=[string_t('app_mod')]) - sources(2) = new_test_module(file_name="src/my_mod.f90", & + sources(2) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod.f90", & scope = FPM_SCOPE_LIB, & provides=[string_t('my_mod')], & uses=[string_t('app_mod')]) - call resolve_module_dependencies(sources,error) + call targets_from_sources(targets,sources,'') + call resolve_module_dependencies(targets,error) end subroutine test_invalid_library_use @@ -275,22 +351,25 @@ contains type(error_t), allocatable, intent(out) :: error type(srcfile_t) :: sources(2) + type(build_target_ptr), allocatable :: targets(:) - sources(1) = new_test_module(file_name="app/subdir/app_mod.f90", & + sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="app/subdir/app_mod.f90", & scope = FPM_SCOPE_APP, & provides=[string_t('app_mod')]) - sources(2) = new_test_program(file_name="app/my_program.f90", & + sources(2) = new_test_source(FPM_UNIT_PROGRAM,file_name="app/my_program.f90", & scope=FPM_SCOPE_APP, & uses=[string_t('app_mod')]) - call resolve_module_dependencies(sources,error) + call targets_from_sources(targets,sources,'') + call resolve_module_dependencies(targets,error) end subroutine test_invalid_own_module_use - !> Helper to create a new srcfile_t for a module - function new_test_module(file_name, scope, uses, provides) result(src) + !> Helper to create a new srcfile_t + function new_test_source(type,file_name, scope, uses, provides) result(src) + integer, intent(in) :: type character(*), intent(in) :: file_name integer, intent(in) :: scope type(string_t), intent(in), optional :: uses(:) @@ -299,7 +378,7 @@ contains src%file_name = file_name src%unit_scope = scope - src%unit_type = FPM_UNIT_MODULE + src%unit_type = type if (present(provides)) then src%modules_provided = provides @@ -315,49 +394,89 @@ contains allocate(src%include_dependencies(0)) - end function new_test_module + end function new_test_source - !> Helper to create a new srcfile_t for a program - function new_test_program(file_name, scope, uses) result(src) - character(*), intent(in) :: file_name - integer, intent(in) :: scope - type(string_t), intent(in), optional :: uses(:) - type(srcfile_t) :: src + !> Helper to check an expected output target + subroutine check_target(target,type,n_depends,deps,source,error) + type(build_target_t), intent(in) :: target + integer, intent(in) :: type + integer, intent(in) :: n_depends + type(srcfile_t), intent(in), optional :: source + type(build_target_ptr), intent(in), optional :: deps(:) + type(error_t), intent(out), allocatable :: error - src%file_name = file_name - src%unit_scope = scope - src%unit_type = FPM_UNIT_PROGRAM + integer :: i - if (present(uses)) then - src%modules_used = uses - else - allocate(src%modules_used(0)) + if (target%target_type /= type) then + call test_failed(error,'Unexpected target_type for target "'//target%output_file//'"') + return end if - allocate(src%modules_provided(0)) - allocate(src%include_dependencies(0)) + if (size(target%dependencies) /= n_depends) then + call test_failed(error,'Wrong number of dependencies for target "'//target%output_file//'"') + return + end if + + if (present(deps)) then - end function new_test_program + do i=1,size(deps) + if (.not.(deps(i)%ptr .in. target%dependencies)) then + call test_failed(error,'Missing dependency ('//deps(i)%ptr%output_file//& + ') for target "'//target%output_file//'"') + return + end if + + end do + + end if - !> Helper to check if a srcfile is in a list of srcfile_ptr - logical function srcfile_in(needle,haystack) - type(srcfile_t), intent(in), target :: needle - type(srcfile_ptr), intent(in) :: haystack(:) + if (present(source)) then + + if (allocated(target%source)) then + if (target%source%file_name /= source%file_name) then + call test_failed(error,'Incorrect source ('//target%source%file_name//') for target "'//& + target%output_file//'"'//new_line('a')//' expected "'//source%file_name//'"') + return + end if + + else + call test_failed(error,'Expecting source for target "'//target%output_file//'" but none found') + return + end if + + else + + if (allocated(target%source)) then + call test_failed(error,'Found source ('//target%source%file_name//') for target "'//& + target%output_file//'" but none expected') + return + end if + + end if + + end subroutine check_target + + + !> Helper to check if a build target is in a list of build_target_ptr + logical function target_in(needle,haystack) + type(build_target_t), intent(in), target :: needle + type(build_target_ptr), intent(in) :: haystack(:) integer :: i - srcfile_in = .false. + target_in = .false. do i=1,size(haystack) if (associated(haystack(i)%ptr,needle)) then - srcfile_in = .true. + target_in = .true. return end if end do - end function srcfile_in + end function target_in + end module test_module_dependencies -- cgit v1.2.3 From 11bebfcbbd114655b38ee0dd7e47ade9a15252d6 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 1 Nov 2020 12:34:44 +0000 Subject: Get backend working with new model targets structure --- fpm/src/fpm.f90 | 6 +- fpm/src/fpm_backend.f90 | 143 ++++++++++++------------- fpm/src/fpm_targets.f90 | 120 +++++++++++---------- fpm/test/fpm_test/test_module_dependencies.f90 | 126 ++++++++++++---------- 4 files changed, 206 insertions(+), 189 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 571eb10..402a1e4 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -170,12 +170,12 @@ subroutine build_model(model, settings, package, error) & -fmax-errors=1 & & -ffast-math & & -funroll-loops ' // & - & '-J'//join_path(model%output_directory,model%package_name) + & '-J'//join_path(model%output_directory,'lib') else model%output_directory = 'build/gfortran_debug' model%fortran_compile_flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g '// & '-fbounds-check -fcheck-array-temporaries -fbacktrace '// & - '-J'//join_path(model%output_directory,model%package_name) + '-J'//join_path(model%output_directory,'lib') endif model%link_flags = '' @@ -234,7 +234,7 @@ subroutine build_model(model, settings, package, error) stop else - call targets_from_sources(model%targets,sources,model%package_name) + call targets_from_sources(model,sources) call resolve_module_dependencies(model%targets,error) endif diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 2706b79..88f3317 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -4,10 +4,10 @@ module fpm_backend use fpm_environment, only: run, get_os_type, OS_WINDOWS use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir -use fpm_model, only: fpm_model_t, srcfile_t, FPM_UNIT_MODULE, & +use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM, & - FPM_SCOPE_TEST, build_target_t + FPM_SCOPE_TEST, FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE use fpm_strings, only: split @@ -22,61 +22,28 @@ contains subroutine build_package(model) type(fpm_model_t), intent(inout) :: model - ! integer :: i - ! character(:), allocatable :: base, linking, subdir + integer :: i + character(:), allocatable :: base, linking, subdir - ! if (.not.exists(model%output_directory)) then - ! call mkdir(model%output_directory) - ! end if - ! if (.not.exists(join_path(model%output_directory,model%package_name))) then - ! call mkdir(join_path(model%output_directory,model%package_name)) - ! end if + if (.not.exists(model%output_directory)) then + call mkdir(model%output_directory) + end if - ! linking = "" - ! do i=1,size(model%targets) + if (.not.exists(join_path(model%output_directory,'lib'))) then + call mkdir(join_path(model%output_directory,'lib')) + end if - ! ! if (model%sources(i)%unit_type == FPM_UNIT_MODULE .or. & - ! ! model%sources(i)%unit_type == FPM_UNIT_SUBMODULE .or. & - ! ! model%sources(i)%unit_type == FPM_UNIT_SUBPROGRAM .or. & - ! ! model%sources(i)%unit_type == FPM_UNIT_CSOURCE) then - - ! call build_source(model,model%sources(i),linking) + if (model%targets(1)%ptr%target_type == FPM_TARGET_ARCHIVE) then + linking = ' -l'//model%package_name//" -L"//join_path(model%output_directory,'lib') + else + linking = " " + end if - ! ! end if + do i=1,size(model%targets) + + call build_target(model,model%targets(i)%ptr,linking) - ! end do - - ! if (any([(model%sources(i)%unit_type == FPM_UNIT_PROGRAM,i=1,size(model%sources))])) then - ! if (.not.exists(join_path(model%output_directory,'test'))) then - ! call mkdir(join_path(model%output_directory,'test')) - ! end if - ! if (.not.exists(join_path(model%output_directory,'app'))) then - ! call mkdir(join_path(model%output_directory,'app')) - ! end if - ! end if - - ! do i=1,size(model%sources) - - ! if (model%sources(i)%unit_type == FPM_UNIT_PROGRAM) then - - ! base = basename(model%sources(i)%file_name,suffix=.false.) - - ! if (model%sources(i)%unit_scope == FPM_SCOPE_TEST) then - ! subdir = 'test' - ! else - ! subdir = 'app' - ! end if - - ! call run("gfortran -c " // model%sources(i)%file_name // ' '//model%fortran_compile_flags & - ! // " -o " // join_path(model%output_directory,subdir,base) // ".o") - - ! call run("gfortran " // join_path(model%output_directory, subdir, base) // ".o "// & - ! linking //" " //model%link_flags // " -o " // & - ! join_path(model%output_directory,subdir,model%sources(i)%exe_name) ) - - ! end if - - ! end do + end do end subroutine build_package @@ -87,41 +54,63 @@ recursive subroutine build_target(model,target,linking) ! type(fpm_model_t), intent(in) :: model type(build_target_t), intent(inout) :: target - character(:), allocatable, intent(inout) :: linking + character(:), allocatable, intent(in) :: linking + + integer :: i + character(:), allocatable :: objs + + if (target%built) then + return + end if + + if (target%touched) then + write(*,*) '(!) Circular dependency found with: ',target%output_file + stop + else + target%touched = .true. + end if + + objs = " " - ! integer :: i - ! character(:), allocatable :: object_file + do i=1,size(target%dependencies) - ! if (source_file%built) then - ! return - ! end if + if (associated(target%dependencies(i)%ptr)) then + call build_target(model,target%dependencies(i)%ptr,linking) + end if - ! if (source_file%touched) then - ! write(*,*) '(!) Circular dependency found with: ',source_file%file_name - ! stop - ! else - ! source_file%touched = .true. - ! end if + if (target%target_type == FPM_TARGET_ARCHIVE ) then - ! do i=1,size(source_file%file_dependencies) + objs = objs//" "//target%dependencies(i)%ptr%output_file - ! if (associated(source_file%file_dependencies(i)%ptr)) then - ! call build_source(model,source_file%file_dependencies(i)%ptr,linking) - ! end if + else if (target%target_type == FPM_TARGET_EXECUTABLE .and. & + target%dependencies(i)%ptr%target_type == FPM_TARGET_OBJECT) then - ! end do + objs = " "//target%dependencies(i)%ptr%output_file - ! object_file = get_object_name(model,source_file%file_name) + end if + + end do - ! if (.not.exists(dirname(object_file))) then - ! call mkdir(dirname(object_file)) - ! end if + if (.not.exists(dirname(target%output_file))) then + call mkdir(dirname(target%output_file)) + end if + + select case(target%target_type) + + case (FPM_TARGET_OBJECT) + call run("gfortran -c " // target%source%file_name // model%fortran_compile_flags & + // " -o " // target%output_file) + + case (FPM_TARGET_EXECUTABLE) + call run("gfortran " // objs // model%fortran_compile_flags & + //linking// " -o " // target%output_file) + + case (FPM_TARGET_ARCHIVE) + call run("ar -rs " // target%output_file // objs) - ! call run("gfortran -c " // source_file%file_name // model%fortran_compile_flags & - ! // " -o " // object_file) - ! linking = linking // " " // object_file + end select - ! source_file%built = .true. + target%built = .true. end subroutine build_target diff --git a/fpm/src/fpm_targets.f90 b/fpm/src/fpm_targets.f90 index dfdc9af..0c46aac 100644 --- a/fpm/src/fpm_targets.f90 +++ b/fpm/src/fpm_targets.f90 @@ -1,18 +1,16 @@ module fpm_targets use fpm_error, only: error_t, fatal_error -use fpm_model!, only: srcfile_t, build_target_t, FPM_UNIT_PROGRAM, & - ! FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE, FPM_TARGET_OBJECT +use fpm_model use fpm_environment, only: get_os_type, OS_WINDOWS -use fpm_filesystem, only: dirname, join_path +use fpm_filesystem, only: dirname, join_path, canon_path use fpm_strings, only: operator(.in.) implicit none contains -subroutine targets_from_sources(targets,sources,package_name) - type(build_target_ptr), allocatable, intent(out), target :: targets(:) +subroutine targets_from_sources(model,sources) + type(fpm_model_t), intent(inout), target :: model type(srcfile_t), intent(in) :: sources(:) - character(*), intent(in) :: package_name integer :: i type(build_target_t), pointer :: dep @@ -20,49 +18,96 @@ subroutine targets_from_sources(targets,sources,package_name) with_lib = any([(sources(i)%unit_scope == FPM_SCOPE_LIB,i=1,size(sources))]) - if (with_lib) call add_target(targets,type = FPM_TARGET_ARCHIVE,& - output_file = package_name//'.a') + if (with_lib) call add_target(model%targets,type = FPM_TARGET_ARCHIVE,& + output_file = join_path(model%output_directory,& + 'lib','lib'//model%package_name//'.a')) do i=1,size(sources) select case (sources(i)%unit_type) case (FPM_UNIT_MODULE,FPM_UNIT_SUBMODULE,FPM_UNIT_SUBPROGRAM,FPM_UNIT_CSOURCE) - call add_target(targets,source = sources(i), & + call add_target(model%targets,source = sources(i), & type = FPM_TARGET_OBJECT,& - output_file = get_object_name(sources(i)%file_name)) + output_file = get_object_name(sources(i))) if (with_lib .and. sources(i)%unit_scope == FPM_SCOPE_LIB) then ! Archive depends on object - call add_dependency(targets(1)%ptr, targets(size(targets))%ptr) + call add_dependency(model%targets(1)%ptr, model%targets(size(model%targets))%ptr) end if case (FPM_UNIT_PROGRAM) - call add_target(targets,type = FPM_TARGET_OBJECT,& - output_file = get_object_name(sources(i)%file_name), & + call add_target(model%targets,type = FPM_TARGET_OBJECT,& + output_file = get_object_name(sources(i)), & source = sources(i) & ) - - call add_target(targets,type = FPM_TARGET_EXECUTABLE,& - output_file = join_path('app',sources(i)%exe_name)) - + + if (sources(i)%unit_scope == FPM_SCOPE_APP) then + call add_target(model%targets,type = FPM_TARGET_EXECUTABLE,& + output_file = join_path(model%output_directory,'app',sources(i)%exe_name)) + else + call add_target(model%targets,type = FPM_TARGET_EXECUTABLE,& + output_file = join_path(model%output_directory,'test',sources(i)%exe_name)) + + end if ! Executable depends on object - call add_dependency(targets(size(targets))%ptr, targets(size(targets)-1)%ptr) + call add_dependency(model%targets(size(model%targets))%ptr, model%targets(size(model%targets)-1)%ptr) if (with_lib) then ! Executable depends on library - call add_dependency(targets(size(targets))%ptr, targets(1)%ptr) + call add_dependency(model%targets(size(model%targets))%ptr, model%targets(1)%ptr) end if end select end do + contains + + function get_object_name(source) result(object_file) + ! Generate object target path from source name and model params + ! + ! + type(srcfile_t), intent(in) :: source + character(:), allocatable :: object_file + + integer :: i + character(1), parameter :: filesep = '/' + character(:), allocatable :: dir + + object_file = canon_path(source%file_name) + + ! Ignore first directory level + object_file = object_file(index(object_file,filesep)+1:) + + ! Convert any remaining directory separators to underscores + i = index(object_file,filesep) + do while(i > 0) + object_file(i:i) = '_' + i = index(object_file,filesep) + end do + + select case(source%unit_scope) + + case (FPM_SCOPE_APP) + object_file = join_path(model%output_directory,'app',object_file)//'.o' + + case (FPM_SCOPE_TEST) + object_file = join_path(model%output_directory,'test',object_file)//'.o' + + case default + object_file = join_path(model%output_directory,'lib',object_file)//'.o' + + end select + + end function get_object_name + end subroutine targets_from_sources +!> Add new target to target list subroutine add_target(targets,type,output_file,source) type(build_target_ptr), allocatable, intent(inout) :: targets(:) integer, intent(in) :: type @@ -84,49 +129,16 @@ subroutine add_target(targets,type,output_file,source) end subroutine add_target +!> Add pointer to dependeny in target%dependencies subroutine add_dependency(target, dependency) type(build_target_t), intent(inout) :: target type(build_target_t) , intent(in), target :: dependency - type(build_target_ptr) :: depend - - depend%ptr => dependency - - ! if (.not.allocated(target%dependencies)) then - ! allocate(target%dependencies(0)) - ! end if - - target%dependencies = [target%dependencies, depend] - ! target%dependencies(size(target%dependencies))%ptr => dependency + target%dependencies = [target%dependencies, build_target_ptr(dependency)] end subroutine add_dependency -function get_object_name(source_file_name) result(object_file) - ! Generate object target path from source name and model params - ! - ! src/test.f90 -> //test.o - ! src/subdir/test.f90 -> //subdir_test.o - ! - character(*), intent(in) :: source_file_name - character(:), allocatable :: object_file - - integer :: i - character(1) :: filesep - - select case(get_os_type()) - case (OS_WINDOWS) - filesep = '\' - case default - filesep = '/' - end select - - ! Exclude first directory level from path - object_file = source_file_name(index(source_file_name,filesep)+1:)//'.o' - -end function get_object_name - - subroutine resolve_module_dependencies(targets,error) ! After enumerating all source files: resolve file dependencies ! by searching on module names diff --git a/fpm/test/fpm_test/test_module_dependencies.f90 b/fpm/test/fpm_test/test_module_dependencies.f90 index 1292a39..c73db30 100644 --- a/fpm/test/fpm_test/test_module_dependencies.f90 +++ b/fpm/test/fpm_test/test_module_dependencies.f90 @@ -2,7 +2,7 @@ module test_module_dependencies use testsuite, only : new_unittest, unittest_t, error_t, test_failed use fpm_targets, only: targets_from_sources, resolve_module_dependencies - use fpm_model, only: srcfile_t, build_target_t, build_target_ptr, & + use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, build_target_ptr, & FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, & @@ -52,7 +52,9 @@ contains type(error_t), allocatable, intent(out) :: error type(srcfile_t) :: sources(2) - type(build_target_ptr), allocatable :: targets(:) + type(fpm_model_t) :: model + + model%output_directory = '' sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_1.f90", & scope = FPM_SCOPE_LIB, & @@ -63,32 +65,32 @@ contains provides=[string_t('my_mod_2')], & uses=[string_t('my_mod_1')]) - call targets_from_sources(targets,sources,'test_package') - call resolve_module_dependencies(targets,error) + call targets_from_sources(model,sources) + call resolve_module_dependencies(model%targets,error) if (allocated(error)) then return end if - if (size(targets) /= 3) then - call test_failed(error,'Incorrect number of targets - expecting three') + if (size(model%targets) /= 3) then + call test_failed(error,'Incorrect number of model%targets - expecting three') return end if - call check_target(targets(1)%ptr,type=FPM_TARGET_ARCHIVE,n_depends=2, & - deps = [targets(2),targets(3)],error=error) + call check_target(model%targets(1)%ptr,type=FPM_TARGET_ARCHIVE,n_depends=2, & + deps = [model%targets(2),model%targets(3)],error=error) if (allocated(error)) return - call check_target(targets(2)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, & + call check_target(model%targets(2)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, & source=sources(1),error=error) if (allocated(error)) return - call check_target(targets(3)%ptr,type=FPM_TARGET_OBJECT,n_depends=1, & - deps=[targets(2)],source=sources(2),error=error) + call check_target(model%targets(3)%ptr,type=FPM_TARGET_OBJECT,n_depends=1, & + deps=[model%targets(2)],source=sources(2),error=error) if (allocated(error)) return @@ -96,7 +98,7 @@ contains !> Check a program using a library module - !> Each program generates two targets: object file and executable + !> Each program generates two model%targets: object file and executable !> subroutine test_program_module_use(error) @@ -117,9 +119,11 @@ contains integer :: i type(srcfile_t) :: sources(3) - type(build_target_ptr), allocatable :: targets(:) + type(fpm_model_t) :: model character(:), allocatable :: scope_str + model%output_directory = '' + scope_str = merge('FPM_SCOPE_APP ','FPM_SCOPE_TEST',exe_scope==FPM_SCOPE_APP)//' - ' sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_1.f90", & @@ -130,35 +134,35 @@ contains scope=exe_scope, & uses=[string_t('my_mod_1')]) - call targets_from_sources(targets,sources,'') - call resolve_module_dependencies(targets,error) + call targets_from_sources(model,sources) + call resolve_module_dependencies(model%targets,error) if (allocated(error)) then return end if - if (size(targets) /= 4) then - call test_failed(error,scope_str//'Incorrect number of targets - expecting three') + if (size(model%targets) /= 4) then + call test_failed(error,scope_str//'Incorrect number of model%targets - expecting three') return end if - call check_target(targets(1)%ptr,type=FPM_TARGET_ARCHIVE,n_depends=1, & - deps=[targets(2)],error=error) + call check_target(model%targets(1)%ptr,type=FPM_TARGET_ARCHIVE,n_depends=1, & + deps=[model%targets(2)],error=error) if (allocated(error)) return - call check_target(targets(2)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, & + call check_target(model%targets(2)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, & source=sources(1),error=error) if (allocated(error)) return - call check_target(targets(3)%ptr,type=FPM_TARGET_OBJECT,n_depends=1, & - deps=[targets(2)],source=sources(2),error=error) + call check_target(model%targets(3)%ptr,type=FPM_TARGET_OBJECT,n_depends=1, & + deps=[model%targets(2)],source=sources(2),error=error) if (allocated(error)) return - call check_target(targets(4)%ptr,type=FPM_TARGET_EXECUTABLE,n_depends=2, & - deps=[targets(1),targets(3)],error=error) + call check_target(model%targets(4)%ptr,type=FPM_TARGET_EXECUTABLE,n_depends=2, & + deps=[model%targets(1),model%targets(3)],error=error) if (allocated(error)) return @@ -176,33 +180,35 @@ contains integer :: i type(srcfile_t) :: sources(1) - type(build_target_ptr), allocatable :: targets(:) + type(fpm_model_t) :: model + + model%output_directory = '' sources(1) = new_test_source(FPM_UNIT_PROGRAM,file_name="app/my_program.f90", & scope = FPM_SCOPE_APP, & provides=[string_t('app_mod')], & uses=[string_t('app_mod')]) - call targets_from_sources(targets,sources,'') - call resolve_module_dependencies(targets,error) + call targets_from_sources(model,sources) + call resolve_module_dependencies(model%targets,error) if (allocated(error)) then return end if - if (size(targets) /= 2) then - write(*,*) size(targets) - call test_failed(error,'Incorrect number of targets - expecting two') + if (size(model%targets) /= 2) then + write(*,*) size(model%targets) + call test_failed(error,'Incorrect number of model%targets - expecting two') return end if - call check_target(targets(1)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, & + call check_target(model%targets(1)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, & source=sources(1),error=error) if (allocated(error)) return - call check_target(targets(2)%ptr,type=FPM_TARGET_EXECUTABLE,n_depends=1, & - deps=[targets(1)],error=error) + call check_target(model%targets(2)%ptr,type=FPM_TARGET_EXECUTABLE,n_depends=1, & + deps=[model%targets(1)],error=error) if (allocated(error)) return @@ -228,9 +234,11 @@ contains type(error_t), allocatable, intent(out) :: error type(srcfile_t) :: sources(2) - type(build_target_ptr), allocatable :: targets(:) + type(fpm_model_t) :: model character(:), allocatable :: scope_str + model%output_directory = '' + scope_str = merge('FPM_SCOPE_APP ','FPM_SCOPE_TEST',exe_scope==FPM_SCOPE_APP)//' - ' sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="app/app_mod.f90", & @@ -241,31 +249,31 @@ contains scope=exe_scope, & uses=[string_t('app_mod')]) - call targets_from_sources(targets,sources,'') - call resolve_module_dependencies(targets,error) + call targets_from_sources(model,sources) + call resolve_module_dependencies(model%targets,error) if (allocated(error)) then return end if - if (size(targets) /= 3) then - call test_failed(error,scope_str//'Incorrect number of targets - expecting three') + if (size(model%targets) /= 3) then + call test_failed(error,scope_str//'Incorrect number of model%targets - expecting three') return end if - call check_target(targets(1)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, & + call check_target(model%targets(1)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, & source=sources(1),error=error) if (allocated(error)) return - call check_target(targets(2)%ptr,type=FPM_TARGET_OBJECT,n_depends=1, & - source=sources(2),deps=[targets(1)],error=error) + call check_target(model%targets(2)%ptr,type=FPM_TARGET_OBJECT,n_depends=1, & + source=sources(2),deps=[model%targets(1)],error=error) if (allocated(error)) return - call check_target(targets(3)%ptr,type=FPM_TARGET_EXECUTABLE,n_depends=1, & - deps=[targets(2)],error=error) + call check_target(model%targets(3)%ptr,type=FPM_TARGET_EXECUTABLE,n_depends=1, & + deps=[model%targets(2)],error=error) if (allocated(error)) return @@ -280,7 +288,9 @@ contains type(error_t), allocatable, intent(out) :: error type(srcfile_t) :: sources(2) - type(build_target_ptr), allocatable :: targets(:) + type(fpm_model_t) :: model + + model%output_directory = '' sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_1.f90", & scope = FPM_SCOPE_LIB, & @@ -291,8 +301,8 @@ contains provides=[string_t('my_mod_2')], & uses=[string_t('my_mod_3')]) - call targets_from_sources(targets,sources,'') - call resolve_module_dependencies(targets,error) + call targets_from_sources(model,sources) + call resolve_module_dependencies(model%targets,error) end subroutine test_missing_library_use @@ -304,7 +314,9 @@ contains type(error_t), allocatable, intent(out) :: error type(srcfile_t) :: sources(2) - type(build_target_ptr), allocatable :: targets(:) + type(fpm_model_t) :: model + + model%output_directory = '' sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_1.f90", & scope = FPM_SCOPE_LIB, & @@ -314,8 +326,8 @@ contains scope=FPM_SCOPE_APP, & uses=[string_t('my_mod_2')]) - call targets_from_sources(targets,sources,'') - call resolve_module_dependencies(targets,error) + call targets_from_sources(model,sources) + call resolve_module_dependencies(model%targets,error) end subroutine test_missing_program_use @@ -327,7 +339,9 @@ contains type(error_t), allocatable, intent(out) :: error type(srcfile_t) :: sources(2) - type(build_target_ptr), allocatable :: targets(:) + type(fpm_model_t) :: model + + model%output_directory = '' sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="app/app_mod.f90", & scope = FPM_SCOPE_APP, & @@ -338,8 +352,8 @@ contains provides=[string_t('my_mod')], & uses=[string_t('app_mod')]) - call targets_from_sources(targets,sources,'') - call resolve_module_dependencies(targets,error) + call targets_from_sources(model,sources) + call resolve_module_dependencies(model%targets,error) end subroutine test_invalid_library_use @@ -351,7 +365,9 @@ contains type(error_t), allocatable, intent(out) :: error type(srcfile_t) :: sources(2) - type(build_target_ptr), allocatable :: targets(:) + type(fpm_model_t) :: model + + model%output_directory = '' sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="app/subdir/app_mod.f90", & scope = FPM_SCOPE_APP, & @@ -361,8 +377,8 @@ contains scope=FPM_SCOPE_APP, & uses=[string_t('app_mod')]) - call targets_from_sources(targets,sources,'') - call resolve_module_dependencies(targets,error) + call targets_from_sources(model,sources) + call resolve_module_dependencies(model%targets,error) end subroutine test_invalid_own_module_use -- cgit v1.2.3 From 1cf62c0accda7294a230cb89912bad2d03863c46 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 1 Nov 2020 13:41:39 +0000 Subject: Cleanup for PR --- fpm/src/fpm.f90 | 28 +++++++++++++--------------- fpm/src/fpm_backend.f90 | 8 ++++---- fpm/src/fpm_model.f90 | 4 +++- fpm/src/fpm_targets.f90 | 4 ++-- 4 files changed, 22 insertions(+), 22 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 402a1e4..97c1f42 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -170,18 +170,18 @@ subroutine build_model(model, settings, package, error) & -fmax-errors=1 & & -ffast-math & & -funroll-loops ' // & - & '-J'//join_path(model%output_directory,'lib') + & '-J'//join_path(model%output_directory,model%package_name) else model%output_directory = 'build/gfortran_debug' model%fortran_compile_flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g '// & '-fbounds-check -fcheck-array-temporaries -fbacktrace '// & - '-J'//join_path(model%output_directory,'lib') + '-J'//join_path(model%output_directory,model%package_name) endif model%link_flags = '' ! Add sources from executable directories if (is_dir('app') .and. package%build_config%auto_executables) then - call add_sources_from_dir(sources,'app', FPM_SCOPE_APP, & + call add_sources_from_dir(model%sources,'app', FPM_SCOPE_APP, & with_executables=.true., error=error) if (allocated(error)) then @@ -190,7 +190,7 @@ subroutine build_model(model, settings, package, error) end if if (is_dir('test') .and. package%build_config%auto_tests) then - call add_sources_from_dir(sources,'test', FPM_SCOPE_TEST, & + call add_sources_from_dir(model%sources,'test', FPM_SCOPE_TEST, & with_executables=.true., error=error) if (allocated(error)) then @@ -199,7 +199,7 @@ subroutine build_model(model, settings, package, error) end if if (allocated(package%executable)) then - call add_executable_sources(sources, package%executable, FPM_SCOPE_APP, & + call add_executable_sources(model%sources, package%executable, FPM_SCOPE_APP, & auto_discover=package%build_config%auto_executables, & error=error) @@ -209,7 +209,7 @@ subroutine build_model(model, settings, package, error) end if if (allocated(package%test)) then - call add_executable_sources(sources, package%test, FPM_SCOPE_TEST, & + call add_executable_sources(model%sources, package%test, FPM_SCOPE_TEST, & auto_discover=package%build_config%auto_tests, & error=error) @@ -220,25 +220,23 @@ subroutine build_model(model, settings, package, error) endif ! Add library sources, including local dependencies - call add_libsources_from_package(sources,package_list,package, & + call add_libsources_from_package(model%sources,package_list,package, & package_root='.',dev_depends=.true.,error=error) if (allocated(error)) then return end if + call targets_from_sources(model,model%sources) + if(settings%list)then - do i=1,size(sources) - write(stderr,'(*(g0,1x))')'fpm::build:file expected at',sources(i)%file_name, & - & merge('exists ','does not exist',exists(sources(i)%file_name) ) + do i=1,size(model%targets) + write(stderr,*) model%targets(i)%ptr%output_file enddo stop - else - - call targets_from_sources(model,sources) - - call resolve_module_dependencies(model%targets,error) endif + call resolve_module_dependencies(model%targets,error) + end subroutine build_model diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 88f3317..d3fa785 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -28,13 +28,13 @@ subroutine build_package(model) if (.not.exists(model%output_directory)) then call mkdir(model%output_directory) end if - - if (.not.exists(join_path(model%output_directory,'lib'))) then - call mkdir(join_path(model%output_directory,'lib')) + if (.not.exists(join_path(model%output_directory,model%package_name))) then + call mkdir(join_path(model%output_directory,model%package_name)) end if if (model%targets(1)%ptr%target_type == FPM_TARGET_ARCHIVE) then - linking = ' -l'//model%package_name//" -L"//join_path(model%output_directory,'lib') + linking = ' -l'//model%package_name//" -L"//& + join_path(model%output_directory,model%package_name) else linking = " " end if diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 44b7d39..b8c3220 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -75,8 +75,10 @@ end type build_target_t type :: fpm_model_t character(:), allocatable :: package_name ! Name of package + type(srcfile_t), allocatable :: sources(:) + ! Array of sources type(build_target_ptr), allocatable :: targets(:) - ! Array of sources with module-dependencies resolved + ! Array of targets with module-dependencies resolved character(:), allocatable :: fortran_compiler ! Command line name to invoke fortran compiler character(:), allocatable :: fortran_compile_flags diff --git a/fpm/src/fpm_targets.f90 b/fpm/src/fpm_targets.f90 index 0c46aac..54f0764 100644 --- a/fpm/src/fpm_targets.f90 +++ b/fpm/src/fpm_targets.f90 @@ -20,7 +20,7 @@ subroutine targets_from_sources(model,sources) if (with_lib) call add_target(model%targets,type = FPM_TARGET_ARCHIVE,& output_file = join_path(model%output_directory,& - 'lib','lib'//model%package_name//'.a')) + model%package_name,'lib'//model%package_name//'.a')) do i=1,size(sources) @@ -98,7 +98,7 @@ subroutine targets_from_sources(model,sources) object_file = join_path(model%output_directory,'test',object_file)//'.o' case default - object_file = join_path(model%output_directory,'lib',object_file)//'.o' + object_file = join_path(model%output_directory,model%package_name,object_file)//'.o' end select -- cgit v1.2.3 From 309ddf645e62a57fc65ddbaf8a08127cbe1678ca Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 1 Nov 2020 13:57:27 +0000 Subject: Manually revert 436573b to simplify PR --- fpm/src/fpm.f90 | 1 - fpm/src/fpm_source_parsing.f90 | 425 ------------------------------ fpm/src/fpm_sources.f90 | 423 ++++++++++++++++++++++++++++- fpm/test/fpm_test/test_source_parsing.f90 | 2 +- 4 files changed, 419 insertions(+), 432 deletions(-) delete mode 100644 fpm/src/fpm_source_parsing.f90 diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 97c1f42..5ddc6c5 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -150,7 +150,6 @@ subroutine build_model(model, settings, package, error) type(error_t), allocatable, intent(out) :: error integer :: i - type(srcfile_t), allocatable :: sources(:) type(string_t), allocatable :: package_list(:) model%package_name = package%name diff --git a/fpm/src/fpm_source_parsing.f90 b/fpm/src/fpm_source_parsing.f90 deleted file mode 100644 index abbe716..0000000 --- a/fpm/src/fpm_source_parsing.f90 +++ /dev/null @@ -1,425 +0,0 @@ -module fpm_source_parsing -use fpm_error, only: error_t, file_parse_error -use fpm_model, only: srcfile_t, & - FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & - FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & - FPM_UNIT_CSOURCE, FPM_UNIT_CHEADER - -use fpm_filesystem, only: basename, read_lines -use fpm_strings, only: lower, split, str_ends_with, string_t -implicit none - -private -public :: parse_source, parse_f_source, parse_c_source - -character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & - ['iso_c_binding ', & - 'iso_fortran_env', & - 'ieee_arithmetic', & - 'ieee_exceptions', & - 'ieee_features '] - -contains - -function parse_source(source_file_path,error) result(source) - character(*), intent(in) :: source_file_path - type(error_t), allocatable, intent(out) :: error - type(srcfile_t) :: source - - if (str_ends_with(lower(source_file_path), ".f90")) then - - source = parse_f_source(source_file_path, error) - - if (source%unit_type == FPM_UNIT_PROGRAM) then - source%exe_name = basename(source_file_path,suffix=.false.) - end if - - else if (str_ends_with(lower(source_file_path), ".c") .or. & - str_ends_with(lower(source_file_path), ".h")) then - - source = parse_c_source(source_file_path,error) - - end if - - if (allocated(error)) then - return - end if - -end function parse_source - -function parse_f_source(f_filename,error) result(f_source) - ! Rudimentary scan of Fortran source file and - ! extract program unit name and use/include dependencies - ! - character(*), intent(in) :: f_filename - type(srcfile_t) :: f_source - type(error_t), allocatable, intent(out) :: error - - integer :: stat - integer :: fh, n_use, n_include, n_mod, i, j, ic, pass - type(string_t), allocatable :: file_lines(:) - character(:), allocatable :: temp_string, mod_name - - f_source%file_name = f_filename - - open(newunit=fh,file=f_filename,status='old') - file_lines = read_lines(fh) - close(fh) - - do pass = 1,2 - n_use = 0 - n_include = 0 - n_mod = 0 - file_loop: do i=1,size(file_lines) - - ! Skip lines that are continued: not statements - if (i > 1) then - ic = index(file_lines(i-1)%s,'!') - if (ic < 1) then - ic = len(file_lines(i-1)%s) - end if - temp_string = trim(file_lines(i-1)%s(1:ic)) - if (len(temp_string) > 0 .and. index(temp_string,'&') == len(temp_string)) then - cycle - end if - end if - - ! Process 'USE' statements - if (index(adjustl(lower(file_lines(i)%s)),'use ') == 1 .or. & - index(adjustl(lower(file_lines(i)%s)),'use::') == 1) then - - if (index(file_lines(i)%s,'::') > 0) then - - temp_string = split_n(file_lines(i)%s,delims=':',n=2,stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to find used module name',i, & - file_lines(i)%s,index(file_lines(i)%s,'::')) - return - end if - - mod_name = split_n(temp_string,delims=' ,',n=1,stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to find used module name',i, & - file_lines(i)%s) - return - end if - mod_name = lower(mod_name) - - else - - mod_name = split_n(file_lines(i)%s,n=2,delims=' ,',stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to find used module name',i, & - file_lines(i)%s) - return - end if - mod_name = lower(mod_name) - - end if - - if (.not.validate_name(mod_name)) then - cycle - end if - - if (any([(index(mod_name,trim(INTRINSIC_MODULE_NAMES(j)))>0, & - j=1,size(INTRINSIC_MODULE_NAMES))])) then - cycle - end if - - n_use = n_use + 1 - - if (pass == 2) then - - f_source%modules_used(n_use)%s = mod_name - - end if - - end if - - ! Process 'INCLUDE' statements - ic = index(adjustl(lower(file_lines(i)%s)),'include') - if ( ic == 1 ) then - ic = index(lower(file_lines(i)%s),'include') - if (index(adjustl(file_lines(i)%s(ic+7:)),'"') == 1 .or. & - index(adjustl(file_lines(i)%s(ic+7:)),"'") == 1 ) then - - - n_include = n_include + 1 - - if (pass == 2) then - f_source%include_dependencies(n_include)%s = & - & split_n(file_lines(i)%s,n=2,delims="'"//'"',stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to find include file name',i, & - file_lines(i)%s) - return - end if - end if - end if - end if - - ! Extract name of module if is module - if (index(adjustl(lower(file_lines(i)%s)),'module ') == 1) then - - mod_name = lower(split_n(file_lines(i)%s,n=2,delims=' ',stat=stat)) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to find module name',i, & - file_lines(i)%s) - return - end if - - if (mod_name == 'procedure' .or. & - mod_name == 'subroutine' .or. & - mod_name == 'function') then - ! Ignore these cases - cycle - end if - - if (.not.validate_name(mod_name)) then - call file_parse_error(error,f_filename, & - 'empty or invalid name for module',i, & - file_lines(i)%s, index(file_lines(i)%s,mod_name)) - return - end if - - n_mod = n_mod + 1 - - if (pass == 2) then - f_source%modules_provided(n_mod) = string_t(mod_name) - end if - - f_source%unit_type = FPM_UNIT_MODULE - - end if - - ! Extract name of submodule if is submodule - if (index(adjustl(lower(file_lines(i)%s)),'submodule') == 1) then - - mod_name = split_n(file_lines(i)%s,n=3,delims='()',stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to get submodule name',i, & - file_lines(i)%s) - return - end if - if (.not.validate_name(mod_name)) then - call file_parse_error(error,f_filename, & - 'empty or invalid name for submodule',i, & - file_lines(i)%s, index(file_lines(i)%s,mod_name)) - return - end if - - n_mod = n_mod + 1 - - temp_string = split_n(file_lines(i)%s,n=2,delims='()',stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to get submodule ancestry',i, & - file_lines(i)%s) - return - end if - - f_source%unit_type = FPM_UNIT_SUBMODULE - - n_use = n_use + 1 - - if (pass == 2) then - - if (index(temp_string,':') > 0) then - - temp_string = temp_string(index(temp_string,':')+1:) - - end if - - if (.not.validate_name(temp_string)) then - call file_parse_error(error,f_filename, & - 'empty or invalid name for submodule parent',i, & - file_lines(i)%s, index(file_lines(i)%s,temp_string)) - return - end if - - f_source%modules_used(n_use)%s = lower(temp_string) - - f_source%modules_provided(n_mod)%s = lower(mod_name) - - end if - - end if - - ! Detect if contains a program - ! (no modules allowed after program def) - if (index(adjustl(lower(file_lines(i)%s)),'program') == 1) then - - f_source%unit_type = FPM_UNIT_PROGRAM - - end if - - end do file_loop - - ! Default to subprogram unit type - if (f_source%unit_type == FPM_UNIT_UNKNOWN) then - f_source%unit_type = FPM_UNIT_SUBPROGRAM - end if - - if (pass == 1) then - allocate(f_source%modules_used(n_use)) - allocate(f_source%include_dependencies(n_include)) - allocate(f_source%modules_provided(n_mod)) - end if - - end do - - contains - - function validate_name(name) result(valid) - character(*), intent(in) :: name - logical :: valid - - integer :: i - - if (len_trim(name) < 1) then - valid = .false. - return - end if - - if (lower(name(1:1)) < 'a' .or. & - lower(name(1:1)) > 'z') then - - valid = .false. - return - end if - - do i=1,len(name) - - if (.not.( & - (name(i:i) >= '0' .and. name(i:i) <= '9').or. & - (lower(name(i:i)) >= 'a' .and. lower(name(i:i)) <= 'z').or. & - name(i:i) == '_') ) then - - valid = .false. - return - end if - - end do - - valid = .true. - return - - end function validate_name - -end function parse_f_source - - -function parse_c_source(c_filename,error) result(c_source) - ! Rudimentary scan of c source file and - ! extract include dependencies - ! - character(*), intent(in) :: c_filename - type(srcfile_t) :: c_source - type(error_t), allocatable, intent(out) :: error - - integer :: fh, n_include, i, pass, stat - type(string_t), allocatable :: file_lines(:) - - c_source%file_name = c_filename - - if (str_ends_with(lower(c_filename), ".c")) then - - c_source%unit_type = FPM_UNIT_CSOURCE - - elseif (str_ends_with(lower(c_filename), ".h")) then - - c_source%unit_type = FPM_UNIT_CHEADER - - end if - - allocate(c_source%modules_used(0)) - allocate(c_source%modules_provided(0)) - - open(newunit=fh,file=c_filename,status='old') - file_lines = read_lines(fh) - close(fh) - - do pass = 1,2 - n_include = 0 - file_loop: do i=1,size(file_lines) - - ! Process 'INCLUDE' statements - if (index(adjustl(lower(file_lines(i)%s)),'#include') == 1 .and. & - index(file_lines(i)%s,'"') > 0) then - - n_include = n_include + 1 - - if (pass == 2) then - - c_source%include_dependencies(n_include)%s = & - & split_n(file_lines(i)%s,n=2,delims='"',stat=stat) - if (stat /= 0) then - call file_parse_error(error,c_filename, & - 'unable to get c include file',i, & - file_lines(i)%s,index(file_lines(i)%s,'"')) - return - end if - - end if - - end if - - end do file_loop - - if (pass == 1) then - allocate(c_source%include_dependencies(n_include)) - end if - - end do - -end function parse_c_source - - -function split_n(string,delims,n,stat) result(substring) - ! Split a string on one or more delimeters - ! and return the nth substring if it exists - ! - ! n=0 will return the last item - ! n=-1 will return the penultimate item etc. - ! - ! stat = 1 on return if the index - ! is not found - ! - character(*), intent(in) :: string - character(*), intent(in) :: delims - integer, intent(in) :: n - integer, intent(out) :: stat - character(:), allocatable :: substring - - integer :: i - character(:), allocatable :: string_parts(:) - - call split(string,string_parts,delims) - - if (n<1) then - i = size(string_parts) + n - if (i < 1) then - stat = 1 - return - end if - else - i = n - end if - - if (i>size(string_parts)) then - stat = 1 - return - end if - - substring = trim(adjustl(string_parts(i))) - stat = 0 - -end function split_n - -end module fpm_source_parsing \ No newline at end of file diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index 35b769b..7d853e0 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -1,19 +1,56 @@ module fpm_sources -use fpm_error, only: error_t, fatal_error -use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM, & +use fpm_error, only: error_t, file_parse_error, fatal_error +use fpm_model, only: srcfile_t, fpm_model_t, & + FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & + FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & + FPM_UNIT_CSOURCE, FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, & FPM_SCOPE_LIB, FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST -use fpm_filesystem, only: basename, canon_path, dirname, join_path, list_files -use fpm_strings, only: lower, str_ends_with, string_t, operator(.in.) +use fpm_filesystem, only: basename, canon_path, dirname, join_path, read_lines, list_files +use fpm_strings, only: lower, split, str_ends_with, string_t, operator(.in.) use fpm_manifest_executable, only: executable_t -use fpm_source_parsing, only: parse_source implicit none private public :: add_sources_from_dir, add_executable_sources +public :: parse_f_source, parse_c_source + +character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & + ['iso_c_binding ', & + 'iso_fortran_env', & + 'ieee_arithmetic', & + 'ieee_exceptions', & + 'ieee_features '] contains +function parse_source(source_file_path,error) result(source) + character(*), intent(in) :: source_file_path + type(error_t), allocatable, intent(out) :: error + type(srcfile_t) :: source + + if (str_ends_with(lower(source_file_path), ".f90")) then + + source = parse_f_source(source_file_path, error) + + if (source%unit_type == FPM_UNIT_PROGRAM) then + source%exe_name = basename(source_file_path,suffix=.false.) + end if + + else if (str_ends_with(lower(source_file_path), ".c") .or. & + str_ends_with(lower(source_file_path), ".h")) then + + source = parse_c_source(source_file_path,error) + + end if + + if (allocated(error)) then + return + end if + +end function parse_source + + subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) ! Enumerate sources in a directory ! @@ -170,4 +207,380 @@ subroutine get_executable_source_dirs(exe_dirs,executables) end subroutine get_executable_source_dirs +function parse_f_source(f_filename,error) result(f_source) + ! Rudimentary scan of Fortran source file and + ! extract program unit name and use/include dependencies + ! + character(*), intent(in) :: f_filename + type(srcfile_t) :: f_source + type(error_t), allocatable, intent(out) :: error + + integer :: stat + integer :: fh, n_use, n_include, n_mod, i, j, ic, pass + type(string_t), allocatable :: file_lines(:) + character(:), allocatable :: temp_string, mod_name + + f_source%file_name = f_filename + + open(newunit=fh,file=f_filename,status='old') + file_lines = read_lines(fh) + close(fh) + + do pass = 1,2 + n_use = 0 + n_include = 0 + n_mod = 0 + file_loop: do i=1,size(file_lines) + + ! Skip lines that are continued: not statements + if (i > 1) then + ic = index(file_lines(i-1)%s,'!') + if (ic < 1) then + ic = len(file_lines(i-1)%s) + end if + temp_string = trim(file_lines(i-1)%s(1:ic)) + if (len(temp_string) > 0 .and. index(temp_string,'&') == len(temp_string)) then + cycle + end if + end if + + ! Process 'USE' statements + if (index(adjustl(lower(file_lines(i)%s)),'use ') == 1 .or. & + index(adjustl(lower(file_lines(i)%s)),'use::') == 1) then + + if (index(file_lines(i)%s,'::') > 0) then + + temp_string = split_n(file_lines(i)%s,delims=':',n=2,stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find used module name',i, & + file_lines(i)%s,index(file_lines(i)%s,'::')) + return + end if + + mod_name = split_n(temp_string,delims=' ,',n=1,stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find used module name',i, & + file_lines(i)%s) + return + end if + mod_name = lower(mod_name) + + else + + mod_name = split_n(file_lines(i)%s,n=2,delims=' ,',stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find used module name',i, & + file_lines(i)%s) + return + end if + mod_name = lower(mod_name) + + end if + + if (.not.validate_name(mod_name)) then + cycle + end if + + if (any([(index(mod_name,trim(INTRINSIC_MODULE_NAMES(j)))>0, & + j=1,size(INTRINSIC_MODULE_NAMES))])) then + cycle + end if + + n_use = n_use + 1 + + if (pass == 2) then + + f_source%modules_used(n_use)%s = mod_name + + end if + + end if + + ! Process 'INCLUDE' statements + ic = index(adjustl(lower(file_lines(i)%s)),'include') + if ( ic == 1 ) then + ic = index(lower(file_lines(i)%s),'include') + if (index(adjustl(file_lines(i)%s(ic+7:)),'"') == 1 .or. & + index(adjustl(file_lines(i)%s(ic+7:)),"'") == 1 ) then + + + n_include = n_include + 1 + + if (pass == 2) then + f_source%include_dependencies(n_include)%s = & + & split_n(file_lines(i)%s,n=2,delims="'"//'"',stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find include file name',i, & + file_lines(i)%s) + return + end if + end if + end if + end if + + ! Extract name of module if is module + if (index(adjustl(lower(file_lines(i)%s)),'module ') == 1) then + + mod_name = lower(split_n(file_lines(i)%s,n=2,delims=' ',stat=stat)) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find module name',i, & + file_lines(i)%s) + return + end if + + if (mod_name == 'procedure' .or. & + mod_name == 'subroutine' .or. & + mod_name == 'function') then + ! Ignore these cases + cycle + end if + + if (.not.validate_name(mod_name)) then + call file_parse_error(error,f_filename, & + 'empty or invalid name for module',i, & + file_lines(i)%s, index(file_lines(i)%s,mod_name)) + return + end if + + n_mod = n_mod + 1 + + if (pass == 2) then + f_source%modules_provided(n_mod) = string_t(mod_name) + end if + + f_source%unit_type = FPM_UNIT_MODULE + + end if + + ! Extract name of submodule if is submodule + if (index(adjustl(lower(file_lines(i)%s)),'submodule') == 1) then + + mod_name = split_n(file_lines(i)%s,n=3,delims='()',stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to get submodule name',i, & + file_lines(i)%s) + return + end if + if (.not.validate_name(mod_name)) then + call file_parse_error(error,f_filename, & + 'empty or invalid name for submodule',i, & + file_lines(i)%s, index(file_lines(i)%s,mod_name)) + return + end if + + n_mod = n_mod + 1 + + temp_string = split_n(file_lines(i)%s,n=2,delims='()',stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to get submodule ancestry',i, & + file_lines(i)%s) + return + end if + + f_source%unit_type = FPM_UNIT_SUBMODULE + + n_use = n_use + 1 + + if (pass == 2) then + + if (index(temp_string,':') > 0) then + + temp_string = temp_string(index(temp_string,':')+1:) + + end if + + if (.not.validate_name(temp_string)) then + call file_parse_error(error,f_filename, & + 'empty or invalid name for submodule parent',i, & + file_lines(i)%s, index(file_lines(i)%s,temp_string)) + return + end if + + f_source%modules_used(n_use)%s = lower(temp_string) + + f_source%modules_provided(n_mod)%s = lower(mod_name) + + end if + + end if + + ! Detect if contains a program + ! (no modules allowed after program def) + if (index(adjustl(lower(file_lines(i)%s)),'program') == 1) then + + f_source%unit_type = FPM_UNIT_PROGRAM + + end if + + end do file_loop + + ! Default to subprogram unit type + if (f_source%unit_type == FPM_UNIT_UNKNOWN) then + f_source%unit_type = FPM_UNIT_SUBPROGRAM + end if + + if (pass == 1) then + allocate(f_source%modules_used(n_use)) + allocate(f_source%include_dependencies(n_include)) + allocate(f_source%modules_provided(n_mod)) + end if + + end do + + contains + + function validate_name(name) result(valid) + character(*), intent(in) :: name + logical :: valid + + integer :: i + + if (len_trim(name) < 1) then + valid = .false. + return + end if + + if (lower(name(1:1)) < 'a' .or. & + lower(name(1:1)) > 'z') then + + valid = .false. + return + end if + + do i=1,len(name) + + if (.not.( & + (name(i:i) >= '0' .and. name(i:i) <= '9').or. & + (lower(name(i:i)) >= 'a' .and. lower(name(i:i)) <= 'z').or. & + name(i:i) == '_') ) then + + valid = .false. + return + end if + + end do + + valid = .true. + return + + end function validate_name + +end function parse_f_source + + +function parse_c_source(c_filename,error) result(c_source) + ! Rudimentary scan of c source file and + ! extract include dependencies + ! + character(*), intent(in) :: c_filename + type(srcfile_t) :: c_source + type(error_t), allocatable, intent(out) :: error + + integer :: fh, n_include, i, pass, stat + type(string_t), allocatable :: file_lines(:) + + c_source%file_name = c_filename + + if (str_ends_with(lower(c_filename), ".c")) then + + c_source%unit_type = FPM_UNIT_CSOURCE + + elseif (str_ends_with(lower(c_filename), ".h")) then + + c_source%unit_type = FPM_UNIT_CHEADER + + end if + + allocate(c_source%modules_used(0)) + allocate(c_source%modules_provided(0)) + + open(newunit=fh,file=c_filename,status='old') + file_lines = read_lines(fh) + close(fh) + + do pass = 1,2 + n_include = 0 + file_loop: do i=1,size(file_lines) + + ! Process 'INCLUDE' statements + if (index(adjustl(lower(file_lines(i)%s)),'#include') == 1 .and. & + index(file_lines(i)%s,'"') > 0) then + + n_include = n_include + 1 + + if (pass == 2) then + + c_source%include_dependencies(n_include)%s = & + & split_n(file_lines(i)%s,n=2,delims='"',stat=stat) + if (stat /= 0) then + call file_parse_error(error,c_filename, & + 'unable to get c include file',i, & + file_lines(i)%s,index(file_lines(i)%s,'"')) + return + end if + + end if + + end if + + end do file_loop + + if (pass == 1) then + allocate(c_source%include_dependencies(n_include)) + end if + + end do + +end function parse_c_source + + +function split_n(string,delims,n,stat) result(substring) + ! Split a string on one or more delimeters + ! and return the nth substring if it exists + ! + ! n=0 will return the last item + ! n=-1 will return the penultimate item etc. + ! + ! stat = 1 on return if the index + ! is not found + ! + character(*), intent(in) :: string + character(*), intent(in) :: delims + integer, intent(in) :: n + integer, intent(out) :: stat + character(:), allocatable :: substring + + integer :: i + character(:), allocatable :: string_parts(:) + + call split(string,string_parts,delims) + + if (n<1) then + i = size(string_parts) + n + if (i < 1) then + stat = 1 + return + end if + else + i = n + end if + + if (i>size(string_parts)) then + stat = 1 + return + end if + + substring = trim(adjustl(string_parts(i))) + stat = 0 + +end function split_n + + end module fpm_sources diff --git a/fpm/test/fpm_test/test_source_parsing.f90 b/fpm/test/fpm_test/test_source_parsing.f90 index 4463c07..d1d3e12 100644 --- a/fpm/test/fpm_test/test_source_parsing.f90 +++ b/fpm/test/fpm_test/test_source_parsing.f90 @@ -2,7 +2,7 @@ module test_source_parsing use testsuite, only : new_unittest, unittest_t, error_t, test_failed use fpm_filesystem, only: get_temp_filename - use fpm_source_parsing, only: parse_f_source, parse_c_source + use fpm_sources, only: parse_f_source, parse_c_source use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE use fpm_strings, only: operator(.in.) -- cgit v1.2.3 From 6a2d6e798703bb88dd4ab3b7a8bf643e55724a88 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 1 Nov 2020 14:14:47 +0000 Subject: Fix: new backend to link non-library dependencies with executables --- fpm/src/fpm_backend.f90 | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index d3fa785..e8f51cc 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -56,7 +56,8 @@ recursive subroutine build_target(model,target,linking) type(build_target_t), intent(inout) :: target character(:), allocatable, intent(in) :: linking - integer :: i + integer :: i, j + type(build_target_t), pointer :: exe_obj character(:), allocatable :: objs if (target%built) then @@ -80,12 +81,27 @@ recursive subroutine build_target(model,target,linking) if (target%target_type == FPM_TARGET_ARCHIVE ) then + ! Construct object list for archive objs = objs//" "//target%dependencies(i)%ptr%output_file else if (target%target_type == FPM_TARGET_EXECUTABLE .and. & target%dependencies(i)%ptr%target_type == FPM_TARGET_OBJECT) then - objs = " "//target%dependencies(i)%ptr%output_file + exe_obj => target%dependencies(i)%ptr + + ! Construct object list for executable + objs = " "//exe_obj%output_file + + ! Include non-library object dependencies + do j=1,size(exe_obj%dependencies) + + if (allocated(exe_obj%dependencies(j)%ptr%source)) then + if (exe_obj%dependencies(j)%ptr%source%unit_scope == exe_obj%source%unit_scope) then + objs = objs//" "//exe_obj%dependencies(j)%ptr%output_file + end if + end if + + end do end if -- cgit v1.2.3 From 00c75b4dbaa19a15d3f0e92ff9dbacf8b334a2bf Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 7 Nov 2020 14:04:00 +0000 Subject: Use path to archive file for linking --- fpm/src/fpm_backend.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index e8f51cc..f70f477 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -33,8 +33,7 @@ subroutine build_package(model) end if if (model%targets(1)%ptr%target_type == FPM_TARGET_ARCHIVE) then - linking = ' -l'//model%package_name//" -L"//& - join_path(model%output_directory,model%package_name) + linking = " "//model%targets(1)%ptr%output_file else linking = " " end if -- cgit v1.2.3 From 4071e13104cc9b82ddd6969183a378b5a3f27b1c Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 8 Nov 2020 13:02:23 +0000 Subject: Add: check for duplicate output objects --- fpm/src/fpm_targets.f90 | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/fpm/src/fpm_targets.f90 b/fpm/src/fpm_targets.f90 index 54f0764..2cd4418 100644 --- a/fpm/src/fpm_targets.f90 +++ b/fpm/src/fpm_targets.f90 @@ -114,16 +114,32 @@ subroutine add_target(targets,type,output_file,source) character(*), intent(in) :: output_file type(srcfile_t), intent(in), optional :: source + integer :: i type(build_target_ptr), allocatable :: temp(:) type(build_target_t), pointer :: new_target + if (.not.allocated(targets)) allocate(targets(0)) + + ! Check for duplicate outputs + do i=1,size(targets) + + if (targets(i)%ptr%output_file == output_file) then + + write(*,*) 'Error while building target list: duplicate output object "',& + output_file,'"' + if (present(source)) write(*,*) ' Source file: "',source%file_name,'"' + stop 1 + + end if + + end do + allocate(new_target) new_target%target_type = type new_target%output_file = output_file if (present(source)) new_target%source = source allocate(new_target%dependencies(0)) - - if (.not.allocated(targets)) allocate(targets(0)) + targets = [targets, build_target_ptr(new_target)] end subroutine add_target -- cgit v1.2.3 From 9f200c3a29a1fa794fb11b60f8cab02f77fc882e Mon Sep 17 00:00:00 2001 From: LKedward Date: Tue, 10 Nov 2020 13:49:18 +0000 Subject: Minor fix: add missing link flags from model. --- fpm/src/fpm_backend.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index f70f477..d705ec2 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -38,6 +38,8 @@ subroutine build_package(model) linking = " " end if + linking = linking//" "//model%link_flags + do i=1,size(model%targets) call build_target(model,model%targets(i)%ptr,linking) -- cgit v1.2.3