diff options
| -rw-r--r-- | fpm/src/fpm.f90 | 245 | ||||
| -rw-r--r-- | fpm/src/fpm_command_line.f90 | 3 | ||||
| -rw-r--r-- | fpm/src/fpm_filesystem.f90 | 4 |
3 files changed, 215 insertions, 37 deletions
diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 1975d28..d2ba95d 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -5,7 +5,7 @@ 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: join_path, number_of_rows, list_files, exists, basename +use fpm_filesystem, only: join_path, number_of_rows, list_files, exists, basename, mkdir 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 @@ -19,9 +19,10 @@ implicit none private public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test - contains - +!=================================================================================================================================== +!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! +!=================================================================================================================================== subroutine build_model(model, settings, package, error) ! Constructs a valid fpm model from command line settings and toml manifest ! @@ -89,7 +90,9 @@ subroutine build_model(model, settings, package, error) call resolve_module_dependencies(model%sources) end subroutine build_model - +!=================================================================================================================================== +!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! +!=================================================================================================================================== subroutine cmd_build(settings) type(fpm_build_settings), intent(in) :: settings type(package_t) :: package @@ -126,21 +129,51 @@ end if call build_package(model) -end subroutine - +end subroutine cmd_build +!=================================================================================================================================== +!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! +!=================================================================================================================================== subroutine cmd_install(settings) type(fpm_install_settings), intent(in) :: settings print *, "fpm error: 'fpm install' not implemented." error stop 1 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 :: bname - bname=basename(settings%name) !! new basename(dirname) if full paths are allowed ??? - - message=[character(len=80) :: & ! create fpm.toml +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 depenent potentially + call mkdir(join_path(settings%name,'src') ) + !! 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 + littlefile=[character(len=80) :: & + &'module '//bname, & + &' implicit none', & + &' private', & + &'', & + &' public :: say_hello', & + &'contains', & + &' subroutine say_hello', & + &' print *, "Hello, '//bname//'!"', & + &' end subroutine say_hello', & + &'end module '//bname] + call warnwrite(join_path(settings%name, 'src', bname//'.f90'), littlefile) ! create NAME/src/NAME.f90 + + 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) :: & ! build NAME/fpm.toml &'name = "'//bname//'" ', & &'version = "0.1.0" ', & &'license = "license" ', & @@ -153,46 +186,188 @@ character(len=:),allocatable :: bname &''] if(settings%with_test)then - message=[character(len=80) :: message, & ! create next section of fpm.toml + message=[character(len=80) :: message, & ! create next section of fpm.toml &'[[test]] ', & &'name="runTests" ', & &'source-dir="test" ', & &'main="main.f90" ', & &''] + + call mkdir(join_path(settings%name, 'test')) ! create NAME/test or stop + littlefile=[character(len=80) :: & + &'program main', & + &'implicit none', & + &'', & + &'print *, "Put some tests in here!"', & + &'end program main'] + call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile) ! create NAME/test/main.f90 endif if(settings%with_executable)then - message=[character(len=80) :: message, & ! create next section of fpm.toml + message=[character(len=80) :: message, & ! create next section of fpm.toml &'[[executable]] ', & &'name="'//bname//'" ', & &'source-dir="app" ', & &'main="main.f90" ', & &''] + + call mkdir(join_path(settings%name, 'app')) ! create NAME/app or stop + 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 - write(*,'(a)')message - print *, "fpm error: 'fpm new' not implemented." - error stop 1 -end subroutine cmd_new + 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) + 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 - integer :: i - - write(*,*)'RELEASE=',settings%release - if(size(settings%name).eq.0)then - write(*,*)'RUN DEFAULTS with arguments ['//settings%args//']' - else - do i=1,size(settings%name) - write(*,*)'RUN:'//trim(settings%name(i))//' with arguments ['//settings%args//']' - enddo - endif - - print *, "fpm error: 'fpm run' not implemented." - error stop 1 - +type(fpm_run_settings), intent(in) :: settings +character(len=:),allocatable :: release_name, cmd, fname +integer :: i, j +type(package_t) :: package +type(error_t), allocatable :: error +character(len=:),allocatable :: newwords(:) +logical,allocatable :: foundit(:) +logical :: list + call get_package_data(package, "fpm.toml", error) + if (allocated(error)) then + print '(a)', error%message + stop + endif + release_name=trim(merge('gfortran_release','gfortran_debug ',settings%release)) + newwords=[character(len=0) ::] + ! Populate executable in case we find the default app directory + if (.not.allocated(package%executable) .and. exists("app")) then + allocate(package%executable(1)) + call default_executable(package%executable(1), package%name) + endif + if(size(settings%name).eq.0)then + if ( .not.allocated(package%executable) ) then + write(stderr,'(*(g0,1x))')'fpm::run<INFO>:no executables found in fpm.toml and no default app/ directory' + stop + endif + allocate(foundit(size(package%executable))) + do i=1,size(package%executable) + fname=join_path('build',release_name,package%executable(i)%source_dir,package%executable(i)%name) + newwords=[character(len=max(len(newwords),len(fname))) :: newwords,fname] + enddo + if(size(newwords).lt.1)then + write(stderr,'(*(g0,1x))')'fpm::run<INFO>:no executables found in fpm.toml' + stop + endif + else + !! expand names, duplicates are a problem?? + allocate(foundit(size(settings%name))) + foundit=.false. + FINDIT: do i=1,size(package%executable) + do j=1,size(settings%name) + if(settings%name(j).eq.package%executable(i)%name)then + fname=join_path('build',release_name,package%executable(i)%source_dir,package%executable(i)%name) + newwords=[character(len=max(len(newwords),len(fname))) :: newwords,fname] + foundit(j)=.true. + endif + enddo + enddo FINDIT + do i=1,size(settings%name) + if(.not.foundit(i))then + write(stderr,'(*(g0,1x))')'fpm::run<ERROR>:executable',trim(settings%name(i)),'not located' + !!elseif(settings%debug)then + !! write(stderr,'(*(g0,1x))')'fpm::run<INFO>:executable',trim(settings%name(i)),'located at',newwords(i),& + !! & merge('exists ','does not exist',exists(trim(settings%name(i)))) + endif + enddo + if(allocated(foundit))deallocate(foundit) + endif + do i=1,size(newwords) + !! list is a new option for use with xargs, to move files to production area, valgrind, gdb, ls -l, .... + !! maybe add as --mask and could do --mask 'echo %xx' or --mask 'cp %XX /usr/local/bin/' an so on + !! default if blank would be filename uptodate|needs|updated|doesnotexist creation_date, ... + !! or maybe just list filenames so can pipe through xargs, and so on + if(settings%list)then + write(stderr,'(*(g0,1x))')'fpm::run<INFO>:executable expected at',newwords(i),& + & merge('exists ','does not exist',exists(newwords(i))) + cycle + endif + cmd=newwords(i) // ' ' // settings%args + if(exists(newwords(i)))then + call run(cmd) + else ! try to build + !!call cmd_build() + if(exists(newwords(i)))then + call run(cmd) + else + write(stderr,*)'fpm::run<ERROR>',cmd,' not found' + endif + endif + enddo + deallocate(newwords) end subroutine cmd_run - +!=================================================================================================================================== +!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! +!=================================================================================================================================== subroutine cmd_test(settings) type(fpm_test_settings), intent(in) :: settings character(len=:),allocatable :: release_name @@ -214,5 +389,7 @@ subroutine cmd_test(settings) print *, "fpm error: 'fpm test' not implemented." error stop 1 end subroutine cmd_test - +!=================================================================================================================================== +!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! +!=================================================================================================================================== end module fpm diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 84b4693..9f9dcbe 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -123,7 +123,8 @@ contains endif allocate(fpm_run_settings :: cmd_settings) - cmd_settings=fpm_run_settings( name=names, release=lget('release'), args=remaining ) + cmd_settings=fpm_run_settings( name=names, list=lget('list'), & + & release=lget('release'), args=remaining ) case('build') help_text=[character(len=80) :: & diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index 488a202..9acbb85 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -135,11 +135,11 @@ subroutine mkdir(dir) select case (get_os_type()) case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD) call execute_command_line('mkdir -p ' // dir, exitstat=stat) - write (*, '(2a)') 'mkdir -p ' // dir + write (*, '(" + ",2a)') 'mkdir -p ' // dir case (OS_WINDOWS) call execute_command_line("mkdir " // windows_path(dir), exitstat=stat) - write (*, '(2a)') 'mkdir ' // windows_path(dir) + write (*, '(" + ",2a)') 'mkdir ' // windows_path(dir) end select if (stat /= 0) then |