From eed082b47c95b3732dee25822f8604e80fe34790 Mon Sep 17 00:00:00 2001 From: LKedward Date: Fri, 11 Sep 2020 16:16:36 +0100 Subject: Isolate model definition from model construction --- fpm/src/fpm.f90 | 42 +++++++++++++++++++++--- fpm/src/fpm_backend.f90 | 6 ++-- fpm/src/fpm_model.f90 | 87 ++++++++++++++++++++++++------------------------- fpm/src/fpm_sources.f90 | 46 +++----------------------- 4 files changed, 87 insertions(+), 94 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 69fe155..29d663c 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -4,10 +4,12 @@ use fpm_strings, only: string_t, str_ends_with use fpm_backend, only: build_package use fpm_command_line, only: fpm_build_settings use fpm_environment, only: run, get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS -use fpm_filesystem, only: number_of_rows, list_files, exists -use fpm_model, only: build_model, fpm_model_t -use fpm_manifest, only : get_package_data, default_executable, default_library, & - & package_t +use fpm_filesystem, only: join_path, number_of_rows, list_files, exists +use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t +use fpm_sources, only: add_executable_sources, add_sources_from_dir, & + resolve_module_dependencies +use fpm_manifest, only : get_package_data, default_executable, & + default_library, package_t use fpm_error, only : error_t implicit none private @@ -16,6 +18,38 @@ public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test contains +subroutine build_model(model, settings, package) + ! Constructs a valid fpm model from command line settings and toml manifest + ! + type(fpm_model_t), intent(out) :: model + type(fpm_build_settings), intent(in) :: settings + type(package_t), intent(in) :: package + + model%package_name = package%name + + ! #TODO: Choose flags and output directory based on cli settings & manifest inputs + model%fortran_compiler = 'gfortran' + 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) + model%link_flags = '' + + ! Add sources from executable directories + if (allocated(package%executable)) then + call add_executable_sources(model%sources, package%executable,is_test=.false.) + end if + if (allocated(package%test)) then + call add_executable_sources(model%sources, package%test,is_test=.true.) + end if + + if (allocated(package%library)) then + call add_sources_from_dir(model%sources,package%library%source_dir) + end if + + call resolve_module_dependencies(model%sources) + +end subroutine build_model subroutine cmd_build(settings) type(fpm_build_settings), intent(in) :: settings diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index d8bfd44..62fd242 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -4,9 +4,9 @@ module fpm_backend use fpm_environment, only: run use fpm_filesystem, only: basename, join_path, exists, mkdir -use fpm_model, only: fpm_model_t -use fpm_sources, only: srcfile_t, FPM_UNIT_MODULE, FPM_UNIT_SUBMODULE, & - FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM +use fpm_model, only: fpm_model_t, srcfile_t, FPM_UNIT_MODULE, & + FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & + FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM use fpm_strings, only: split implicit none diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 0387dfb..702ba6f 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -1,19 +1,51 @@ module fpm_model - ! Definition and validation of the backend model - -use fpm_command_line, only: fpm_build_settings -use fpm_filesystem, only: exists, join_path -use fpm_manifest, only: package_t, default_library, default_executable -use fpm_manifest_executable, only: executable_t -use fpm_sources, only: resolve_module_dependencies, add_sources_from_dir, & - add_executable_sources, srcfile_t use fpm_strings, only: string_t - implicit none private -public :: build_model, fpm_model_t +public :: srcfile_ptr, srcfile_t, fpm_model_t + +public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & + FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & + FPM_UNIT_CHEADER + +integer, parameter :: FPM_UNIT_UNKNOWN = -1 +integer, parameter :: FPM_UNIT_PROGRAM = 1 +integer, parameter :: FPM_UNIT_MODULE = 2 +integer, parameter :: FPM_UNIT_SUBMODULE = 3 +integer, parameter :: FPM_UNIT_SUBPROGRAM = 4 +integer, parameter :: FPM_UNIT_CSOURCE = 5 +integer, parameter :: FPM_UNIT_CHEADER = 6 + +type srcfile_ptr + ! For constructing arrays of src_file pointers + type(srcfile_t), pointer :: ptr => null() +end type srcfile_ptr + +type srcfile_t + ! Type for encapsulating a source file + ! and it's metadata + character(:), allocatable :: file_name + ! File path relative to cwd + character(:), allocatable :: exe_name + ! Name of executable for FPM_UNIT_PROGRAM + logical :: is_test = .false. + ! Is executable a test? + type(string_t), allocatable :: modules_provided(:) + ! Modules provided by this source file (lowerstring) + integer :: unit_type = FPM_UNIT_UNKNOWN + ! Type of program unit + type(string_t), allocatable :: modules_used(:) + ! 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 + + logical :: built = .false. + logical :: touched = .false. +end type srcfile_t type :: fpm_model_t character(:), allocatable :: package_name @@ -30,39 +62,4 @@ type :: fpm_model_t ! Base directory for build end type fpm_model_t -contains - -subroutine build_model(model, settings, package) - ! Constructs a valid fpm model from command line settings and toml manifest - ! - type(fpm_model_t), intent(out) :: model - type(fpm_build_settings), intent(in) :: settings - type(package_t), intent(in) :: package - - model%package_name = package%name - - ! #TODO: Choose flags and output directory based on cli settings & manifest inputs - model%fortran_compiler = 'gfortran' - 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) - model%link_flags = '' - - ! Add sources from executable directories - if (allocated(package%executable)) then - call add_executable_sources(model%sources, package%executable,is_test=.false.) - end if - if (allocated(package%test)) then - call add_executable_sources(model%sources, package%test,is_test=.true.) - end if - - if (allocated(package%library)) then - call add_sources_from_dir(model%sources,package%library%source_dir) - end if - - call resolve_module_dependencies(model%sources) - -end subroutine build_model - end module fpm_model diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index b84e31d..f2418b5 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -1,23 +1,15 @@ module fpm_sources +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 use fpm_filesystem, only: basename, read_lines, list_files use fpm_strings, only: lower, split, str_ends_with, string_t, operator(.in.) use fpm_manifest_executable, only: executable_t implicit none private -public :: srcfile_ptr, srcfile_t public :: add_sources_from_dir, add_executable_sources, resolve_module_dependencies -public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & - FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & - FPM_UNIT_CHEADER - -integer, parameter :: FPM_UNIT_UNKNOWN = -1 -integer, parameter :: FPM_UNIT_PROGRAM = 1 -integer, parameter :: FPM_UNIT_MODULE = 2 -integer, parameter :: FPM_UNIT_SUBMODULE = 3 -integer, parameter :: FPM_UNIT_SUBPROGRAM = 4 -integer, parameter :: FPM_UNIT_CSOURCE = 5 -integer, parameter :: FPM_UNIT_CHEADER = 6 character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & ['iso_c_binding ', & @@ -26,36 +18,6 @@ character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & 'ieee_exceptions', & 'ieee_features '] -type srcfile_ptr - ! For constructing arrays of src_file pointers - type(srcfile_t), pointer :: ptr => null() -end type srcfile_ptr - -type srcfile_t - ! Type for encapsulating a source file - ! and it's metadata - character(:), allocatable :: file_name - ! File path relative to cwd - character(:), allocatable :: exe_name - ! Name of executable for FPM_UNIT_PROGRAM - logical :: is_test = .false. - ! Is executable a test? - type(string_t), allocatable :: modules_provided(:) - ! Modules provided by this source file (lowerstring) - integer :: unit_type = FPM_UNIT_UNKNOWN - ! Type of program unit - type(string_t), allocatable :: modules_used(:) - ! 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 - - logical :: built = .false. - logical :: touched = .false. -end type srcfile_t - - contains subroutine add_sources_from_dir(sources,directory,with_executables) -- cgit v1.2.3