More issues for new

README.md

@@ -77,7 +77,7 @@ with the following contents and initialized as a git repository.
 * `fpm test` – run tests
 
 The command `fpm run` can optionally accept the name of the specific executable
-to run, as can `fpm test`; like `fpm run specifc_executable`. Command line
+to run, as can `fpm test`; like `fpm run specific_executable`. Command line
 arguments can also be passed to the executable(s) or test(s) with the option
 `--args "some arguments"`.
 

ci/run_tests.bat

@@ -9,8 +9,10 @@ if errorlevel 1 exit 1
 fpm run
 if errorlevel 1 exit 1
 
+rmdir fpm_scratch_* /s /q
 fpm test
 if errorlevel 1 exit 1
+rmdir fpm_scratch_* /s /q
 
 build\gfortran_debug\app\fpm
 if errorlevel 1 exit 1
@@ -103,4 +105,4 @@ if errorlevel 1 exit 1
 if errorlevel 1 exit 1
 
 .\build\gfortran_debug\app\Program_with_module
-if errorlevel 1 exit 1
+if errorlevel 1 exit 1

ci/run_tests.sh

@@ -5,7 +5,9 @@ set -ex
 cd fpm
 fpm build
 fpm run
+rm -rf fpm_scratch_*/
 fpm test
+rm -rf fpm_scratch_*/
 build/gfortran_debug/app/fpm
 
 cd ../test/example_packages/hello_world

fpm/.gitignore

