diff options
| -rw-r--r-- | README.md | 2 | ||||
| -rw-r--r-- | fpm/.gitignore | 2 | ||||
| -rw-r--r-- | fpm/fpm.toml | 8 | ||||
| -rw-r--r-- | fpm/src/fpm/cmd/new.f90 | 137 | ||||
| -rw-r--r-- | fpm/src/fpm_command_line.f90 | 776 | ||||
| -rw-r--r-- | fpm/test/cli_test/cli_test.f90 | 14 | ||||
| -rw-r--r-- | fpm/test/new_test/new_test.f90 | 286 |
7 files changed, 863 insertions, 362 deletions
@@ -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"`. diff --git a/fpm/.gitignore b/fpm/.gitignore index c602557..7e96036 100644 --- a/fpm/.gitignore +++ b/fpm/.gitignore @@ -1,2 +1,2 @@ build/* -*/FODDER/* +FODDER/* diff --git a/fpm/fpm.toml b/fpm/fpm.toml index 9418204..8b4d8a3 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -14,12 +14,20 @@ tag = "v0.2" git = "https://github.com/urbanjost/M_CLI2.git" rev = "649075aceb97f997665a1a4656514fd2e9b4becc" +[dependencies.fortran-intrinsic-manpages] +git = "https://github.com/urbanjost/M_intrinsics.git" + [[test]] 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" diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index fc4c93e..f57b948 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -2,7 +2,7 @@ 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 @@ -10,27 +10,50 @@ 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(:) - 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(). + 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 + + ! 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 + !! 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 + ! create NAME/README.md + call warnwrite(join_path(settings%name, 'README.md'), littlefile) - message=[character(len=80) :: & ! start building NAME/fpm.toml + ! start building NAME/fpm.toml + message=[character(len=80) :: & &'name = "'//bname//'" ', & &'version = "0.1.0" ', & &'license = "license" ', & @@ -42,11 +65,13 @@ character(len=:),allocatable :: littlefile(:) 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,52 +82,67 @@ character(len=:),allocatable :: littlefile(:) &' 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) @@ -110,16 +150,19 @@ 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,11 +173,11 @@ character(len=256) :: message 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 @@ -142,17 +185,21 @@ character(len=256) :: message 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 diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 1a7e4ab..671d17f 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -3,10 +3,12 @@ use fpm_environment, only : get_os_type, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD use M_CLI2, only : set_args, lget, unnamed, remaining, specified -use fpm_filesystem, only : basename +use M_intrinsics, only : help_intrinsics +use fpm_strings, only : lower +use fpm_filesystem, only : basename, canon_path use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & - & stdout=>output_unit, & - & stderr=>error_unit + & stdout=>output_unit, & + & stderr=>error_unit implicit none private @@ -27,6 +29,7 @@ type, extends(fpm_cmd_settings) :: fpm_new_settings logical :: with_executable=.false. logical :: with_test=.false. logical :: with_lib=.true. + logical :: backfill=.true. end type type, extends(fpm_cmd_settings) :: fpm_build_settings @@ -52,11 +55,14 @@ type, extends(fpm_cmd_settings) :: fpm_install_settings end type character(len=:),allocatable :: name +character(len=:),allocatable :: os_type character(len=ibug),allocatable :: names(:) character(len=:), allocatable :: version_text(:) -character(len=:), allocatable :: help_new(:), help_fpm(:), help_run(:), help_test(:), help_build(:) -character(len=:), allocatable :: help_text(:), help_install(:), help_help(:) +character(len=:), allocatable :: help_new(:), help_fpm(:), help_run(:), & + & help_test(:), help_build(:), help_usage(:), & + & help_text(:), help_install(:), help_help(:), & + & help_list(:), help_list_dash(:), help_list_nodash(:) contains subroutine get_command_line_settings(cmd_settings) @@ -64,24 +70,37 @@ contains character(len=4096) :: cmdarg integer :: i + integer :: widest call set_help() ! text for --version switch, + select case (get_os_type()) + case (OS_LINUX); os_type = "OS Type: Linux" + case (OS_MACOS); os_type = "OS Type: macOS" + case (OS_WINDOWS); os_type = "OS Type: Windows" + case (OS_CYGWIN); os_type = "OS Type: Cygwin" + case (OS_SOLARIS); os_type = "OS Type: Solaris" + case (OS_FREEBSD); os_type = "OS Type: FreeBSD" + case (OS_UNKNOWN); os_type = "OS Type: Unknown" + case default ; os_type = "OS Type: UNKNOWN" + end select version_text = [character(len=80) :: & - & 'Version: 0.1.0, Pre-alpha', & - & 'Program: fpm(1)', & - & 'Description: A Fortran package manager and build system', & - & 'Home Page: https://github.com/fortran-lang/fpm', & - & 'License: MIT', & - & ''] - ! find the subcommand name by looking for first word on command not starting with dash + & 'Version: 0.1.0, Pre-alpha', & + & 'Program: fpm(1)', & + & 'Description: A Fortran package manager and build system', & + & 'Home Page: https://github.com/fortran-lang/fpm', & + & 'License: MIT', & + & os_type] + ! find the subcommand name by looking for first word on command + ! not starting with dash cmdarg = '' do i = 1, command_argument_count() call get_command_argument(i, cmdarg) if(adjustl(cmdarg(1:1)) .ne. '-')exit enddo - ! now set subcommand-specific help text and process commandline arguments. Then call subcommand routine + ! now set subcommand-specific help text and process commandline + ! arguments. Then call subcommand routine select case(trim(cmdarg)) case('run') @@ -101,51 +120,52 @@ contains call set_args( '--release F --list F --',help_build,version_text ) allocate( fpm_build_settings :: cmd_settings ) - cmd_settings=fpm_build_settings( release=lget('release'),list=lget('list') ) + cmd_settings=fpm_build_settings( release=lget('release'), & + & list=lget('list') ) case('new') - call set_args(' --with-executable F --with-test F --lib F --app F --test F', help_new, version_text) + 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,'(*(g0))')' usage: fpm new NAME [--with-executable] [--with-test]' + write(stderr,'(*(g0,/))')'ERROR: directory name required' + write(stderr,'(*(7x,g0,/))') & + & '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,'(*(g0))')' usage: fpm new NAME [--with-executable] [--with-test]' + write(stderr,'(g0)')'ERROR: only one directory name allowed' + write(stderr,'(7x,g0)') & + & 'usage: fpm new NAME [--lib|--src] [--app] [--test] [--backfill]' stop 2 end select - + !! canon_path is not converting ".", etc. + name=canon_path(name) if( .not.is_fortran_name(basename(name)) )then - write(stderr,'(*(g0))')'ERROR: the new directory basename must be an allowed Fortran name.' - write(stderr,'(*(g0))')' It must be composed of 1 to 63 ASCII characters and start' - write(stderr,'(*(g0))')' with a letter and be composed entirely of alphanumeric' - write(stderr,'(*(g0))')' characters [A-Za-z0-9] and underscores.' + write(stderr,'(g0)') [ character(len=72) :: & + & 'ERROR: the new directory basename must be an allowed ', & + & ' Fortran name. It must be composed of 1 to 63 ASCII', & + & ' characters and start with a letter and be composed', & + & ' entirely of alphanumeric characters [a-zA-Z0-9]', & + & ' and underscores.'] stop 4 endif allocate(fpm_new_settings :: cmd_settings) - cmd_settings=fpm_new_settings(name=name, & - & with_executable=lget('with-executable'), & - & with_test=lget('with-test'), & - & with_lib=.true.) - - ! use alternative --lib --test --app switches. In production pick one - ! method or probably an error should be using --with and one of these - if (any( specified(['lib ','app ','test']) ) )then - if (any( specified(['with-executable','with-test ']) ) )then - write(stderr,'(*(g0))') 'A BIT FROWARD:' - write(stderr,'(*(g0))') ' DO NOT MIX --with-* with [--lib|--app|--test]' - write(stderr,'(*(g0))') ' THEY ARE TWO DIFFERENT PROTOTYPE PROPOSALS ' - write(stderr,'(*(g0))') ' SEE ISSUES #111 #110 #109' - write(stderr,'(*(g0))') ' START WITH https://github.com/fortran-lang/fpm/issues/111' - endif + + 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, & - & with_executable=lget('app'), & - & with_test=lget('test'), & - & with_lib=lget('lib') ) + & with_executable=.true., & + & with_test=.true., & + & with_lib=.true., & + & backfill=lget('backfill') ) endif case('help') @@ -153,41 +173,57 @@ contains if(size(unnamed).lt.2)then unnamed=['help', 'fpm '] endif - allocate(character(len=80) :: help_text(0)) + widest=256 + allocate(character(len=widest) :: help_text(0)) do i=2,size(unnamed) select case(unnamed(i)) case('build ' ) - help_text=[character(len=80) :: help_text, help_build] + help_text=[character(len=widest) :: help_text, help_build] case('run ' ) - help_text=[character(len=80) :: help_text, help_run] + help_text=[character(len=widest) :: help_text, help_run] case('help ' ) - help_text=[character(len=80) :: help_text, help_help] + help_text=[character(len=widest) :: help_text, help_help] case('test ' ) - help_text=[character(len=80) :: help_text, help_test] + help_text=[character(len=widest) :: help_text, help_test] case('new ' ) - help_text=[character(len=80) :: help_text, help_new] + help_text=[character(len=widest) :: help_text, help_new] case('fpm ' ) - help_text=[character(len=80) :: help_text, help_fpm] + help_text=[character(len=widest) :: help_text, help_fpm] + case('list ' ) + help_text=[character(len=widest) :: help_text, help_list] case('version' ) - help_text=[character(len=80) :: help_text, version_text] - case('all ' ) - help_text=[character(len=80) :: help_text, help_fpm] - help_text=[character(len=80) :: help_text, help_new] - help_text=[character(len=80) :: help_text, help_build] - help_text=[character(len=80) :: help_text, help_run] - help_text=[character(len=80) :: help_text, help_test] - help_text=[character(len=80) :: help_text, version_text] + help_text=[character(len=widest) :: help_text, version_text] + case('manual ' ) + help_text=[character(len=widest) :: help_text, help_fpm] + help_text=[character(len=widest) :: help_text, help_new] + help_text=[character(len=widest) :: help_text, help_build] + help_text=[character(len=widest) :: help_text, help_run] + help_text=[character(len=widest) :: help_text, help_test] + help_text=[character(len=widest) :: help_text, help_help] + help_text=[character(len=widest) :: help_text, version_text] case default - help_text=[character(len=80) :: help_text, 'unknown subcommand'//unnamed(i)] + ! note help_intrinsics is returning a fixed-length array + ! to avoid compiler issues + help_text=[character(len=widest) :: help_text, & + & help_intrinsics( lower( unnamed(i) ) ) ] + if(size(help_text).eq.0)then + help_text=[character(len=widest) :: help_text, & + & 'ERROR: unknown help topic "'//trim(unnamed(i))//'"'] + endif end select enddo - write(stderr,'(g0)')(trim(help_text(i)), i=1, size(help_text) ) + call printhelp(help_text) case('install') call set_args('--release F ', help_install, version_text) allocate(fpm_install_settings :: cmd_settings) - + case('list') + call set_args(' --list F', help_list, version_text) + call printhelp(help_list_nodash) + if(lget('list'))then + call printhelp(help_list_dash) + endif case('test') call set_args('--list F --release F --',help_test,version_text) @@ -203,24 +239,34 @@ contains case default - call set_args(' ', help_fpm, version_text) - ! Note: will not get here if --version or --usage or --help is present on commandline - if(len_trim(cmdarg).eq.0)then - write(stderr,'(*(a))')'ERROR: missing subcommand' + call set_args(' --list F', help_fpm, version_text) + ! Note: will not get here if --version or --usage or --help + ! is present on commandline + help_text=help_usage + if(lget('list'))then + help_text=help_list_dash + elseif(len_trim(cmdarg).eq.0)then + 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 [', trim(cmdarg), ']' + write(stderr,'(*(a))')'ERROR: unknown subcommand [', & + & trim(cmdarg), ']' endif - help_text=[character(len=80) :: & - 'USAGE: fpm [ SUBCOMMAND [SUBCOMMAND_OPTIONS] ] | [|--help|--version] ', & - ' Enter "fpm --help" for more information ', & - '' ] - write(stderr,'(g0)')(trim(help_text(i)), i=1, size(help_text) ) + call printhelp(help_text) end select + contains + subroutine printhelp(lines) + character(len=:),intent(in),allocatable :: lines(:) + write(stdout,'(g0)')(trim(lines(i)), i=1, size(lines) ) + end subroutine printhelp end subroutine get_command_line_settings function is_fortran_name(line) result (lout) - ! determine if a string is a valid Fortran name ignoring trailing spaces (but not leading spaces) + ! determine if a string is a valid Fortran name ignoring trailing spaces + ! (but not leading spaces) character(len=*),parameter :: int='0123456789' character(len=*),parameter :: lower='abcdefghijklmnopqrstuvwxyz' character(len=*),parameter :: upper='ABCDEFGHIJKLMNOPQRSTUVWXYZ' @@ -240,255 +286,369 @@ contains end function is_fortran_name subroutine set_help() + help_list_nodash=[character(len=80) :: & + ' ', & + ' build Compile the package placing results in the "build" directory', & + ' help Display help ', & + ' list Display this list of subcommand descriptions ', & + ' new Create a new Fortran package directory with sample files ', & + ' run Run the local package application programs ', & + ' test Run the test programs ', & + ' '] + help_list_dash = [character(len=80) :: & + ' ', & + ' build [--release] [--list] ', & + ' help [NAME(s)] ', & + ' new NAME [--lib|--src] [--app] [--test] [--backfill] ', & + ' list [--list] ', & + ' run [NAME(s)] [--release] [--list] [-- ARGS] ', & + ' test [NAME(s)] [--release] [--list] [-- ARGS] ', & + ' '] + help_usage=[character(len=80) :: & + ' ', & + 'USAGE: fpm [ SUBCOMMAND [SUBCOMMAND_OPTIONS] ] | [--help|--version] ', & + ' where SUBCOMMAND is commonly new|build|run|test ', & + ' ', & + ' Enter "fpm list " or "fpm --list" for a full list of ', & + ' subcommands. Enter "fpm --help" or "fpm SUBCOMMAND --help" ', & + ' for detailed command information. ', & + '' ] help_fpm=[character(len=80) :: & - 'NAME', & - ' fpm(1) - A Fortran package manager and build system', & - 'OS TYPE' ] - select case (get_os_type()) - case (OS_LINUX); help_fpm=[character(len=80) :: help_fpm, " Linux" ] - case (OS_MACOS); help_fpm=[character(len=80) :: help_fpm, " macOS" ] - case (OS_WINDOWS); help_fpm=[character(len=80) :: help_fpm, " Windows" ] - case (OS_CYGWIN); help_fpm=[character(len=80) :: help_fpm, " Cygwin" ] - case (OS_SOLARIS); help_fpm=[character(len=80) :: help_fpm, " Solaris" ] - case (OS_FREEBSD); help_fpm=[character(len=80) :: help_fpm, " FreeBSD" ] - case (OS_UNKNOWN); help_fpm=[character(len=80) :: help_fpm, " Unknown" ] - case default ; help_fpm=[character(len=80) :: help_fpm, " UNKNOWN" ] - end select - help_fpm=[character(len=80) :: help_fpm, & - 'SYNOPSIS ', & - ' fpm SUBCOMMAND [SUBCOMMAND_OPTIONS] ', & - ' ', & - ' fpm --help|--version ', & - ' ', & - 'DESCRIPTION ', & - ' fpm is a package manager that helps you create Fortran projects that are ', & - ' optionally dependent on multiple files and other fpm(1) packages. ', & - ' ', & - ' Most significantly fpm(1) lets you pull upon other fpm(1) packages in ', & - ' distributed git(1) repositories as if the packages were a basic part ', & - ' of your default programming environment, as well as letting you share ', & - ' your projects with others in a similar manner. ', & - ' ', & - ' See the fpm(1) repository for a listing of such available projects. ', & - ' ', & - ' All output goes into the directory "build/". ', & - ' ', & - 'SUBCOMMANDS ', & - ' Valid fpm subcommands are: ', & - ' ', & - ' build [--release] [--list] ', & - ' Compile the packages into the "build/" directory. ', & - ' new NAME [--with-executable] [--with-test] ', & - ' Create a new Fortran package directory ', & - ' with sample files ', & - ' run [NAME(s)] [--release] [--list] [-- ARGS] ', & - ' Run the local package binaries. defaults to all ', & - ' binaries for that release. ', & - ' test [NAME(s)] [--release] [--list] [-- ARGS] ', & - ' Run the tests ', & - ' help [NAME(s)] Alternate method for displaying subcommand help ', & - ' ', & - 'SUBCOMMAND OPTIONS ', & - ' --release Builds or runs in release mode (versus debug mode). fpm(1) ', & - ' Defaults to using common compiler debug flags and building ', & - ' in "build/gfortran_debug/". When this flag is present build ', & - ' output goes into "build/gfortran_release/" and common ', & - ' compiler optimization flags are used. ', & - ' --list list candidates instead of building or running them ', & - ' -- ARGS Arguments to pass to executables/tests ', & - ' --help Show this help text and exit. Valid for all subcommands. ', & - ' --version Show version information and exit. Valid for all subcommands.', & - 'EXAMPLES ', & - ' sample commands: ', & - ' ', & - ' fpm build ', & - ' fpm test ', & - ' fpm run ', & - ' fpm new --help ', & - ' fpm new mypackage --with-executable --with-test ', & - ' fpm run myprogram --release -- -x 10 -y 20 --title "my title" ', & - 'SEE ALSO ', & - ' The fpm(1) home page is https://github.com/fortran-lang/fpm ', & + 'NAME ', & + ' fpm(1) - A Fortran package manager and build system ', & + ' ', & + 'SYNOPSIS ', & + ' fpm SUBCOMMAND [SUBCOMMAND_OPTIONS] ', & + ' ', & + ' fpm --help|--version ', & + ' ', & + 'DESCRIPTION ', & + ' fpm(1) is a package manager that helps you create Fortran projects ', & + ' from source. ', & + ' ', & + ' Most significantly fpm(1) lets you pull upon other fpm(1) packages ', & + ' in distributed git(1) repositories as if the packages were a basic ', & + ' part of your default programming environment, as well as letting ', & + ' you share your projects with others in a similar manner. ', & + ' ', & + ' See the fpm(1) repository at https://fortran-lang.org/packages ', & + ' for a listing of registered projects. ', & + ' ', & + ' All output goes into the directory "build/" which can generally be ', & + ' removed and rebuilt if required. Note that if external packages are ', & + ' being used you need network connectivity to rebuild from scratch. ', & + ' ', & + 'SUBCOMMANDS ', & + ' Valid fpm subcommands are: ', & + ' ', & + ' build [--release] [--list] ', & + ' Compile the packages into the "build/" directory. ', & + ' new NAME [--lib|--src] [--app] [--test] [--backfill] ', & + ' Create a new Fortran package directory ', & + ' with sample files ', & + ' run [NAME(s)] [--release] [--list] [-- ARGS] ', & + ' Run the local package binaries. defaults to all ', & + ' binaries for that release. ', & + ' test [NAME(s)] [--release] [--list] [-- ARGS] ', & + ' Run the tests ', & + ' help [NAME(s)] Alternate method for displaying subcommand help ', & + ' list [--list] Display brief descriptions of all subcommands. ', & + ' ', & + 'SUBCOMMAND OPTIONS ', & + ' --release Builds or runs in release mode (versus debug mode). fpm(1)', & + ' Defaults to using common compiler debug flags and building', & + ' in "build/*_debug/". When this flag is present build ', & + ' output goes into "build/*_release/" and common compiler ', & + ' optimization flags are used. ', & + ' --list list candidates instead of building or running them ', & + ' -- ARGS Arguments to pass to executables/tests ', & + ' --help Show help text and exit. Valid for all subcommands. ', & + ' --version Show version information and exit. Valid for all ', & + ' subcommands. ', & + ' ', & + 'EXAMPLES ', & + ' sample commands: ', & + ' ', & + ' fpm new mypackage --app --test ', & + ' fpm build ', & + ' fpm test ', & + ' 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 ', & ''] + help_list=[character(len=80) :: & + 'NAME ', & + ' list(1) - list summary of fpm(1) subcommands ', & + ' ', & + 'SYNOPSIS ', & + ' fpm list [-list] ', & + ' ', & + ' fpm run --help|--version ', & + ' ', & + 'DESCRIPTION ', & + ' Display a short description for each fpm(1) subcommand. ', & + ' ', & + 'OPTIONS ', & + ' --list display a list of command options as well. This is the ', & + ' same output as generated by "fpm --list". ', & + ' ', & + 'EXAMPLES ', & + ' display a short list of fpm(1) subcommands ', & + ' ', & + ' fpm list ', & + ' fpm --list ', & + ' ', & + 'SEE ALSO ', & + ' The fpm(1) home page at https://github.com/fortran-lang/fpm ', & + '' ] help_run=[character(len=80) :: & - 'NAME ', & - ' run(1) - the fpm(1) subcommand to run project applications ', & - ' ', & - 'SYNOPSIS ', & - ' fpm run [NAME(s)] [--release] [-- ARGS] ', & - ' ', & - ' fpm run --help|--version ', & - ' ', & - 'DESCRIPTION ', & - ' Run applications you have built in your fpm(1) project. ', & - ' ', & - 'OPTIONS ', & - ' NAME(s) optional list of specific names to execute. ', & - ' The default is to run all the applications in app/ ', & - ' or the programs listed in the "fpm.toml" file. ', & - ' --release selects the optimized build instead of the debug ', & - ' build. ', & - ' --list list candidates instead of building or running them', & - ' -- ARGS optional arguments to pass to the program(s). ', & - ' The same arguments are passed to all names ', & - ' specified. ', & - ' ', & - 'EXAMPLES ', & - 'run fpm(1) project applications ', & - ' ', & - ' # run default programs in /app or as specified in "fpm.toml" ', & - ' fpm run ', & - ' ', & - ' # run a specific program and pass arguments to the command ', & - ' fpm run mytest -- -x 10 -y 20 -title "my title line" ', & - ' ', & - ' # production version of two applications ', & - ' fpm run tst1 test2 -release ', & - 'SEE ALSO ', & - ' The fpm(1) home page is https://github.com/fortran-lang/fpm ', & + 'NAME ', & + ' run(1) - the fpm(1) subcommand to run project applications ', & + ' ', & + 'SYNOPSIS ', & + ' fpm run [NAME(s)] [--release] [-- ARGS] ', & + ' ', & + ' fpm run --help|--version ', & + ' ', & + 'DESCRIPTION ', & + ' Run applications you have built in your fpm(1) project. ', & + ' ', & + 'OPTIONS ', & + ' NAME(s) optional list of specific names to execute. ', & + ' The default is to run all the applications in app/ ', & + ' or the programs listed in the "fpm.toml" file. ', & + ' --release selects the optimized build instead of the debug ', & + ' build. ', & + ' --list list candidates instead of building or running them ', & + ' -- ARGS optional arguments to pass to the program(s). ', & + ' The same arguments are passed to all names ', & + ' specified. ', & + ' ', & + 'EXAMPLES ', & + ' run fpm(1) project applications ', & + ' ', & + ' # run default programs in /app or as specified in "fpm.toml" ', & + ' fpm run ', & + ' ', & + ' # run a specific program and pass arguments to the command ', & + ' fpm run mytest -- -x 10 -y 20 --title "my title line" ', & + ' ', & + ' # 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] ', & - ' fpm build --help|--version ', & - ' ', & - 'DESCRIPTION ', & - ' The "fpm build" command ', & - ' o Fetches any dependencies ', & - ' o Scans your sources ', & - ' o Builds them in the proper order ', & - ' ', & - ' The Fortran source files are assumed to be in app/, test/, and src/ ', & - ' by default. The changed or new files found are rebuilt. ', & - ' The results are placed in the build/ directory. ', & - ' ', & - ' Non-default pathnames and remote dependencies are used if ', & - ' specified in the "fpm.toml" file. ', & - ' ', & - 'OPTIONS ', & - ' --release build in build/*_release instead of build/*_debug with ', & - ' high optimization instead of full debug options. ', & - ' --list list candidates instead of building or running them ', & - ' --help print this help and exit ', & - ' --version print program version information and exit ', & - ' ', & - 'EXAMPLES ', & - ' Sample commands: ', & - ' ', & - ' fpm build # build with debug options ', & - ' fpm build -release # build with high optimization ', & - 'SEE ALSO ', & - ' The fpm(1) home page is https://github.com/fortran-lang/fpm ', & + 'NAME ', & + ' build(1) - the fpm(1) subcommand to build a project ', & + ' ', & + 'SYNOPSIS ', & + ' fpm build [--release]|[-list] ', & + ' ', & + ' fpm build --help|--version ', & + ' ', & + 'DESCRIPTION ', & + ' The "fpm build" command ', & + ' o Fetches any dependencies ', & + ' o Scans your sources ', & + ' o Builds them in the proper order ', & + ' ', & + ' The Fortran source files are assumed by default to be in ', & + ' o src/ for modules and procedure source ', & + ' o app/ main program(s) for applications ', & + ' o test/ main program(s) and support files for project tests ', & + ' Changed or new files found are rebuilt. The results are placed in ', & + ' the build/ directory. ', & + ' ', & + ' Non-default pathnames and remote dependencies are used if ', & + ' specified in the "fpm.toml" file. ', & + ' ', & + 'OPTIONS ', & + ' --release build in build/*_release instead of build/*_debug with ', & + ' high optimization instead of full debug options. ', & + ' --list list candidates instead of building or running them ', & + ' --help print this help and exit ', & + ' --version print program version information and exit ', & + ' ', & + 'EXAMPLES ', & + ' Sample commands: ', & + ' ', & + ' 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 ', & '' ] + help_help=[character(len=80) :: & - 'NAME ', & - ' help(1) - the fpm(1) subcommand to display help ', & - 'SYNOPSIS ', & - ' fpm help [fpm][new][build][run][test][help][version][all] ', & - ' ', & - 'DESCRIPTION ', & - ' The "fpm help" command is an alternative to the --help parameter ', & - ' on the fpm(1) command and its subcommands. ', & - ' ', & - 'OPTIONS ', & - ' NAME(s) A list of topic names to display. ', & - ' ', & - 'EXAMPLES ', & - ' ', & - ' fpm help ', & - ' fpm help version ', & - ' fpm all ', & - 'SEE ALSO ', & - ' The fpm(1) home page is https://github.com/fortran-lang/fpm ', & + 'NAME ', & + ' help(1) - the fpm(1) subcommand to display help ', & + ' ', & + 'SYNOPSIS ', & + ' fpm help [fpm] [new] [build] [run] [test] [help] [version] [manual] ', & + ' ', & + ' fpm help [fortran|fortran_manual][FORTRAN_INTRINSIC_NAME] ', & + ' ', & + 'DESCRIPTION ', & + ' The "fpm help" command is an alternative to the --help parameter ', & + ' on the fpm(1) command and its subcommands. ', & + ' ', & + 'OPTIONS ', & + ' NAME(s) A list of topic names to display. All the subcommands ', & + ' have their own page (new, build, run, test, ...). ', & + ' ', & + ' The special name "manual" displays all the fpm(1) ', & + ' built-in documentation. ', & + ' ', & + ' The default is to display help for the fpm(1) command ', & + ' itself. ', & + ' INTRINSIC(s) In addition, Fortran intrinsics can be described. ', & + ' The special name "fortran" prints a list of available ', & + ' topics. "fortran_manual" displays all the built-in ', & + ' 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: ', & + ' ', & + ' fpm help # general fpm(1) command help ', & + ' fpm help version # show program version ', & + ' fpm help new # display help for "new" subcommand ', & + ' fpm help manual # All fpm(1) built-in documentation ', & + ' ', & + ' FORTRAN INTRINSICS ', & + ' Additional general Fortran documentation ', & + ' ', & + ' fpm help SIN COS TAN # selected Fortran Intrinsic help ', & + ' fpm help fortran # index of Fortran documentation ', & + ' fpm help fortran_manual # all Fortran documentation ', & + ' ', & + 'SEE ALSO ', & + ' The fpm(1) home page at https://github.com/fortran-lang/fpm ', & '' ] - help_new=[character(len=80) :: & - 'NAME ', & - ' new(1) - the fpm(1) subcommand to initialize a new project ', & - 'SYNOPSIS ', & - ' fpm new NAME [--with-executable] [--with-test] ', & - ' ', & - ' fpm new --help|--version ', & - ' ', & - 'DESCRIPTION ', & - ' Create a new programming project in a new directory ', & - ' ', & - ' The "new" subcommand creates a directory and runs the command ', & - ' "git init" in that directory and makes an example "fpm.toml" ', & - ' file. and src/ directory and a sample module file. It ', & - ' optionally also creates a test/ and app/ directory with ', & - ' trivial example Fortran program sources. ', & - ' ', & - ' Remember to update the information in the sample "fpm.toml" ', & - ' file with such information as your name and e-mail address. ', & - ' ', & - 'OPTIONS ', & - ' NAME the name of the project directory to create. The name ', & - ' must be a valid Fortran name composed of 1 to 63 ', & - ' ASCII alphanumeric characters and underscores, ', & - ' starting with a letter. ', & - ' --with-executable additionally create optional directory app/ ', & - ' and placeholder program for "fpm run". ', & - ' --with-test additionally create optional directory test/', & - ' and placeholder program for "fpm test". ', & - ' --help print this help and exit ', & - ' --version print program version information and exit ', & - ' ', & - 'EXAMPLES ', & - ' Sample use ', & - ' ', & - ' fpm new myproject # create new project directory and seed it', & - ' cd myproject # Enter the new directory ', & - ' # and run commands such as ', & - ' fpm build ', & - ' fpm run # if you selected --with-executable ', & - ' fpm test # if you selected --with-test ', & - 'SEE ALSO ', & - ' The fpm(1) home page is https://github.com/fortran-lang/fpm ', & - ' ', & - ' Registered packages are at https://fortran-lang.org/packages ', & + help_new=[character(len=80) :: & + 'NAME ', & + ' new(1) - the fpm(1) subcommand to initialize a new project ', & + 'SYNOPSIS ', & + ' fpm new NAME [--lib|--src] [--app] [--test] [--backfill] ', & + ' ', & + ' fpm new --help|--version ', & + ' ', & + 'DESCRIPTION ', & + ' "fpm new" creates a new programming project in a new directory. ', & + ' ', & + ' The "new" subcommand creates a directory with the specified ', & + ' name and runs the command "git init" in that directory and ', & + ' populates it with an example "fpm.toml" file, a src/, test/, ', & + ' and app/ directory with trivial example Fortran source files ', & + ' and a ".gitignore" file for ignoring the build/ directory ', & + ' (where fpm-generated output will be placed): ', & + ' ', & + ' NAME/ ', & + ' fpm.toml ', & + ' .gitignore ', & + ' src/ ', & + ' NAME.f90 ', & + ' app/ ', & + ' main.f90 ', & + ' test/ ', & + ' main.f90 ', & + ' ', & + ' Remember to update the information in the sample "fpm.toml" ', & + ' file with your name and e-mail address. ', & + ' ', & + 'OPTIONS ', & + ' NAME the name of the project directory to create. The name ', & + ' must be a valid Fortran name composed of 1 to 63 ', & + ' ASCII alphanumeric characters and underscores, ', & + ' starting with a letter. ', & + ' ', & + ' The default is to create all of the src/, app/, and test/ ', & + ' directories. If any of the following options are specified ', & + ' then only specified subdirectories are generated: ', & + ' ', & + ' --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. ', & + ' ', & + ' --help print this help and exit ', & + ' --version print program version information and exit ', & + ' ', & + 'EXAMPLES ', & + ' Sample use ', & + ' ', & + ' fpm new myproject # create new project directory and seed it ', & + ' cd myproject # Enter the new directory ', & + ' # and run commands such as ', & + ' 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 ', & + ' ', & + ' Registered packages are at https://fortran-lang.org/packages ', & '' ] help_test=[character(len=80) :: & - 'NAME ', & - ' test(1) - the fpm(1) subcommand to run project tests ', & - ' ', & - 'SYNOPSIS ', & - ' fpm test [NAME(s)] [--release] [--list] [-- ARGS] ', & - ' ', & - ' fpm test --help|--version ', & - ' ', & - 'DESCRIPTION ', & - ' Run applications you have built to test your project. ', & - ' ', & - 'OPTIONS ', & - ' NAME(s) optional list of specific test names to execute. ', & - ' The default is to run all the tests in test/ ', & - ' or the tests listed in the "fpm.toml" file. ', & - ' --release selects the optimized build instead of the debug ', & - ' build. ', & - ' --list list candidates instead of building or running them', & - ' -- ARGS optional arguments to pass to the test program(s). ', & - ' The same arguments are passed to all test names ', & - ' specified. ', & - ' ', & - 'EXAMPLES ', & - 'run tests ', & - ' ', & - ' # run default tests in /test or as specified in "fpm.toml" ', & - ' fpm test ', & - ' ', & - ' # run a specific test and pass arguments to the command ', & - ' fpm test mytest -- -x 10 -y 20 -title "my title line" ', & - ' ', & - ' fpm test tst1 test2 -release # production version of two tests', & - 'SEE ALSO ', & - ' The fpm(1) home page is https://github.com/fortran-lang/fpm ', & + 'NAME ', & + ' test(1) - the fpm(1) subcommand to run project tests ', & + ' ', & + 'SYNOPSIS ', & + ' fpm test [NAME(s)] [--release] [--list] [-- ARGS] ', & + ' ', & + ' fpm test --help|--version ', & + ' ', & + 'DESCRIPTION ', & + ' Run applications you have built to test your project. ', & + ' ', & + 'OPTIONS ', & + ' NAME(s) optional list of specific test names to execute. ', & + ' The default is to run all the tests in test/ ', & + ' or the tests listed in the "fpm.toml" file. ', & + ' --release selects the optimized build instead of the debug ', & + ' build. ', & + ' --list list candidates instead of building or running them ', & + ' -- ARGS optional arguments to pass to the test program(s). ', & + ' The same arguments are passed to all test names ', & + ' specified. ', & + ' ', & + 'EXAMPLES ', & + 'run tests ', & + ' ', & + ' # run default tests in /test or as specified in "fpm.toml" ', & + ' fpm test ', & + ' ', & + ' # run a specific test and pass arguments to the command ', & + ' 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 ', & '' ] help_install=[character(len=80) :: & - ' fpm(1) subcommand "install" ', & - ' ', & - ' Usage: fpm install NAME ', & + ' fpm(1) subcommand "install" ', & + ' ', & + ' Usage: fpm install NAME ', & '' ] end subroutine set_help diff --git a/fpm/test/cli_test/cli_test.f90 b/fpm/test/cli_test/cli_test.f90 index b0140e1..59f1f7a 100644 --- a/fpm/test/cli_test/cli_test.f90 +++ b/fpm/test/cli_test/cli_test.f90 @@ -41,11 +41,11 @@ character(len=*),parameter :: tests(*)= [ character(len=256) :: & 'CMD="new", ESTAT=1,', & !'CMD="new -unknown", ESTAT=2,', & -'CMD="new my_project another yet_another -with-test", ESTAT=2,', & -'CMD="new my_project --with-executable", W_E=T, NAME="my_project",', & -'CMD="new my_project --with-executable -with-test", W_E=T,W_T=T, NAME="my_project",', & -'CMD="new my_project -with-test", W_T=T, NAME="my_project",', & -'CMD="new my_project", NAME="my_project",', & +'CMD="new my_project another yet_another -test", ESTAT=2,', & +'CMD="new my_project --app", W_E=T, NAME="my_project",', & +'CMD="new my_project --app --test", W_E=T,W_T=T, NAME="my_project",', & +'CMD="new my_project --test", W_T=T, NAME="my_project",', & +'CMD="new my_project", W_E=T,W_T=T, NAME="my_project",', & 'CMD="run", ', & 'CMD="run my_project", NAME="my_project", ', & @@ -91,8 +91,8 @@ if(command_argument_count().eq.0)then ! assume if called with no arguments to d ! blank out name group EXPECTED name=[(repeat(' ',len(name)),i=1,max_names)] ! the words on the command line sans the subcommand name release=.false. ! --release - w_e=.false. ! --with-executable - w_t=.false. ! --with-test + w_e=.false. ! --app + w_t=.false. ! --test args=repeat(' ',132) ! -- ARGS cmd=repeat(' ',132) ! the command line arguments to test cstat=0 ! status values from EXECUTE_COMMAND_LINE() diff --git a/fpm/test/new_test/new_test.f90 b/fpm/test/new_test/new_test.f90 new file mode 100644 index 0000000..289431e --- /dev/null +++ b/fpm/test/new_test/new_test.f90 @@ -0,0 +1,286 @@ +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 :: fnames(:) +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='' + write(*,*)path//' '//cmds(i) + call execute_command_line(path//' '//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 + !! MSwindows has hidden files in it + 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.] + 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 |