From a42775d3ace284d8041d874bdfa7ce9eb947314f Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Fri, 25 Sep 2020 18:49:04 -0400 Subject: RESTORE FROM BACKUP --- fpm/src/fpm.f90 | 245 ++++++------------------------------------- fpm/src/fpm_command_line.f90 | 3 +- fpm/src/fpm_filesystem.f90 | 4 +- 3 files changed, 37 insertions(+), 215 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index d2ba95d..1975d28 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, mkdir +use fpm_filesystem, only: join_path, number_of_rows, list_files, exists, basename 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,10 +19,9 @@ 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 ! @@ -90,9 +89,7 @@ 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 @@ -129,51 +126,21 @@ end if call build_package(model) -end subroutine cmd_build -!=================================================================================================================================== -!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! -!=================================================================================================================================== +end subroutine + 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 :: 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 +character(len=:),allocatable :: bname + bname=basename(settings%name) !! new basename(dirname) if full paths are allowed ??? + + message=[character(len=80) :: & ! create fpm.toml &'name = "'//bname//'" ', & &'version = "0.1.0" ', & &'license = "license" ', & @@ -186,188 +153,46 @@ character(len=:),allocatable :: littlefile(:) &''] 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 - 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',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 - + write(*,'(a)')message + print *, "fpm error: 'fpm new' not implemented." + error stop 1 end subroutine cmd_new -!=================================================================================================================================== -!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! -!=================================================================================================================================== + subroutine cmd_run(settings) -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: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: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:executable',trim(settings%name(i)),'not located' - !!elseif(settings%debug)then - !! write(stderr,'(*(g0,1x))')'fpm::run: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: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',cmd,' not found' - endif - endif - enddo - deallocate(newwords) + 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 + end subroutine cmd_run -!=================================================================================================================================== -!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! -!=================================================================================================================================== + subroutine cmd_test(settings) type(fpm_test_settings), intent(in) :: settings character(len=:),allocatable :: release_name @@ -389,7 +214,5 @@ 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 9f9dcbe..84b4693 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -123,8 +123,7 @@ contains endif allocate(fpm_run_settings :: cmd_settings) - cmd_settings=fpm_run_settings( name=names, list=lget('list'), & - & release=lget('release'), args=remaining ) + cmd_settings=fpm_run_settings( name=names, 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 9acbb85..488a202 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 -- cgit v1.2.3