diff options
| -rwxr-xr-x | ci/run_tests.bat | 25 | ||||
| -rwxr-xr-x | ci/run_tests.sh | 10 | ||||
| -rw-r--r-- | fpm/app/main.f90 | 3 | ||||
| -rw-r--r-- | fpm/src/fpm.f90 | 302 | ||||
| -rw-r--r-- | fpm/src/fpm/cmd/new.f90 | 164 | ||||
| -rw-r--r-- | fpm/src/fpm/git.f90 | 52 | ||||
| -rw-r--r-- | fpm/src/fpm_backend.f90 | 13 | ||||
| -rw-r--r-- | fpm/src/fpm_command_line.f90 | 5 | ||||
| -rw-r--r-- | fpm/src/fpm_sources.f90 | 138 | ||||
| -rw-r--r-- | fpm/test/cli_test/cli_test.f90 | 3 | ||||
| -rw-r--r-- | fpm/test/fpm_test/test_source_parsing.f90 | 6 | ||||
| -rw-r--r-- | test/example_packages/README.md | 6 | ||||
| -rw-r--r-- | test/example_packages/hello_complex_2/app/say_hello/app_hello_mod.f90 | 2 |
13 files changed, 480 insertions, 249 deletions
diff --git a/ci/run_tests.bat b/ci/run_tests.bat index 76e5349..645fd49 100755 --- a/ci/run_tests.bat +++ b/ci/run_tests.bat @@ -15,6 +15,7 @@ if errorlevel 1 exit 1 build\gfortran_debug\app\fpm if errorlevel 1 exit 1 + cd ..\test\example_packages\hello_world if errorlevel 1 exit 1 @@ -25,6 +26,30 @@ if errorlevel 1 exit 1 if errorlevel 1 exit 1 +cd ..\hello_fpm +if errorlevel 1 exit 1 + +..\..\..\fpm\build\gfortran_debug\app\fpm build +if errorlevel 1 exit 1 + +.\build\gfortran_debug\app\hello_fpm +if errorlevel 1 exit 1 + + +cd ..\circular_test +if errorlevel 1 exit 1 + +..\..\..\fpm\build\gfortran_debug\app\fpm build +if errorlevel 1 exit 1 + + +cd ..\circular_example +if errorlevel 1 exit 1 + +..\..\..\fpm\build\gfortran_debug\app\fpm build +if errorlevel 1 exit 1 + + cd ..\hello_complex if errorlevel 1 exit 1 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index adff2b3..7ca33d8 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -12,6 +12,16 @@ cd ../test/example_packages/hello_world ../../../fpm/build/gfortran_debug/app/fpm build ./build/gfortran_debug/app/hello_world +cd ../hello_fpm +../../../fpm/build/gfortran_debug/app/fpm build +./build/gfortran_debug/app/hello_fpm + +cd ../circular_test +../../../fpm/build/gfortran_debug/app/fpm build + +cd ../circular_example +../../../fpm/build/gfortran_debug/app/fpm build + cd ../hello_complex ../../../fpm/build/gfortran_debug/app/fpm build ./build/gfortran_debug/app/say_Hello diff --git a/fpm/app/main.f90 b/fpm/app/main.f90 index be9b805..9982028 100644 --- a/fpm/app/main.f90 +++ b/fpm/app/main.f90 @@ -7,7 +7,8 @@ use fpm_command_line, only: & fpm_test_settings, & fpm_install_settings, & get_command_line_settings -use fpm, only: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test +use fpm, only: cmd_build, cmd_install, cmd_run, cmd_test +use fpm_cmd_new, only: cmd_new implicit none diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 4db35ba..36ee766 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -1,11 +1,10 @@ module fpm - -use fpm_strings, only: string_t, str_ends_with +use fpm_strings, only: string_t, str_ends_with, operator(.in.) use fpm_backend, only: build_package 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, get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS -use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename, mkdir +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, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, & FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST @@ -14,18 +13,134 @@ 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, default_test -use fpm_error, only : error_t +use fpm_error, only : error_t, fatal_error use fpm_manifest_test, only : test_t use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & & stderr=>error_unit +use fpm_manifest_dependency, only: dependency_t implicit none private -public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test +public :: cmd_build, cmd_install, cmd_run, cmd_test contains +recursive subroutine add_libsources_from_package(sources,package_list,package, & + package_root,dev_depends,error) + ! Discover library sources in a package, recursively including dependencies + ! + type(srcfile_t), allocatable, intent(inout), target :: sources(:) + type(string_t), allocatable, intent(inout) :: package_list(:) + type(package_t), intent(in) :: package + character(*), intent(in) :: package_root + logical, intent(in) :: dev_depends + type(error_t), allocatable, intent(out) :: error + + ! Add package library sources + if (allocated(package%library)) then + + call add_sources_from_dir(sources, join_path(package_root,package%library%source_dir), & + FPM_SCOPE_LIB, error=error) + + if (allocated(error)) then + return + end if + + end if + + ! Add library sources from dependencies + if (allocated(package%dependency)) then + + call add_dependencies(package%dependency) + + if (allocated(error)) then + return + end if + + end if + + ! Add library sources from dev-dependencies + if (dev_depends .and. allocated(package%dev_dependency)) then + + call add_dependencies(package%dev_dependency) + + if (allocated(error)) then + return + end if + + end if + + contains + + subroutine add_dependencies(dependency_list) + type(dependency_t), intent(in) :: dependency_list(:) + + integer :: i + type(string_t) :: dep_name + type(package_t) :: dependency + + character(:), allocatable :: dependency_path + + do i=1,size(dependency_list) + + if (dependency_list(i)%name .in. package_list) then + cycle + end if + + if (allocated(dependency_list(i)%git)) then + + dependency_path = join_path('build','dependencies',dependency_list(i)%name) + + if (.not.exists(join_path(dependency_path,'fpm.toml'))) then + call dependency_list(i)%git%checkout(dependency_path, error) + if (allocated(error)) return + end if + + else if (allocated(dependency_list(i)%path)) then + + dependency_path = join_path(package_root,dependency_list(i)%path) + + end if + + call get_package_data(dependency, & + join_path(dependency_path,"fpm.toml"), error) + + if (allocated(error)) then + error%message = 'Error while parsing manifest for dependency package at:'//& + new_line('a')//join_path(dependency_path,"fpm.toml")//& + new_line('a')//error%message + return + end if + + if (.not.allocated(dependency%library) .and. & + exists(join_path(dependency_path,"src"))) then + allocate(dependency%library) + dependency%library%source_dir = "src" + end if + + + call add_libsources_from_package(sources,package_list,dependency, & + package_root=dependency_path, & + dev_depends=.false., error=error) + + if (allocated(error)) then + error%message = 'Error while processing sources for dependency package "'//& + new_line('a')//dependency%name//'"'//& + new_line('a')//error%message + return + end if + + dep_name%s = dependency_list(i)%name + package_list = [package_list, dep_name] + + end do + + end subroutine add_dependencies + +end subroutine add_libsources_from_package + + subroutine build_model(model, settings, package, error) ! Constructs a valid fpm model from command line settings and toml manifest ! @@ -35,8 +150,13 @@ subroutine build_model(model, settings, package, error) type(error_t), allocatable, intent(out) :: error integer :: i + type(string_t), allocatable :: package_list(:) + model%package_name = package%name + allocate(package_list(1)) + package_list(1)%s = package%name + ! #TODO: Choose flags and output directory based on cli settings & manifest inputs model%fortran_compiler = 'gfortran' @@ -98,17 +218,13 @@ subroutine build_model(model, settings, package, error) endif - if (allocated(package%library)) then - - call add_sources_from_dir(model%sources, package%library%source_dir, & - FPM_SCOPE_LIB, error=error) - - if (allocated(error)) then - return - endif - + ! Add library sources, including local dependencies + call add_libsources_from_package(model%sources,package_list,package, & + package_root='.',dev_depends=.true.,error=error) + if (allocated(error)) then + return + end if - endif if(settings%list)then do i=1,size(model%sources) write(stderr,'(*(g0,1x))')'fpm::build<INFO>:file expected at',model%sources(i)%file_name, & @@ -168,160 +284,6 @@ type(fpm_install_settings), intent(in) :: settings error stop 8 end subroutine cmd_install - -subroutine cmd_new(settings) ! --with-executable F --with-test F ' -type(fpm_new_settings), intent(in) :: settings -integer :: ierr -character(len=:),allocatable :: bname ! baeename of NAME -character(len=:),allocatable :: message(:) -character(len=:),allocatable :: littlefile(:) - - call mkdir(settings%name) ! make new directory - call run('cd '//settings%name) ! change to new directory as a test. New OS routines to improve this; system dependent potentially - !! NOTE: need some system routines to handle filenames like "." like realpath() or getcwd(). - bname=basename(settings%name) - - !! weird gfortran bug?? lines truncated to concatenated string length, not 80 - !! hit some weird gfortran bug when littlefile data was an argument to warnwrite(3f), ok when a variable - - call warnwrite(join_path(settings%name, '.gitignore'), ['build/*']) ! create NAME/.gitignore file - - littlefile=[character(len=80) :: '# '//bname, 'My cool new project!'] - - call warnwrite(join_path(settings%name, 'README.md'), littlefile) ! create NAME/README.md - - message=[character(len=80) :: & ! start building NAME/fpm.toml - &'name = "'//bname//'" ', & - &'version = "0.1.0" ', & - &'license = "license" ', & - &'author = "Jane Doe" ', & - &'maintainer = "jane.doe@example.com" ', & - &'copyright = "2020 Jane Doe" ', & - &' ', & - &''] - - if(settings%with_lib)then - call mkdir(join_path(settings%name,'src') ) - message=[character(len=80) :: message, & ! create next section of fpm.toml - &'[library] ', & - &'source-dir="src" ', & - &''] - littlefile=[character(len=80) :: & ! create placeholder module src/bname.f90 - &'module '//bname, & - &' implicit none', & - &' private', & - &'', & - &' public :: say_hello', & - &'contains', & - &' subroutine say_hello', & - &' print *, "Hello, '//bname//'!"', & - &' end subroutine say_hello', & - &'end module '//bname] - ! a proposed alternative default - call warnwrite(join_path(settings%name, 'src', bname//'.f90'), littlefile) ! create NAME/src/NAME.f90 - endif - - if(settings%with_test)then - call mkdir(join_path(settings%name, 'test')) ! create NAME/test or stop - message=[character(len=80) :: message, & ! create next section of fpm.toml - &'[[test]] ', & - &'name="runTests" ', & - &'source-dir="test" ', & - &'main="main.f90" ', & - &''] - - littlefile=[character(len=80) :: & - &'program main', & - &'implicit none', & - &'', & - &'print *, "Put some tests in here!"', & - &'end program main'] - ! a proposed alternative default a little more substantive - call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile) ! create NAME/test/main.f90 - endif - - if(settings%with_executable)then - call mkdir(join_path(settings%name, 'app')) ! create NAME/app or stop - message=[character(len=80) :: message, & ! create next section of fpm.toml - &'[[executable]] ', & - &'name="'//bname//'" ', & - &'source-dir="app" ', & - &'main="main.f90" ', & - &''] - - littlefile=[character(len=80) :: & - &'program main', & - &' use '//bname//', only: say_hello', & - &'', & - &' implicit none', & - &'', & - &' call say_hello', & - &'end program main'] - call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile) - endif - - call warnwrite(join_path(settings%name, 'fpm.toml'), message) ! now that built it write NAME/fpm.toml - - call run('cd ' // settings%name // ';git init') ! assumes these commands work on all systems and git(1) is installed -contains - -subroutine warnwrite(fname,data) -character(len=*),intent(in) :: fname -character(len=*),intent(in) :: data(:) - - if(.not.exists(fname))then - call filewrite(fname,data) - else - write(stderr,'(*(g0,1x))')'fpm::new<WARNING>',fname,'already exists. Not overwriting' - endif - -end subroutine warnwrite - -subroutine filewrite(filename,filedata) -use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit -! write filedata to file filename -character(len=*),intent(in) :: filename -character(len=*),intent(in) :: filedata(:) -integer :: lun, i, ios -character(len=256) :: message - - message=' ' - ios=0 - if(filename.ne.' ')then - open(file=filename, & - & newunit=lun, & - & form='formatted', & ! FORM = FORMATTED | UNFORMATTED - & access='sequential', & ! ACCESS = SEQUENTIAL | DIRECT | STREAM - & action='write', & ! ACTION = READ|WRITE | READWRITE - & position='rewind', & ! POSITION = ASIS | REWIND | APPEND - & status='new', & ! STATUS = NEW | REPLACE | OLD | SCRATCH | UNKNOWN - & iostat=ios, & - & iomsg=message) - else - lun=stdout - ios=0 - endif - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message) - error stop 1 - endif - do i=1,size(filedata) ! write file - write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i)) - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message) - error stop 4 - endif - enddo - close(unit=lun,iostat=ios,iomsg=message) ! close file - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')'*filewrite* error:',trim(message) - error stop 2 - endif -end subroutine filewrite - -end subroutine cmd_new - - subroutine cmd_run(settings) type(fpm_run_settings), intent(in) :: settings character(len=:),allocatable :: release_name, cmd, fname diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 new file mode 100644 index 0000000..fc4c93e --- /dev/null +++ b/fpm/src/fpm/cmd/new.f90 @@ -0,0 +1,164 @@ +module fpm_cmd_new + +use fpm_command_line, only : fpm_new_settings +use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS +use fpm_filesystem, only : join_path, exists, basename, mkdir +use,intrinsic :: iso_fortran_env, only : stderr=>error_unit +implicit none +private +public :: cmd_new + +contains + +subroutine cmd_new(settings) ! --with-executable F --with-test F ' +type(fpm_new_settings), intent(in) :: settings +character(len=:),allocatable :: bname ! baeename of NAME +character(len=:),allocatable :: message(:) +character(len=:),allocatable :: littlefile(:) + + call mkdir(settings%name) ! make new directory + call run('cd '//settings%name) ! change to new directory as a test. System dependent potentially + !! NOTE: need some system routines to handle filenames like "." like realpath() or getcwd(). + bname=basename(settings%name) + + !! weird gfortran bug?? lines truncated to concatenated string length, not 80 + !! hit some weird gfortran bug when littlefile data was an argument to warnwrite(3f), ok when a variable + + call warnwrite(join_path(settings%name, '.gitignore'), ['build/*']) ! create NAME/.gitignore file + + littlefile=[character(len=80) :: '# '//bname, 'My cool new project!'] + + call warnwrite(join_path(settings%name, 'README.md'), littlefile) ! create NAME/README.md + + message=[character(len=80) :: & ! start building NAME/fpm.toml + &'name = "'//bname//'" ', & + &'version = "0.1.0" ', & + &'license = "license" ', & + &'author = "Jane Doe" ', & + &'maintainer = "jane.doe@example.com" ', & + &'copyright = "2020 Jane Doe" ', & + &' ', & + &''] + + if(settings%with_lib)then + call mkdir(join_path(settings%name,'src') ) + message=[character(len=80) :: message, & ! create next section of fpm.toml + &'[library] ', & + &'source-dir="src" ', & + &''] + littlefile=[character(len=80) :: & ! create placeholder module src/bname.f90 + &'module '//bname, & + &' implicit none', & + &' private', & + &'', & + &' public :: say_hello', & + &'contains', & + &' subroutine say_hello', & + &' print *, "Hello, '//bname//'!"', & + &' end subroutine say_hello', & + &'end module '//bname] + ! a proposed alternative default + call warnwrite(join_path(settings%name, 'src', bname//'.f90'), littlefile) ! create NAME/src/NAME.f90 + endif + + if(settings%with_test)then + call mkdir(join_path(settings%name, 'test')) ! create NAME/test or stop + message=[character(len=80) :: message, & ! create next section of fpm.toml + &'[[test]] ', & + &'name="runTests" ', & + &'source-dir="test" ', & + &'main="main.f90" ', & + &''] + + littlefile=[character(len=80) :: & + &'program main', & + &'implicit none', & + &'', & + &'print *, "Put some tests in here!"', & + &'end program main'] + ! a proposed alternative default a little more substantive + call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile) ! create NAME/test/main.f90 + endif + + if(settings%with_executable)then + call mkdir(join_path(settings%name, 'app')) ! create NAME/app or stop + message=[character(len=80) :: message, & ! create next section of fpm.toml + &'[[executable]] ', & + &'name="'//bname//'" ', & + &'source-dir="app" ', & + &'main="main.f90" ', & + &''] + + littlefile=[character(len=80) :: & + &'program main', & + &' use '//bname//', only: say_hello', & + &'', & + &' implicit none', & + &'', & + &' call say_hello', & + &'end program main'] + call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile) + endif + + call warnwrite(join_path(settings%name, 'fpm.toml'), message) ! now that built it write NAME/fpm.toml + + call run('cd ' // settings%name // '&&git init') ! assumes these commands work on all systems and git(1) is installed +contains + +subroutine warnwrite(fname,data) +character(len=*),intent(in) :: fname +character(len=*),intent(in) :: data(:) + + if(.not.exists(fname))then + call filewrite(fname,data) + else + write(stderr,'(*(g0,1x))')'fpm::new<WARNING>',fname,'already exists. Not overwriting' + endif + +end subroutine warnwrite + +subroutine filewrite(filename,filedata) +use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit +! write filedata to file filename +character(len=*),intent(in) :: filename +character(len=*),intent(in) :: filedata(:) +integer :: lun, i, ios +character(len=256) :: message + + message=' ' + ios=0 + if(filename.ne.' ')then + open(file=filename, & + & newunit=lun, & + & form='formatted', & ! FORM = FORMATTED | UNFORMATTED + & access='sequential', & ! ACCESS = SEQUENTIAL | DIRECT | STREAM + & action='write', & ! ACTION = READ|WRITE | READWRITE + & position='rewind', & ! POSITION = ASIS | REWIND | APPEND + & status='new', & ! STATUS = NEW | REPLACE | OLD | SCRATCH | UNKNOWN + & iostat=ios, & + & iomsg=message) + else + lun=stdout + ios=0 + endif + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message) + error stop 1 + endif + do i=1,size(filedata) ! write file + write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i)) + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message) + error stop 4 + endif + enddo + close(unit=lun,iostat=ios,iomsg=message) ! close file + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')'*filewrite* error:',trim(message) + error stop 2 + endif +end subroutine filewrite + +end subroutine cmd_new + +end module fpm_cmd_new diff --git a/fpm/src/fpm/git.f90 b/fpm/src/fpm/git.f90 index 28ae867..187b551 100644 --- a/fpm/src/fpm/git.f90 +++ b/fpm/src/fpm/git.f90 @@ -1,5 +1,6 @@ !> Implementation for interacting with git repositories. module fpm_git + use fpm_error, only: error_t, fatal_error implicit none public :: git_target_t @@ -43,6 +44,9 @@ module fpm_git contains + !> Fetch and checkout in local directory + procedure :: checkout + !> Show information on instance procedure :: info @@ -124,6 +128,54 @@ contains end function git_target_tag + subroutine checkout(self,local_path, error) + + !> Instance of the git target + class(git_target_t), intent(in) :: self + + !> Local path to checkout in + character(*), intent(in) :: local_path + + !> Error + type(error_t), allocatable, intent(out) :: error + + !> git object ref + character(:), allocatable :: object + + !> Stat for execute_command_line + integer :: stat + + if (allocated(self%object)) then + object = self%object + else + object = 'HEAD' + end if + + call execute_command_line("git init "//local_path, exitstat=stat) + + if (stat /= 0) then + call fatal_error(error,'Error while initiating git repository for remote dependency') + return + end if + + call execute_command_line("git -C "//local_path//" fetch "//self%url//& + " "//object, exitstat=stat) + + if (stat /= 0) then + call fatal_error(error,'Error while fetching git repository for remote dependency') + return + end if + + call execute_command_line("git -C "//local_path//" checkout -qf FETCH_HEAD", exitstat=stat) + + if (stat /= 0) then + call fatal_error(error,'Error while checking out git repository for remote dependency') + return + end if + + end subroutine checkout + + !> Show information on git target subroutine info(self, unit, verbosity) diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 40460d7..d7005bf 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -3,7 +3,7 @@ module fpm_backend ! Implements the native fpm build backend use fpm_environment, only: run, get_os_type, OS_WINDOWS -use fpm_filesystem, only: basename, join_path, exists, mkdir +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, & @@ -113,6 +113,10 @@ recursive subroutine build_source(model,source_file,linking) object_file = get_object_name(model,source_file%file_name) + 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 @@ -145,13 +149,6 @@ function get_object_name(model,source_file_name) result(object_file) ! Exclude first directory level from path object_file = source_file_name(index(source_file_name,filesep)+1:) - ! Convert 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 - ! Construct full target path object_file = join_path(model%output_directory, model%package_name, & object_file//'.o') diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 5b9d93a..1a7e4ab 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -416,8 +416,9 @@ contains ' ', & ' The "new" subcommand creates a directory and runs the command ', & ' "git init" in that directory and makes an example "fpm.toml" ', & - ' file, a src/ directory, and optionally a test/ and app/ ', & - ' directory with trivial example Fortran source files. ', & + ' file. and src/ directory and a sample module file. It ', & + ' optionally also creates a test/ and app/ directory with ', & + ' trivial example Fortran program sources. ', & ' ', & ' Remember to update the information in the sample "fpm.toml" ', & ' file with such information as your name and e-mail address. ', & diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index f798276..393c799 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -6,7 +6,7 @@ use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t, & 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, read_lines, list_files +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 implicit none @@ -24,6 +24,33 @@ character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & 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 ! @@ -33,7 +60,7 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) logical, intent(in), optional :: with_executables type(error_t), allocatable, intent(out) :: error - integer :: i, j + integer :: i logical, allocatable :: is_source(:), exclude_source(:) type(string_t), allocatable :: file_names(:) type(string_t), allocatable :: src_file_names(:) @@ -46,13 +73,13 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) if (allocated(sources)) then allocate(existing_src_files(size(sources))) do i=1,size(sources) - existing_src_files(i)%s = sources(i)%file_name + existing_src_files(i)%s = canon_path(sources(i)%file_name) end do else allocate(existing_src_files(0)) end if - is_source = [(.not.(file_names(i)%s .in. existing_src_files) .and. & + is_source = [(.not.(canon_path(file_names(i)%s) .in. existing_src_files) .and. & (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))] @@ -63,26 +90,8 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) do i = 1, size(src_file_names) - if (str_ends_with(lower(src_file_names(i)%s), ".f90")) then - - dir_sources(i) = parse_f_source(src_file_names(i)%s, error) - - if (allocated(error)) then - return - end if - - end if - - if (str_ends_with(lower(src_file_names(i)%s), ".c") .or. & - str_ends_with(lower(src_file_names(i)%s), ".h")) then - - dir_sources(i) = parse_c_source(src_file_names(i)%s,error) - - if (allocated(error)) then - return - end if - - end if + dir_sources(i) = parse_source(src_file_names(i)%s,error) + if (allocated(error)) return dir_sources(i)%unit_scope = scope @@ -93,7 +102,6 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) if (with_executables) then exclude_source(i) = .false. - dir_sources(i)%exe_name = basename(src_file_names(i)%s,suffix=.false.) end if end if @@ -122,49 +130,50 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error) integer :: i, j type(string_t), allocatable :: exe_dirs(:) - logical, allocatable :: include_source(:) - type(srcfile_t), allocatable :: dir_sources(:) + type(srcfile_t) :: exe_source call get_executable_source_dirs(exe_dirs,executables) do i=1,size(exe_dirs) - call add_sources_from_dir(dir_sources,exe_dirs(i)%s, & - scope, with_executables=.true.,error=error) + call add_sources_from_dir(sources,exe_dirs(i)%s, & + scope, with_executables=auto_discover,error=error) if (allocated(error)) then return end if end do - allocate(include_source(size(dir_sources))) + exe_loop: do i=1,size(executables) - do i = 1, size(dir_sources) - - ! Include source by default if not a program or if auto_discover is enabled - include_source(i) = (dir_sources(i)%unit_type /= FPM_UNIT_PROGRAM) .or. & - auto_discover + ! Check if executable already discovered automatically + ! and apply any overrides + do j=1,size(sources) - ! Always include sources specified in fpm.toml - do j=1,size(executables) - - if (basename(dir_sources(i)%file_name,suffix=.true.) == executables(j)%main .and.& - canon_path(dirname(dir_sources(i)%file_name)) == & - canon_path(executables(j)%source_dir) ) then + if (basename(sources(j)%file_name,suffix=.true.) == executables(i)%main .and.& + canon_path(dirname(sources(j)%file_name)) == & + canon_path(executables(i)%source_dir) ) then - include_source(i) = .true. - dir_sources(i)%exe_name = executables(j)%name - exit + sources(j)%exe_name = executables(i)%name + cycle exe_loop end if + end do - end do + ! Add if not already discovered (auto_discovery off) + exe_source = parse_source(join_path(executables(i)%source_dir,executables(i)%main),error) + exe_source%exe_name = executables(i)%name + exe_source%unit_scope = scope + + if (allocated(error)) return - if (.not.allocated(sources)) then - sources = pack(dir_sources,include_source) - else - sources = [sources, pack(dir_sources,include_source)] - end if + if (.not.allocated(sources)) then + sources = [exe_source] + else + sources = [sources, exe_source] + end if + + end do exe_loop end subroutine add_executable_sources @@ -291,21 +300,26 @@ function parse_f_source(f_filename,error) result(f_source) end if ! Process 'INCLUDE' statements - if (index(adjustl(lower(file_lines(i)%s)),'include') == 1) then - - n_include = n_include + 1 + 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 - 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 + + 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 diff --git a/fpm/test/cli_test/cli_test.f90 b/fpm/test/cli_test/cli_test.f90 index fac49e8..b0140e1 100644 --- a/fpm/test/cli_test/cli_test.f90 +++ b/fpm/test/cli_test/cli_test.f90 @@ -193,7 +193,8 @@ use fpm_command_line, only: & fpm_test_settings, & fpm_install_settings, & get_command_line_settings -use fpm, only: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test +use fpm, only: cmd_build, cmd_install, cmd_run, cmd_test +use fpm_cmd_new, only: cmd_new class(fpm_cmd_settings), allocatable :: cmd_settings ! duplicates the calls as seen in the main program for fpm call get_command_line_settings(cmd_settings) diff --git a/fpm/test/fpm_test/test_source_parsing.f90 b/fpm/test/fpm_test/test_source_parsing.f90 index 0b92bef..d1d3e12 100644 --- a/fpm/test/fpm_test/test_source_parsing.f90 +++ b/fpm/test/fpm_test/test_source_parsing.f90 @@ -198,9 +198,11 @@ contains write(unit, '(a)') & & 'program test', & & ' implicit none', & - & ' include "included_file.f90"', & + & ' include "included_file.f90"', & + & ' character(*) :: include_comments', & + & ' include_comments = "some comments"', & & ' contains ', & - & ' include "second_include.f90"', & + & ' include"second_include.f90"', & & 'end program test' close(unit) diff --git a/test/example_packages/README.md b/test/example_packages/README.md index 79fadb1..65f4109 100644 --- a/test/example_packages/README.md +++ b/test/example_packages/README.md @@ -7,11 +7,11 @@ the features demonstrated in each package and which versions of fpm are supporte | Name | Features | Bootstrap (Haskell) fpm | fpm | |---------------------|---------------------------------------------------------------|:-----------------------:|:---:| | auto_discovery_off | Default layout with auto-discovery disabled | N | Y | -| circular_example | Local path dependency; circular dependency | Y | N | -| circular_test | Local path dependency; circular dependency | Y | N | +| circular_example | Local path dependency; circular dependency | Y | Y | +| circular_test | Local path dependency; circular dependency | Y | Y | | hello_complex | Non-standard directory layout; multiple tests and executables | Y | Y | | hello_complex_2 | Auto-discovery of tests and executables with modules | N | Y | -| hello_fpm | App-only; local path dependency | Y | N | +| hello_fpm | App-only; local path dependency | Y | Y | | hello_world | App-only | Y | Y | | makefile_complex | External build command (makefile); local path dependency | Y | N | | program_with_module | App-only; module+program in single source file | Y | Y | diff --git a/test/example_packages/hello_complex_2/app/say_hello/app_hello_mod.f90 b/test/example_packages/hello_complex_2/app/say_hello/app_hello_mod.f90 index 5c426c8..c5795cb 100644 --- a/test/example_packages/hello_complex_2/app/say_hello/app_hello_mod.f90 +++ b/test/example_packages/hello_complex_2/app/say_hello/app_hello_mod.f90 @@ -1,4 +1,6 @@ module app_hello_mod implicit none +integer :: hello_int = 42 + end module app_hello_mod |