aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn S. Urban <urbanjost@comcast.net>2021-06-01 01:35:23 -0400
committerJohn S. Urban <urbanjost@comcast.net>2021-06-01 01:35:23 -0400
commit75af0a2a395d55344af5be7a3934458fdd8465ea (patch)
tree73b9b2ca7b050931aae3bc4b70c648cb5331eba9
parent6d9004d93460dc15b99051c90d1b58d724b010e6 (diff)
downloadfpm-75af0a2a395d55344af5be7a3934458fdd8465ea.tar.gz
fpm-75af0a2a395d55344af5be7a3934458fdd8465ea.zip
alpha plugins, take III
-rw-r--r--fpm.toml2
-rw-r--r--src/fpm_command_line.f9052
-rw-r--r--src/fpm_environment.f90128
-rw-r--r--src/fpm_filesystem.f9083
4 files changed, 239 insertions, 26 deletions
diff --git a/fpm.toml b/fpm.toml
index 4bd2d96..050bec6 100644
--- a/fpm.toml
+++ b/fpm.toml
@@ -12,7 +12,7 @@ rev = "2f5eaba864ff630ba0c3791126a3f811b6e437f3"
[dependencies.M_CLI2]
git = "https://github.com/urbanjost/M_CLI2.git"
-rev = "e59fb2bfcf36199f1af506f937b3849180454a0f"
+rev = "3351d3453e4e228583e63409b4b8c727b2f242e5"
[[test]]
name = "cli-test"
diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90
index 2a2ecf5..3f24dac 100644
--- a/src/fpm_command_line.f90
+++ b/src/fpm_command_line.f90
@@ -27,8 +27,10 @@ use fpm_environment, only : get_os_type, get_env, &
OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD
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, fnv_1a
-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 fpm_compiler, only : get_default_compile_flags
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, &
& stdout=>output_unit, &
@@ -142,11 +144,8 @@ contains
& 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()
! now set subcommand-specific help text and process commandline
! arguments. Then call subcommand routine
@@ -440,26 +439,29 @@ contains
clean=lget('clean'))
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))')'<ERROR> 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))')'<ERROR> unknown subcommand [', &
+ & trim(cmdarg), ']'
+ call printhelp(help_list_dash)
+ endif
+ call printhelp(help_text)
endif
- call printhelp(help_text)
end select
contains
@@ -655,7 +657,7 @@ contains
' + 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 ', &
' ', &
diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90
index 345f6ab..3754166 100644
--- a/src/fpm_environment.f90
+++ b/src/fpm_environment.f90
@@ -3,6 +3,9 @@
!! * [get_os_type] -- Determine the OS type
!! * [get_env] -- return the value of an environment variable
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
@@ -10,6 +13,8 @@ module fpm_environment
public :: run
public :: get_env
public :: get_archiver
+ public :: get_command_arguments_quoted
+ public :: separator
integer, parameter, public :: OS_UNKNOWN = 0
integer, parameter, public :: OS_LINUX = 1
@@ -210,4 +215,127 @@ contains
end if
end associate
end function
+ 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))')'<ERROR>*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))')'<ERROR>*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(*,*)'<WARNING>unknown system directory path separator'
+ endif
+ endif
+ endif
+ endif
+ !*ifort_bug*!sep_cache=sep
+end function separator
end module fpm_environment
diff --git a/src/fpm_filesystem.f90 b/src/fpm_filesystem.f90
index 28c3b33..87c8a88 100644
--- a/src/fpm_filesystem.f90
+++ b/src/fpm_filesystem.f90
@@ -5,15 +5,18 @@ use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit,
use fpm_environment, only: get_os_type, &
OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD
+ 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 :: fileopen, fileclose, filewrite, warnwrite
+ public :: which
integer, parameter :: LINE_BUFFER_LEN = 1000
+
contains
@@ -609,4 +612,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