diff options
| -rw-r--r-- | fpm/fpm.toml | 5 | ||||
| -rw-r--r-- | fpm/src/fpm_command_line.f90 | 70 | ||||
| -rw-r--r-- | fpm/test/new_test/new_test.f90 | 277 |
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 |