beta test of new subcommand

3 files changed, 322 insertions, 30 deletions

diff --git a/fpm/fpm.toml b/fpm/fpm.toml
index 532e010..8b4d8a3 100644
--- a/fpm/fpm.toml
+++ b/fpm/fpm.toml
@@ -23,6 +23,11 @@ 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"
diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90
index 59c7d5a..671d17f 100644
--- a/fpm/src/fpm_command_line.f90
+++ b/fpm/src/fpm_command_line.f90
@@ -124,20 +124,20 @@ contains
                                              & list=lget('list') )
 
         case('new')
-            call set_args(' --lib F --app F --test F --backfill F', &
+            call set_args(' --src F --lib F --app F --test F --backfill F', &
             & help_new, version_text)
             select case(size(unnamed))
             case(1)
                 write(stderr,'(*(g0,/))')'ERROR: directory name required'
                 write(stderr,'(*(7x,g0,/))') &
-                & 'usage: fpm new NAME [--lib] [--app] [--test] [--backfill]'
+                & 'usage: fpm new NAME [--lib|--src] [--app] [--test] [--backfill]'
                 stop 1
             case(2)
                 name=trim(unnamed(2))
             case default
                 write(stderr,'(g0)')'ERROR: only one directory name allowed'
                 write(stderr,'(7x,g0)') &
-                & 'usage: fpm new NAME [--lib] [--app] [--test] [--backfill]'
+                & 'usage: fpm new NAME [--lib|--src] [--app] [--test] [--backfill]'
                 stop 2
             end select
             !! canon_path is not converting ".", etc.
@@ -154,11 +154,11 @@ contains
 
             allocate(fpm_new_settings :: cmd_settings)
 
-            if (any( specified(['lib ','app ','test']) ) )then
-                cmd_settings=fpm_new_settings(name=name, &
-                 & with_executable=lget('app'),          &
-                 & with_test=lget('test'),               &
-                 & with_lib=lget('lib'),                 &
+            if (any( specified(['src ','lib ','app ','test']) ) )then
+                cmd_settings=fpm_new_settings(name=name,    &
+                 & with_executable=lget('app'),             &
+                 & with_test=lget('test'),                  &
+                 & with_lib=any([lget('lib'),lget('src')]), &
                  & backfill=lget('backfill') )
             else
                 cmd_settings=fpm_new_settings(name=name, &
@@ -246,7 +246,9 @@ contains
             if(lget('list'))then
                help_text=help_list_dash
             elseif(len_trim(cmdarg).eq.0)then
-                write(stderr,'(*(a))')'ERROR: missing subcommand. Must be one of'
+                write(stdout,'(*(a))')'Fortran Package Manager:'
+                write(stdout,'(*(a))')' '
+                write(stdout,'(*(a))')' subcommand may be one of'
                 call printhelp(help_list_nodash)
             else
                 write(stderr,'(*(a))')'ERROR: unknown subcommand [', &
@@ -297,7 +299,7 @@ contains
     '                                                                       ', &
    ' build [--release] [--list]                                             ', &
    ' help [NAME(s)]                                                         ', &
-   ' new NAME [--lib] [--app] [--test] [--backfill]                         ', &
+   ' new NAME [--lib|--src] [--app] [--test] [--backfill]                   ', &
    ' list [--list]                                                          ', &
    ' run [NAME(s)] [--release] [--list] [-- ARGS]                           ', &
    ' test [NAME(s)] [--release] [--list] [-- ARGS]                          ', &
@@ -314,8 +316,7 @@ contains
     help_fpm=[character(len=80) :: &
     'NAME                                                                   ', &
     '   fpm(1) - A Fortran package manager and build system                 ', &
-    'OS TYPE' ]
-    help_fpm=[character(len=80) :: help_fpm, &
+    '                                                                       ', &
     'SYNOPSIS                                                               ', &
     '   fpm SUBCOMMAND [SUBCOMMAND_OPTIONS]                                 ', &
     '                                                                       ', &
@@ -342,7 +343,7 @@ contains
     '                                                                       ', &
     '     build [--release] [--list]                                        ', &
     '                     Compile the packages into the "build/" directory. ', &
-    '     new NAME [--lib] [--app] [--test] [--backfill]                    ', &
+    '     new NAME [--lib|--src] [--app] [--test] [--backfill]              ', &
     '                     Create a new Fortran package directory            ', &
     '                     with sample files                                 ', &
     '     run [NAME(s)] [--release] [--list] [-- ARGS]                      ', &
@@ -364,6 +365,7 @@ contains
     '  --help     Show help text and exit. Valid for all subcommands.       ', &
     '  --version  Show version information and exit. Valid for all          ', &
     '             subcommands.                                              ', &
+    '                                                                       ', &
     'EXAMPLES                                                               ', &
     '   sample commands:                                                    ', &
     '                                                                       ', &
@@ -373,6 +375,7 @@ contains
     '    fpm run                                                            ', &
     '    fpm new --help                                                     ', &
     '    fpm run myprogram --release -- -x 10 -y 20 --title "my title"      ', &
+    '                                                                       ', &
     'SEE ALSO                                                               ', &
     '   The fpm(1) home page at https://github.com/fortran-lang/fpm         ', &
     '']
@@ -397,6 +400,7 @@ contains
     '                                                                       ', &
     '  fpm list                                                             ', &
     '  fpm --list                                                           ', &
+    '                                                                       ', &
     'SEE ALSO                                                               ', &
     ' The fpm(1) home page at https://github.com/fortran-lang/fpm           ', &
     '' ]
@@ -434,12 +438,14 @@ contains
     '                                                                       ', &
     '  # run production version of two applications                         ', &
     '  fpm run prg1 prg2 --release                                          ', &
+    '                                                                       ', &
     'SEE ALSO                                                               ', &
     ' The fpm(1) home page at https://github.com/fortran-lang/fpm           ', &
     '' ]
     help_build=[character(len=80) :: &
     'NAME                                                                   ', &
     ' build(1) - the fpm(1) subcommand to build a project                   ', &
+    '                                                                       ', &
     'SYNOPSIS                                                               ', &
     ' fpm build [--release]|[-list]                                         ', &
     '                                                                       ', &
@@ -473,6 +479,7 @@ contains
     '                                                                       ', &
     '  fpm build           # build with debug options                       ', &
     '  fpm build --release # build with high optimization                   ', &
+    '                                                                       ', &
     'SEE ALSO                                                               ', &
     ' The fpm(1) home page at https://github.com/fortran-lang/fpm           ', &
     '' ]
@@ -505,6 +512,7 @@ contains
     '                 fortran documentation. Entries should be in           ', &
     '                 uppercase to avoid conflicts with fpm(1) topics;      ', &
     '                 but can be in lowercase if there is no conflict.      ', &
+    '                                                                       ', &
     'EXAMPLES                                                               ', &
     '   Sample usage:                                                       ', &
     '                                                                       ', &
@@ -527,7 +535,7 @@ contains
     'NAME                                                                   ', &
     ' new(1) - the fpm(1) subcommand to initialize a new project            ', &
     'SYNOPSIS                                                               ', &
-    ' fpm new NAME [--lib] [--app] [--test] [--backfill]                    ', &
+    ' fpm new NAME [--lib|--src] [--app] [--test] [--backfill]              ', &
     '                                                                       ', &
     ' fpm new --help|--version                                              ', &
     '                                                                       ', &
@@ -564,26 +572,26 @@ contains
     ' directories. If any of the following options are specified            ', &
     ' then only specified subdirectories are generated:                     ', &
     '                                                                       ', &
-    ' --lib       create directory src/ and a placeholder module            ', &
-    '             named "NAME.f90" for use with subcommand "build".         ', &
-    ' --app       create directory app/ and a placeholder main              ', &
-    '             program for use with subcommand "run".                    ', &
-    ' --test      create directory test/ and a placeholder program          ', &
-    '             for use with the subcommand "test". Note that sans        ', &
-    '             "--lib" it really does not have anything to test.         ', &
+    ' --lib,--src  create directory src/ and a placeholder module           ', &
+    '              named "NAME.f90" for use with subcommand "build".        ', &
+    ' --app        create directory app/ and a placeholder main             ', &
+    '              program for use with subcommand "run".                   ', &
+    ' --test       create directory test/ and a placeholder program         ', &
+    '              for use with the subcommand "test". Note that sans       ', &
+    '              "--lib" it really does not have anything to test.        ', &
     '                                                                       ', &
     ' So the default is equivalent to "fpm NAME --lib --app --test".        ', &
     '                                                                       ', &
-    ' --backfill  By default the directory must not exist. If this          ', &
-    '             option is present the directory may pre-exist and         ', &
-    '             only subdirectories and files that do not                 ', &
-    '             already exist will be created. For example, if you        ', &
-    '             previously entered "fpm new myname --lib" entering        ', &
-    '             "fpm new myname --backfill" will create the missing       ', &
-    '             app/ and test/ directories and programs.                  ', &
+    ' --backfill   By default the directory must not exist. If this         ', &
+    '              option is present the directory may pre-exist and        ', &
+    '              only subdirectories and files that do not                ', &
+    '              already exist will be created. For example, if you       ', &
+    '              previously entered "fpm new myname --lib" entering       ', &
+    '              "fpm new myname --backfill" will create the missing      ', &
+    '              app/ and test/ directories and programs.                 ', &
     '                                                                       ', &
-    ' --help      print this help and exit                                  ', &
-    ' --version   print program version information and exit                ', &
+    ' --help       print this help and exit                                 ', &
+    ' --version    print program version information and exit               ', &
     '                                                                       ', &
     'EXAMPLES                                                               ', &
     ' Sample use                                                            ', &
@@ -594,6 +602,7 @@ contains
     '   fpm build                                                           ', &
     '   fpm run            # run example application program                ', &
     '   fpm test           # run example test program                       ', &
+    '                                                                       ', &
     'SEE ALSO                                                               ', &
     ' The fpm(1) home page at https://github.com/fortran-lang/fpm           ', &
     '                                                                       ', &
@@ -632,6 +641,7 @@ contains
     ' fpm test mytest -- -x 10 -y 20 --title "my title line"                ', &
     '                                                                       ', &
     ' fpm test tst1 tst2 --release # production version of two tests        ', &
+    '                                                                       ', &
     'SEE ALSO                                                               ', &
     ' The fpm(1) home page at https://github.com/fortran-lang/fpm           ', &
     '' ]
