plugin alpha version

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"

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,11 @@ 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()
 
         ! now set subcommand-specific help text and process commandline
         ! arguments. Then call subcommand routine
@@ -425,25 +425,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))')'<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
@@ -626,7 +630,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                                            ', &
     '                                                                       ', &

fpm/src/fpm_environment.f90

@@ -3,12 +3,17 @@
 !! * [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
     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
@@ -123,7 +128,7 @@ logical function os_is_unix(os) result(unix)
         end if
         unix = os /= OS_WINDOWS
     end function os_is_unix
-
+    
     !> echo command string and pass it to the system for execution
     subroutine run(cmd,echo)
         character(len=*), intent(in) :: cmd
@@ -182,4 +187,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))')'<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

fpm/src/fpm_filesystem.f90

@@ -5,11 +5,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
@@ -578,4 +580,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