From a1e22e467977e8e1a66f7881b64475adb9e7b682 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Thu, 18 Feb 2021 22:11:47 -0500 Subject: [PATCH 1/3] plugin alpha version --- fpm/fpm.toml | 2 +- fpm/src/fpm_command_line.f90 | 57 ++++++++------ fpm/src/fpm_environment.f90 | 140 ++++++++++++++++++++++++++++++++++- fpm/src/fpm_filesystem.f90 | 82 ++++++++++++++++++++ 4 files changed, 255 insertions(+), 26 deletions(-) diff --git a/fpm/fpm.toml b/fpm/fpm.toml index 48f5b0078d..4fdac6c935 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -12,7 +12,7 @@ rev = "2f5eaba864ff630ba0c3791126a3f811b6e437f3" [dependencies.M_CLI2] git = "https://github.com/urbanjost/M_CLI2.git" -rev = "e59fb2bfcf36199f1af506f937b3849180454a0f" +rev = "54cd522b7e2a4a1d873580e4a2c56e34549a1182" [[test]] name = "cli-test" diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 021715454b..9885b0789c 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -27,8 +27,10 @@ module fpm_command_line OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified +use M_CLI2, only : get_subcommand, CLI_RESPONSE_FILE use fpm_strings, only : lower, split -use fpm_filesystem, only : basename, canon_path, to_fortran_name +use fpm_filesystem, only : basename, canon_path, to_fortran_name, which +use fpm_environment, only : run, get_command_arguments_quoted use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & & stderr=>error_unit @@ -136,13 +138,18 @@ subroutine get_command_line_settings(cmd_settings) & '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 + CLI_RESPONSE_FILE=.true. + cmdarg = get_subcommand() + if(cmdarg.eq.' ')then + write(stderr,'(*(g0))')' internal failure in response file processing' + do i = 1, command_argument_count() + call get_command_argument(i, cmdarg) + if(adjustl(cmdarg(1:1)) .ne. '-')exit + enddo + endif ! now set subcommand-specific help text and process commandline ! arguments. Then call subcommand routine @@ -404,25 +411,29 @@ subroutine get_command_line_settings(cmd_settings) case default - call set_args('& - & --list F& - & --verbose 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))')' ' - call printhelp(help_list_nodash) + if(which('fpm-'//cmdarg).ne.'')then + call run('fpm-'//trim(cmdarg)//' '// get_command_arguments_quoted(),.false.) else - write(stderr,'(*(a))')' unknown subcommand [', & - & trim(cmdarg), ']' - call printhelp(help_list_dash) + call set_args('& + & --list F& + & --verbose 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))')' ' + call printhelp(help_list_nodash) + else + write(stderr,'(*(a))')' unknown subcommand [', & + & trim(cmdarg), ']' + call printhelp(help_list_dash) + endif + call printhelp(help_text) endif - call printhelp(help_text) end select contains diff --git a/fpm/src/fpm_environment.f90 b/fpm/src/fpm_environment.f90 index 181252d20e..4ca43f177e 100644 --- a/fpm/src/fpm_environment.f90 +++ b/fpm/src/fpm_environment.f90 @@ -1,10 +1,15 @@ module fpm_environment +use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & + & stdout=>output_unit, & + & stderr=>error_unit implicit none private public :: get_os_type public :: os_is_unix public :: run public :: get_env + public :: get_command_arguments_quoted + public :: separator integer, parameter, public :: OS_UNKNOWN = 0 integer, parameter, public :: OS_LINUX = 1 @@ -117,10 +122,17 @@ logical function os_is_unix(os) result(unix) unix = os /= OS_WINDOWS end function os_is_unix - subroutine run(cmd) + subroutine run(cmd,echo) character(len=*), intent(in) :: cmd + logical,optional,intent(in) :: echo integer :: stat - print *, '+ ', cmd + logical :: echo_local + if(present(echo))then + echo_local=echo + else + echo_local=.true. + endif + if(echo_local) print *, '+ ', cmd call execute_command_line(cmd, exitstat=stat) if (stat /= 0) then print *, 'Command failed' @@ -160,4 +172,128 @@ function get_env(NAME,DEFAULT) result(VALUE) if(VALUE.eq.''.and.present(DEFAULT))VALUE=DEFAULT end function get_env + function get_command_arguments_quoted() result(args) + character(len=:),allocatable :: args + character(len=:),allocatable :: arg + character(len=1) :: quote + integer :: ilength, istatus, i + ilength=0 + args='' + quote=merge('"',"'",separator().eq.'\') + do i=2,command_argument_count() ! look at all arguments after subcommand + call get_command_argument(number=i,length=ilength,status=istatus) + if(istatus /= 0) then + write(stderr,'(*(g0,1x))')'*get_command_arguments_stack* error obtaining argument ',i + exit + else + if(allocated(arg))deallocate(arg) + allocate(character(len=ilength) :: arg) + call get_command_argument(number=i,value=arg,length=ilength,status=istatus) + if(istatus /= 0) then + write(stderr,'(*(g0,1x))')'*get_command_arguments_stack* error obtaining argument ',i + exit + elseif(ilength.gt.0)then + if(index(arg//' ','-').ne.1)then + args=args//quote//arg//quote//' ' + else + args=args//arg//' ' + endif + else + args=args//repeat(quote,2)//' ' + endif + endif + enddo + end function get_command_arguments_quoted + +function separator() result(sep) +!> +!!##NAME +!! separator(3f) - [M_io:ENVIRONMENT] try to determine pathname directory separator character +!! (LICENSE:PD) +!! +!!##SYNOPSIS +!! +!! function separator() result(sep) +!! +!! character(len=1) :: sep +!! +!!##DESCRIPTION +!! First using the name the program was invoked with, then the name +!! returned by an INQUIRE(3f) of that name, then ".\NAME" and "./NAME" +!! try to determine the separator character used to separate directory +!! names from file basenames. +!! +!! If a slash or backslash is not found in the name, the environment +!! variable PATH is examined first for a backslash, then a slash. +!! +!! Can be very system dependent. If the queries fail the default returned +!! is "/". +!! +!!##EXAMPLE +!! +!! sample usage +!! +!! program demo_separator +!! use M_io, only : separator +!! implicit none +!! write(*,*)'separator=',separator() +!! end program demo_separator + +! use the pathname returned as arg0 to determine pathname separator +implicit none +character(len=:),allocatable :: arg0 +integer :: arg0_length +integer :: istat +logical :: existing +character(len=1) :: sep +!*ifort_bug*!character(len=1),save :: sep_cache=' ' +character(len=4096) :: name +character(len=:),allocatable :: fname + + !*ifort_bug*! if(sep_cache.ne.' ')then ! use cached value. NOTE: A parallel code might theoretically use multiple OS + !*ifort_bug*! sep=sep_cache + !*ifort_bug*! return + !*ifort_bug*! endif + + arg0_length=0 + name=' ' + call get_command_argument(0,length=arg0_length,status=istat) + if(allocated(arg0))deallocate(arg0) + allocate(character(len=arg0_length) :: arg0) + call get_command_argument(0,arg0,status=istat) + ! check argument name + if(index(arg0,'\').ne.0)then + sep='\' + elseif(index(arg0,'/').ne.0)then + sep='/' + else + ! try name returned by INQUIRE(3f) + existing=.false. + name=' ' + inquire(file=arg0,iostat=istat,exist=existing,name=name) + if(index(name,'\').ne.0)then + sep='\' + elseif(index(name,'/').ne.0)then + sep='/' + else + ! well, try some common syntax and assume in current directory + fname='.\'//arg0 + inquire(file=fname,iostat=istat,exist=existing) + if(existing)then + sep='/' + else + fname='./'//arg0 + inquire(file=fname,iostat=istat,exist=existing) + if(existing)then + sep='/' + else ! check environment variable PATH + sep=merge('\','/',index(get_env('PATH'),'\').ne.0) + !*!write(*,*)'unknown system directory path separator' + endif + endif + endif + endif + !*ifort_bug*!sep_cache=sep +end function separator + end module fpm_environment diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index 5811cd418a..8b060c383b 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -3,11 +3,13 @@ module fpm_filesystem use fpm_environment, only: get_os_type, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD + use fpm_environment, only: separator, get_env use fpm_strings, only: f_string, replace, string_t, split implicit none private public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, read_lines, list_files, env_variable, & mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file, to_fortran_name + public :: which public :: fileopen, fileclose, filewrite, warnwrite integer, parameter :: LINE_BUFFER_LEN = 1000 @@ -570,4 +572,84 @@ pure function to_fortran_name(string) result(res) res = replace(string, SPECIAL_CHARACTERS, '_') end function to_fortran_name +function which(command) result(pathname) +!> +!!##NAME +!! which(3f) - [M_io:ENVIRONMENT] given a command name find the pathname by searching +!! the directories in the environment variable $PATH +!! (LICENSE:PD) +!! +!!##SYNTAX +!! function which(command) result(pathname) +!! +!! character(len=*),intent(in) :: command +!! character(len=:),allocatable :: pathname +!! +!!##DESCRIPTION +!! Given a command name find the first file with that name in the directories +!! specified by the environment variable $PATH. +!! +!!##OPTIONS +!! COMMAND the command to search for +!! +!!##RETURNS +!! PATHNAME the first pathname found in the current user path. Returns blank +!! if the command is not found. +!! +!!##EXAMPLE +!! +!! Sample program: +!! +!! Checking the error message and counting lines: +!! +!! program demo_which +!! use M_io, only : which +!! implicit none +!! write(*,*)'ls is ',which('ls') +!! write(*,*)'dir is ',which('dir') +!! write(*,*)'install is ',which('install') +!! end program demo_which +!! +!!##AUTHOR +!! John S. Urban +!!##LICENSE +!! Public Domain + +character(len=*),intent(in) :: command +character(len=:),allocatable :: pathname, checkon, paths(:), exts(:) +integer :: i, j + pathname='' + call split(get_env('PATH'),paths,delimiters=merge(';',':',separator().eq.'\')) + SEARCH: do i=1,size(paths) + checkon=trim(join_path(trim(paths(i)),command)) + select case(separator()) + case('/') + if(exists(checkon))then + pathname=checkon + exit SEARCH + endif + case('\') + if(exists(checkon))then + pathname=checkon + exit SEARCH + endif + if(exists(checkon//'.bat'))then + pathname=checkon//'.bat' + exit SEARCH + endif + if(exists(checkon//'.exe'))then + pathname=checkon//'.exe' + exit SEARCH + endif + call split(get_env('PATHEXT'),exts,delimiters=';') + do j=1,size(exts) + if(exists(checkon//'.'//trim(exts(j))))then + pathname=checkon//'.'//trim(exts(j)) + exit SEARCH + endif + enddo + end select + enddo SEARCH +end function which + end module fpm_filesystem From b5829082a6c7e5779ff1bb2510857fc388189ec9 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Sat, 20 Feb 2021 16:03:03 -0500 Subject: [PATCH 2/3] increment version to 0.1.4 from 0.1.3 --- fpm/fpm.toml | 2 +- fpm/src/fpm_command_line.f90 | 11 ++--------- 2 files changed, 3 insertions(+), 10 deletions(-) diff --git a/fpm/fpm.toml b/fpm/fpm.toml index 4fdac6c935..12d830efa9 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -1,5 +1,5 @@ name = "fpm" -version = "0.1.3" +version = "0.1.4" license = "MIT" author = "fpm maintainers" maintainer = "" diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 9885b0789c..2857643267 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -132,7 +132,7 @@ subroutine get_command_line_settings(cmd_settings) case default ; os_type = "OS Type: UNKNOWN" end select version_text = [character(len=80) :: & - & 'Version: 0.1.3, alpha', & + & 'Version: 0.1.4, alpha', & & 'Program: fpm(1)', & & 'Description: A Fortran package manager and build system', & & 'Home Page: https://github.com/fortran-lang/fpm', & @@ -143,13 +143,6 @@ subroutine get_command_line_settings(cmd_settings) ! not starting with dash CLI_RESPONSE_FILE=.true. cmdarg = get_subcommand() - if(cmdarg.eq.' ')then - write(stderr,'(*(g0))')' internal failure in response file processing' - do i = 1, command_argument_count() - call get_command_argument(i, cmdarg) - if(adjustl(cmdarg(1:1)) .ne. '-')exit - enddo - endif ! now set subcommand-specific help text and process commandline ! arguments. Then call subcommand routine @@ -615,7 +608,7 @@ subroutine set_help() ' + run Run the local package binaries. defaults to all binaries for ', & ' that release. ', & ' + test Run the tests. ', & - ' + help Alternate method for displaying subcommand help. ', & + ' + help Alternate to the --help switch for displaying help text. ', & ' + list Display brief descriptions of all subcommands. ', & ' + install Install project ', & ' ', & From 7ca62d05819d53eb397f7ffa9ebd817400c57cf0 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Mon, 22 Feb 2021 00:40:06 -0500 Subject: [PATCH 3/3] correct backslash in separator() --- fpm/src/fpm_environment.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm_environment.f90 b/fpm/src/fpm_environment.f90 index 4ca43f177e..1ce1fafcdc 100644 --- a/fpm/src/fpm_environment.f90 +++ b/fpm/src/fpm_environment.f90 @@ -280,7 +280,7 @@ function separator() result(sep) fname='.\'//arg0 inquire(file=fname,iostat=istat,exist=existing) if(existing)then - sep='/' + sep='\' else fname='./'//arg0 inquire(file=fname,iostat=istat,exist=existing)