RESTORE

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