aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--fpm/src/fpm_command_line.f906
-rw-r--r--fpm/test/new_test/new_test.f90225
2 files changed, 42 insertions, 189 deletions
diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90
index 6d4abee..1ea170e 100644
--- a/fpm/src/fpm_command_line.f90
+++ b/fpm/src/fpm_command_line.f90
@@ -130,14 +130,14 @@ contains
case(1)
write(stderr,'(*(g0,/))')'ERROR: directory name required'
write(stderr,'(*(7x,g0,/))') &
- & 'usage: fpm new NAME [--lib|--src] [--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|--src] [--app] [--test] [--backfill]'
+ & 'USAGE: fpm new NAME [--lib|--src] [--app] [--test] [--backfill]'
stop 2
end select
!! canon_path is not converting ".", etc.
@@ -648,7 +648,7 @@ contains
help_install=[character(len=80) :: &
' fpm(1) subcommand "install" ', &
' ', &
- ' Usage: fpm install NAME ', &
+ ' USAGE: fpm install NAME ', &
'' ]
end subroutine set_help
diff --git a/fpm/test/new_test/new_test.f90 b/fpm/test/new_test/new_test.f90
index 289431e..06f0c8a 100644
--- a/fpm/test/new_test/new_test.f90
+++ b/fpm/test/new_test/new_test.f90
@@ -1,12 +1,10 @@
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_filesystem, only : is_dir, list_files, exists, windows_path
+use fpm_strings, only : string_t, operator(.in.)
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 :: fnames(:)
-character(len=:), allocatable :: directory
integer :: i, j, k
character(len=*),parameter :: cmdpath = 'build/gfortran_debug/app/fpm'
character(len=:),allocatable :: path
@@ -31,6 +29,7 @@ character(len=256) :: message
character(len=:),allocatable :: directories(:)
character(len=:),allocatable :: expected(:)
logical,allocatable :: tally(:)
+logical :: IS_OS_WINDOWS
write(*,'(g0:,1x)')'TEST new SUBCOMMAND (draft):'
allocate(tally(0))
directories=[character(len=80) :: 'A','B','C','D','E','F','G','BB','CC']
@@ -45,19 +44,21 @@ logical,allocatable :: tally(:)
enddo
!! SEE IF EXPECTED FILES ARE GENERATED
- !! DOS versus POSIX filenames
- ! assuming fpm command is in path and the new version
+ !! Issues:
+ !! o assuming fpm command is in expected path and the new version
+ !! o DOS versus POSIX filenames
+ is_os_windows=.false.
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)
+ path=windows_path(path)
+ is_os_windows=.true.
case default
write(*,*)'ERROR: unknown OS. Stopping test'
stop 2
end select
-
-
+ ! execute the fpm(1) commands
do i=1,size(cmds)
message=''
write(*,*)path//' '//cmds(i)
@@ -80,74 +81,53 @@ logical,allocatable :: tally(:)
write(*,*)'ERROR:',trim( directories(i) ),' is not a directory'
else
select case(directories(i))
- case('A')
- expected=[ character(len=80)::&
+ 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)::&
+ case('B'); expected=[ character(len=80)::&
&'B/fpm.toml','B/README.md','B/src','B/src/B.f90']
- case('C')
- expected=[ character(len=80)::&
+ case('C'); expected=[ character(len=80)::&
&'C/app','C/fpm.toml','C/README.md','C/app/main.f90']
- case('D')
- expected=[ character(len=80)::&
+ case('D'); expected=[ character(len=80)::&
&'D/fpm.toml','D/README.md','D/test','D/test/main.f90']
- case('E')
- expected=[ character(len=80)::&
+ 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)::&
+ 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)::&
+ 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)::&
+ 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)::&
+ 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
!! MSwindows has hidden files in it
+ !! Warning: This only looks for expected files. If there are more files than expected it does not fail
call list_files(trim(directories(i)), file_names,recurse=.true.)
- if(allocated(fnames))deallocate(fnames)
- allocate(character(len=0) :: fnames(0))
- do j=1,size(file_names)
- if(file_names(j)%s(1:1).eq.'.'.or.index(file_names(j)%s,'/.').ne.0.or.index(file_names(j)%s,'\.').ne.0)cycle
- fnames=[character(len=max(len(fnames),len(file_names(j)%s))) :: fnames,file_names(j)%s]
- enddo
- write(*,'(*(g0))',advance='no')'>>>DIRECTORY ',trim(directories(i)),': '
- write(*,'(*(g0:,", "))')( file_names(j)%s, j=1,size(file_names) )
- if(size(expected).ne.size(fnames))then
- write(*,*)'unexpected number of files in file list=',size(fnames),' expected ',size(expected)
- 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(fnames(j)==expected) )then
- tally=[tally,.false.]
- write(*,'("ERROR: EXPECTED ",*(g0:,", "))')( trim(expected(k)), k=1,size(expected) )
- write(*,'(*(g0))')' NO MATCH FOR ',fnames(j)
- cycle TESTS
- endif
- enddo
- tally=[tally,.true.]
+
+ if(size(expected).ne.size(file_names))then
+ write(*,*)'WARNING: unexpected number of files in file list=',size(file_names),' expected ',size(expected)
+ write(*,'("EXPECTED: ",*(g0:,","))')(trim(expected(j)),j=1,size(expected))
+ write(*,'("FOUND: ",*(g0:,","))')(trim(file_names(j)%s),j=1,size(file_names))
endif
+
+ do j=1,size(expected)
+
+ if(is_os_windows) expected(j)=windows_path(expected(j))
+ if( .not.(trim(expected(j)).in.file_names) )then
+ tally=[tally,.false.]
+ write(*,'("ERROR: FOUND ",*(g0:,", "))')( trim(file_names(k)%s), k=1,size(file_names) )
+ write(*,'(*(g0))')' BUT NO MATCH FOR ',expected(j)
+ tally=[tally,.false.]
+ cycle TESTS
+ endif
+ enddo
+ tally=[tally,.true.]
endif
enddo TESTS
+
write(*,'("TALLY=",*(g0))')tally
if(all(tally))then
write(*,'(*(g0))')'PASSED: all ',count(tally),' tests passed '
@@ -155,132 +135,5 @@ logical,allocatable :: tally(:)
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-15 08:21:15 +0000