diff --git a/fpm/test/new_test/new_test.f90 b/fpm/test/new_test/new_test.f90
new file mode 100644
index 0000000..3fdf159
--- /dev/null
+++ b/fpm/test/new_test/new_test.f90
@@ -0,0 +1,277 @@
+program new_test
+use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
+use fpm_filesystem,  only : is_dir, list_files, exists
+use fpm_strings,     only : string_t 
+use fpm_environment, only : run, get_os_type 
+use fpm_environment, only : OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_WINDOWS
+type(string_t), allocatable    :: file_names(:)
+character(len=:), allocatable  :: directory
+integer                        :: i, j, k
+character(len=*),parameter     :: cmdpath = 'build/gfortran_debug/app/fpm'
+character(len=:),allocatable   :: path
+character(len=*),parameter     :: cmds(*) = [character(len=80) :: &
+' new', &
+' new no-no', &
+' new A', &
+' new B --lib', &
+' new C --app', &
+' new D --test', &
+' new E --lib --test ', &
+' new F --lib --app', &
+' new G --test --app', &
+' new BB --lib', &
+' new BB --test ', &
+' new BB --backfill --test', &
+' new CC --test --src --app', &
+' new --version', &
+' new --help']
+integer :: estat, cstat
+character(len=256)            :: message
+character(len=:),allocatable  :: directories(:)
+character(len=:),allocatable  :: expected(:)
+logical,allocatable           :: tally(:)
+   write(*,'(g0:,1x)')'TEST new SUBCOMMAND (draft):'
+   allocate(tally(0))
+   directories=[character(len=80) :: 'A','B','C','D','E','F','G','BB','CC']
+
+   do i=1,size(directories)
+      if( is_dir(trim(directories(i))) ) then
+         write(*,*)'ERROR:',trim( directories(i) ),' already exists'
+         write(*,*)'        you must remove scratch directories before performing this test'
+         write(*,'(*(g0:,1x))')'directories:',(trim(directories(j)),j=1,size(directories)),'no-no'
+         stop
+      endif
+   enddo
+
+   !! SEE IF EXPECTED FILES ARE GENERATED
+   !! DOS versus POSIX filenames
+   ! assuming fpm command is in path and the new version
+    select case (get_os_type()) 
+    case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD)
+       path=cmdpath
+    case (OS_WINDOWS) 
+       path=u2d(cmdpath)
+    case default
+       write(*,*)'ERROR: unknown OS. Stopping test'
+       stop 2
+    end select 
+
+
+   do i=1,size(cmds)
+      message=''
+      call execute_command_line(cmdpath//''//cmds(i),exitstat=estat,cmdstat=cstat,cmdmsg=message)
+      write(*,'(*(g0))')'CMD=',trim(cmds(i)),' EXITSTAT=',estat,' CMDSTAT=',cstat,' MESSAGE=',trim(message)
+   enddo
+
+   if( is_dir('no-no') ) then
+       tally=[tally,.false.]
+       write(*,*)'ERROR: directory no-no/ exists'
+    else
+       tally=[tally,.true.]
+    endif
+
+   ! assuming hidden files in .git and .gitignore are ignored for now
+   TESTS: do i=1,size(directories)
+      ! test if expected directory exists
+      if( .not. is_dir(trim(directories(i))) ) then
+         tally=[tally,.false.]
+         write(*,*)'ERROR:',trim( directories(i) ),' is not a directory'
+      else
+         select case(directories(i))
+         case('A')
+          expected=[ character(len=80)::&
+          &'A/app','A/fpm.toml','A/README.md','A/src','A/test','A/app/main.f90','A/src/A.f90','A/test/main.f90']
+         case('B')
+          expected=[ character(len=80)::&
+          &'B/fpm.toml','B/README.md','B/src','B/src/B.f90']
+         case('C')
+          expected=[ character(len=80)::&
+          &'C/app','C/fpm.toml','C/README.md','C/app/main.f90']
+         case('D')
+          expected=[ character(len=80)::&
+          &'D/fpm.toml','D/README.md','D/test','D/test/main.f90']
+         case('E')
+          expected=[ character(len=80)::&
+          &'E/fpm.toml','E/README.md','E/src','E/test','E/src/E.f90','E/test/main.f90']
+         case('F')
+          expected=[ character(len=80)::&
+          &'F/app','F/fpm.toml','F/README.md','F/src','F/app/main.f90','F/src/F.f90']
+         case('G')
+          expected=[ character(len=80)::&
+          &'G/app','G/fpm.toml','G/README.md','G/test','G/app/main.f90','G/test/main.f90']
+         case('BB')
+          expected=[ character(len=80)::&
+          &'BB/fpm.toml','BB/README.md','BB/src','BB/test','BB/src/BB.f90','BB/test/main.f90']
+         case('CC')
+          expected=[ character(len=80)::&
+          &'CC/app','CC/fpm.toml','CC/README.md','CC/src','CC/test','CC/app/main.f90','CC/src/CC.f90','CC/test/main.f90']
+         case default
+            write(*,*)'ERROR: internal error. unknown directory name ',trim(directories(i))
+            stop 4
+         end select
+         call list_files(trim(directories(i)), file_names,recurse=.true.)
+         write(*,'(*(g0))',advance='no')'>>>DIRECTORY ',trim(directories(i)),':   '
+         write(*,'(*(g0:,", "))')( file_names(j)%s, j=1,size(file_names) )
+         if(size(expected).ne.size(file_names))then
+            write(*,*)'unexpected number of files in file list=',size(file_names),' expected ',size(directories)
+            tally=[tally,.false.]
+            cycle TESTS
+         else
+            select case (get_os_type()) 
+            case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD)
+            case (OS_WINDOWS) 
+               do j=1,size(expected)
+                  expected(j)=u2d(expected(j))
+               enddo 
+            case default
+               write(*,*)'ERROR: unknown OS. Stopping test'
+               stop 3
+            end select 
+            do j=1,size(expected)
+               if( .not.any(file_names(j)%s==expected) )then
+                  tally=[tally,.false.]
+                  write(*,'("ERROR: EXPECTED ",*(g0:,", "))')( trim(expected(k)), k=1,size(expected) )
+                  write(*,'(*(g0))')'       NO MATCH FOR ',file_names(j)%s
+                  cycle TESTS
+               endif
+            enddo
+            tally=[tally,.true.]
+         endif
+      endif
+   enddo TESTS
+   write(*,'("TALLY=",*(g0))')tally
+   if(all(tally))then
+      write(*,'(*(g0))')'PASSED: all ',count(tally),' tests passed '
+   else
+      write(*,*)'FAILED: PASSED=',count(tally),' FAILED=',count(.not.tally)
+      stop 5
+   endif
+!-----------------------------------------------------------------------------------------------------------------------------------
+contains
+!-----------------------------------------------------------------------------------------------------------------------------------
+function u2d(pathname) result(dos)
+! simplistically replace / with \ to make posix pathname DOS pathname
+character(len=*),intent(in) :: pathname
+character(len=:),allocatable :: dos
+integer :: i
+dos=pathname
+do i=1,len(pathname)
+   if(pathname(i:i).eq.'/')dos(i:i)='\'
+enddo
+end function u2d
+!-----------------------------------------------------------------------------------------------------------------------------------
+function djb2_hash_arr(chars,continue) result(hash_128)
+use,intrinsic :: ISO_FORTRAN_ENV, only : int8,int16,int32,int64
+implicit none
+
+!$@(#) djb2_hash(3fp): DJB2 hash of array (algorithm by Daniel J. Bernstein ) for character array
+
+character(len=1),intent(in)  :: chars(:)
+logical,intent(in),optional  :: continue
+integer                      :: i
+integer(kind=int64)          :: hash_128
+integer(kind=int64),save     :: hash_64=5381
+
+   if(present(continue))then
+      hash_64 = hash_64
+   else
+      hash_64 = 5381_int64
+   endif
+   do i=1,size(chars)
+      hash_64 = (ishft(hash_64,5) + hash_64) + ichar(chars(i),kind=int64)
+   enddo
+   hash_128=transfer([hash_64,0_int64],hash_128)
+      DEBUG : block
+         integer :: ios
+         write(6,'("*djb2_hash*       hashing string=",*(a))',advance='no')chars
+         write(6,'(1x,"hash=",i0,1x,"hex hash=",z32.32)')hash_128,hash_128
+         flush(6,iostat=ios)
+      endblock DEBUG
+end function djb2_hash_arr
+!-----------------------------------------------------------------------------------------------------------------------------------
+subroutine slurp(filename,text,length,lines)
+use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
+implicit none
+
+!$@(#) M_io::slurp(3f): allocate text array and read file filename into it
+
+class(*),intent(in)                      :: filename    ! filename to shlep
+character(len=1),allocatable,intent(out) :: text(:)     ! array to hold file
+integer,intent(out),optional             :: length      ! length of longest line
+integer,intent(out),optional             :: lines       ! number of lines
+
+integer :: nchars=0             ! holds size of file
+integer :: igetunit             ! use newunit=igetunit in f08
+integer :: ios=0                ! used for I/O error status
+integer :: length_local
+integer :: lines_local
+integer :: i
+integer :: icount
+character(len=256)  :: message
+character(len=4096) :: local_filename
+
+   length_local=0
+   lines_local=0
+
+   message=''
+      select type(FILENAME)
+       type is (character(len=*))
+          open(newunit=igetunit, file=trim(filename), action="read", iomsg=message,&
+           &form="unformatted", access="stream",status='old',iostat=ios)
+          local_filename=filename
+       type is (integer)
+          rewind(unit=filename,iostat=ios,iomsg=message)
+          write(local_filename,'("unit ",i0)')filename
+          igetunit=filename
+      end select
+
+   if(ios.eq.0)then  ! if file was successfully opened
+
+      inquire(unit=igetunit, size=nchars)
+
+      if(nchars.le.0)then
+         call stderr_local( '*slurp* empty file '//trim(local_filename) )
+         return
+      endif
+      ! read file into text array
+      !
+      if(allocated(text))deallocate(text) ! make sure text array not allocated
+      allocate ( text(nchars) )           ! make enough storage to hold file
+      read(igetunit,iostat=ios,iomsg=message) text      ! load input file -> text array
+      if(ios.ne.0)then
+         call stderr_local( '*slurp* bad read of '//trim(local_filename)//':'//trim(message) )
+      endif
+   else
+      call stderr_local('*slurp* '//message)
+      allocate ( text(0) )           ! make enough storage to hold file
+   endif
+
+   close(iostat=ios,unit=igetunit)            ! close if opened successfully or not
+
+   if(present(lines).or.present(length))then  ! get length of longest line and number of lines
+      icount=0
+      do i=1,nchars
+         if(text(i).eq.NEW_LINE('A'))then
+            lines_local=lines_local+1
+            length_local=max(length_local,icount)
+            icount=0
+         endif
+         icount=icount+1
+      enddo
+      if(nchars.ne.0)then
+         if(text(nchars).ne.NEW_LINE('A'))then
+            lines_local=lines_local+1
+            length_local=max(length_local,icount)
+         endif
+      endif
+      if(present(lines))lines=lines_local
+      if(present(length))length=length_local
+   endif
+end subroutine slurp
+!-----------------------------------------------------------------------------------------------------------------------------------
+subroutine stderr_local(message)
+character(len=*) :: message
+   write(stderr,'(a)')trim(message)    ! write message to standard error
+end subroutine stderr_local
+!-----------------------------------------------------------------------------------------------------------------------------------
+end program new_test