@@ -1,2 +1 @@
 build/*
-*/FODDER/*

fpm/fpm.toml

@@ -19,7 +19,14 @@ name = "cli-test"
 source-dir = "test/cli_test"
 main = "cli_test.f90"
 
+[[test]]
+name = "new-test"
+source-dir = "test/new_test"
+main = "new_test.f90"
+
 [[test]]
 name = "fpm-test"
 source-dir = "test/fpm_test"
 main = "main.f90"
+
+

fpm/src/fpm.f90

@@ -202,7 +202,7 @@ subroutine cmd_run(settings)
             stop
         endif
     else
-        !! expand names, duplicates are a problem??
+        !*! expand names, duplicates are a problem??
         allocate(foundit(size(settings%name)))
         foundit=.false.
         FINDIT: do i=1,size(package%executable)
@@ -217,18 +217,15 @@ subroutine cmd_run(settings)
         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
+        !*! 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)))
@@ -287,7 +284,7 @@ subroutine cmd_test(settings)
             stop
         endif
     else
-        !! expand names, duplicates are a problem??
+       !*! expand names, duplicates are a problem??
         allocate(foundit(size(settings%name)))
         foundit=.false.
         FINDIT: do i=1,size(package%test)
@@ -302,18 +299,15 @@ subroutine cmd_test(settings)
         do i=1,size(settings%name)
             if(.not.foundit(i))then
                 write(stderr,'(*(g0,1x))')'fpm::run<ERROR>:test',trim(settings%name(i)),'not located'
-            !!elseif(settings%debug)then
-            !!   write(stderr,'(*(g0,1x))')'fpm::run<INFO>:test',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
+        !*! 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>:test expected at',newwords(i),&
             & merge('exists        ','does not exist',exists(newwords(i)))

fpm/src/fpm/cmd/new.f90

@@ -2,51 +2,74 @@ 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 fpm_filesystem, only : join_path, exists, basename, mkdir, is_dir
 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 '
+subroutine cmd_new(settings)
 type(fpm_new_settings), intent(in) :: settings
 character(len=:),allocatable :: bname          ! baeename of NAME
 character(len=:),allocatable :: message(:)
 character(len=:),allocatable :: littlefile(:)
+character(len=8)             :: date
+
+    call date_and_time(DATE=date)
+
+    if(exists(settings%name) .and. .not.settings%backfill )then
+        write(stderr,'(*(g0,1x))')&
+        & 'ERROR: ',settings%name,'already exists.'
+        write(stderr,'(*(g0,1x))')&
+        & '        perhaps you wanted to add --backfill ?'
+        return
+    elseif(is_dir(settings%name) .and. settings%backfill )then
+        write(*,'(*(g0))')'backfilling ',settings%name
+    elseif(exists(settings%name) )then
+        write(stderr,'(*(g0,1x))')&
+        & 'ERROR: ',settings%name,'already exists and is not a directory.'
+        return
+    else
+        ! make new directory
+        call mkdir(settings%name)
+    endif
 
-    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().
+    ! change to new directory as a test. System dependent potentially
+    call run('cd '//settings%name)
+    !*! 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
+    ! create NAME/.gitignore file
+    call warnwrite(join_path(settings%name, '.gitignore'), ['build/*'])
 
     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"          ', &
-    &'                                     ', &
+    ! create NAME/README.md
+    call warnwrite(join_path(settings%name, 'README.md'), littlefile)
+
+    ! start building NAME/fpm.toml
+    message=[character(len=80) ::                 &
+    &'name = "'//bname//'"                     ', &
+    &'version = "0.1.0"                        ', &
+    &'license = "license"                      ', &
+    &'author = "Jane Doe"                      ', &
+    &'maintainer = "jane.doe@example.com"      ', &
+    &'copyright = "'//date(1:4)//' 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
+        ! create next section of fpm.toml
+        message=[character(len=80) ::  message,   &
         &'[library]                            ', &
         &'source-dir="src"                     ', &
         &'']
-        littlefile=[character(len=80) ::          &                             ! create placeholder module src/bname.f90
+        ! create placeholder module src/bname.f90
+        littlefile=[character(len=80) ::          &
         &'module '//bname,                        &
         &'  implicit none',                       &
         &'  private',                             &
@@ -57,69 +80,87 @@ subroutine cmd_new(settings) ! --with-executable F --with-test F '
         &'    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
+        ! create NAME/src/NAME.f90
+        call warnwrite(join_path(settings%name, 'src', bname//'.f90'),&
+         & littlefile)
     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
+
+       ! create NAME/test or stop
+       call mkdir(join_path(settings%name, 'test'))
+        ! create next section of fpm.toml
+        message=[character(len=80) ::  message,   &
         &'[[test]]                             ', &
         &'name="runTests"                      ', &
         &'source-dir="test"                    ', &
         &'main="main.f90"                      ', &
         &'']
 
-        littlefile=[character(len=80) ::        &
+        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
+        ! create NAME/test/main.f90
+        call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile)
     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
+        ! create next section of fpm.toml
+        call mkdir(join_path(settings%name, 'app'))
+        ! create NAME/app or stop
+        message=[character(len=80) ::  message,   &
         &'[[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']
+        if(exists(bname//'/src/'))then
+            littlefile=[character(len=80) ::          &
+            &'program main',                          &
+            &'  use '//bname//', only: say_hello',    &
+            &'  implicit none',                       &
+            &'',                                      &
+            &'  call say_hello()',                    &
+            &'end program main']
+        else
+            littlefile=[character(len=80) ::                 &
+            &'program main',                                 &
+            &'  implicit none',                              &
+            &'',                                             &
+            &'  print *, "hello from project '//bname//'"',  &
+            &'end program main']
+        endif
         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
+    ! now that built it write NAME/fpm.toml
+    call warnwrite(join_path(settings%name, 'fpm.toml'), message)
+    ! assumes git(1) is installed and in path
+    call run('git init ' // settings%name)
 contains
 
 subroutine warnwrite(fname,data)
 character(len=*),intent(in) :: fname
 character(len=*),intent(in) :: data(:)
 
     if(.not.exists(fname))then
-       call filewrite(fname,data)
+        call filewrite(fname,data)
     else
-       write(stderr,'(*(g0,1x))')'fpm::new<WARNING>',fname,'already exists. Not overwriting'
+        write(stderr,'(*(g0,1x))')'INFO:   ',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
+! procedure to write filedata to file filename
+use,intrinsic :: iso_fortran_env, only : &
+ & stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
+
 character(len=*),intent(in)           :: filename
 character(len=*),intent(in)           :: filedata(:)
 integer                               :: lun, i, ios
@@ -130,29 +171,33 @@ subroutine filewrite(filename,filedata)
     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
+        & 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)
+        write(stderr,'(*(a:,1x))')&
+        & '*filewrite* error:',filename,trim(message)
         error stop 1
     endif
-    do i=1,size(filedata)                                                    ! write file
+    ! write file
+    do i=1,size(filedata)
         write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i))
         if(ios.ne.0)then
-            write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message)
+            write(stderr,'(*(a:,1x))')&
+            & '*filewrite* error:',filename,trim(message)
             error stop 4
         endif
     enddo
-    close(unit=lun,iostat=ios,iomsg=message)                                 ! close file
+    ! close file
+    close(unit=lun,iostat=ios,iomsg=message)
     if(ios.ne.0)then
         write(stderr,'(*(a:,1x))')'*filewrite* error:',trim(message)
         error stop 2