aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorinit current directory[i] <urbanjost@comcast.net>2020-09-25 18:49:04 -0400
committerinit current directory[i] <urbanjost@comcast.net>2020-09-25 18:49:04 -0400
commita42775d3ace284d8041d874bdfa7ce9eb947314f (patch)
tree5feaaa3498d8b7133054f5db02395de9690267f8
parentea1dc19a0f73259b34f9b0881b20a090ef95bf0a (diff)
downloadfpm-a42775d3ace284d8041d874bdfa7ce9eb947314f.tar.gz
fpm-a42775d3ace284d8041d874bdfa7ce9eb947314f.zip
RESTORE FROM BACKUP
-rw-r--r--fpm/src/fpm.f90245
-rw-r--r--fpm/src/fpm_command_line.f903
-rw-r--r--fpm/src/fpm_filesystem.f904
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<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
-
+ 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<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)
+ 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