From b6000d89933610bd8f481b5f0f2c8ceeac7f18ff Mon Sep 17 00:00:00 2001 From: LKedward Date: Tue, 1 Sep 2020 10:37:33 +0100 Subject: Add: stubs for model and manifest structures Backend now only accepts the fpm model structure. This structure currently only contains the array of sources. --- fpm/app/main.f90 | 4 ++-- fpm/src/fpm.f90 | 53 +++++++----------------------------------------- fpm/src/fpm_backend.f90 | 40 ++++++++++++++++++++++++++++++++++++ fpm/src/fpm_manifest.f90 | 10 +++++++++ fpm/src/fpm_model.f90 | 29 ++++++++++++++++++++++++++ fpm/src/fpm_sources.f90 | 19 +++++++++++++---- 6 files changed, 103 insertions(+), 52 deletions(-) create mode 100644 fpm/src/fpm_manifest.f90 create mode 100644 fpm/src/fpm_model.f90 diff --git a/fpm/app/main.f90 b/fpm/app/main.f90 index 7f0f425..c7f9786 100644 --- a/fpm/app/main.f90 +++ b/fpm/app/main.f90 @@ -15,11 +15,11 @@ class(fpm_cmd_settings), allocatable :: cmd_settings call get_command_line_settings(cmd_settings) -select type(cmd_settings) +select type(settings=>cmd_settings) type is (fpm_new_settings) call cmd_new() type is (fpm_build_settings) - call cmd_build() + call cmd_build(settings) type is (fpm_run_settings) call cmd_run() type is (fpm_test_settings) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index ac412c6..a4d830b 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -22,56 +22,17 @@ else end if end subroutine -subroutine cmd_build() -type(string_t), allocatable :: lib_files(:) -type(string_t), allocatable :: app_files(:) -type(string_t), allocatable :: files(:) -character(:), allocatable :: basename, pkg_name, linking -integer :: i, n +subroutine cmd_build(settings) + type(fpm_build_settings), intent(in) :: settings -type(srcfile_t), allocatable :: sources(:) -character(:), allocatable :: file_parts(:) + type(fpm_manifest_t) :: manifest + type(fpm_model_t) :: model -print *, "# Building project" + print *, "# Building project" -call list_files("src", lib_files) -lib_files = [(string_t("src/"//lib_files(i)%s),i=1,size(lib_files))] + call build_model(model, settings, manifest) -call list_files("app", app_files) -app_files = [(string_t("app/"//app_files(i)%s),i=1,size(app_files))] - -files = [lib_files, app_files] - -call scan_sources(files,sources) - -call resolve_dependencies(sources) - -linking = "" -do i=1,size(sources) - - if (sources(i)%unit_type == FPM_UNIT_MODULE .or. & - sources(i)%unit_type == FPM_UNIT_SUBMODULE .or. & - sources(i)%unit_type == FPM_UNIT_SUBPROGRAM .or. & - sources(i)%unit_type == FPM_UNIT_CSOURCE) then - - call build_source(sources(i),linking) - - end if - -end do - -do i=1,size(sources) - - if (sources(i)%unit_type == FPM_UNIT_PROGRAM) then - - call split(sources(i)%file_name,file_parts,delimiters='\/.') - basename = file_parts(size(file_parts)-1) - - call run("gfortran " // sources(i)%file_name // linking // " -o " // basename) - - end if - -end do + call build_package(model) end subroutine diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index da2cc85..37afe65 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -2,11 +2,51 @@ module fpm_backend use fpm_strings use fpm_environment use fpm_sources +use fpm_model implicit none contains + +subroutine build_package(model) + type(fpm_model_t), intent(inout) :: model + + integer :: i + character(:), allocatable :: basename, linking + character(:), allocatable :: file_parts(:) + + linking = "" + do i=1,size(model%sources) + + 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%sources(i),linking) + + end if + + end do + + do i=1,size(model%sources) + + if (model%sources(i)%unit_type == FPM_UNIT_PROGRAM) then + + call split(model%sources(i)%file_name,file_parts,delimiters='\/.') + basename = file_parts(size(file_parts)-1) + + call run("gfortran " // model%sources(i)%file_name // linking // " -o " // basename) + + end if + + end do + +end subroutine build_package + + + recursive subroutine build_source(source_file,linking) ! Compile Fortran source, called recursively on it dependents ! diff --git a/fpm/src/fpm_manifest.f90 b/fpm/src/fpm_manifest.f90 new file mode 100644 index 0000000..4a88844 --- /dev/null +++ b/fpm/src/fpm_manifest.f90 @@ -0,0 +1,10 @@ +module fpm_manifest +! Parsing, validation and representation of 'fpm.toml' manifest file +implicit none + +type fpm_manifest_t + ! Encapsulates settings parsed from 'fpm.toml' + +end type fpm_manifest_t + +end module fpm_manifest \ No newline at end of file diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 new file mode 100644 index 0000000..501ea29 --- /dev/null +++ b/fpm/src/fpm_model.f90 @@ -0,0 +1,29 @@ +module fpm_model +! Definition and validation of the backend model +! +use fpm_strings +use fpm_sources +use fpm_command_line +use fpm_manifest +implicit none + +type fpm_model_t + type(srcfile_t), allocatable :: sources(:) + ! Array of sources with module-dependencies resolved + +end type fpm_model_t + +contains + +subroutine build_model(model, settings, manifest) + type(fpm_model_t), intent(out) :: model + type(fpm_build_settings), intent(in) :: settings + type(fpm_manifest_t), intent(in) :: manifest + + call scan_sources(model%sources,[string_t('app'),string_t('src')]) + + call resolve_dependencies(model%sources) + +end subroutine build_model + +end module fpm_model \ No newline at end of file diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index b07366d..88a9ffa 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -1,6 +1,6 @@ module fpm_sources use fpm_strings -use fpm_filesystem, only: read_lines +use fpm_filesystem, only: read_lines, list_files implicit none private @@ -47,17 +47,28 @@ end type srcfile_t contains -subroutine scan_sources(file_names,sources) +subroutine scan_sources(sources,directories) ! Enumerate Fortran sources and resolve file ! dependencies ! - type(string_t), intent(in) :: file_names(:) type(srcfile_t), allocatable, intent(out), target :: sources(:) + type(string_t), intent(in) :: directories(:) integer :: i, j - logical :: is_source(size(file_names)) + logical, allocatable :: is_source(:) + type(string_t), allocatable :: dir_files(:) + type(string_t), allocatable :: file_names(:) type(string_t), allocatable :: src_file_names(:) + ! Scan directories for sources + allocate(file_names(0)) + do i=1,size(directories) + + call list_files(directories(i)%s, dir_files) + file_names = [file_names,(string_t(directories(i)%s//'/'//dir_files(j)%s),j=1,size(dir_files))] + + end do + is_source = [(str_ends_with(lower(file_names(i)%s), ".f90") .or. & str_ends_with(lower(file_names(i)%s), ".c") .or. & str_ends_with(lower(file_names(i)%s), ".h"),i=1,size(file_names))] -- cgit v1.2.3