Skip to content

Commit 75af0a2

Browse files
urbanjosturbanjost
committed
alpha plugins, take III
1 parent 6d9004d commit 75af0a2

File tree

4 files changed

+239
-26
lines changed

4 files changed

+239
-26
lines changed

‎fpm.toml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ rev = "2f5eaba864ff630ba0c3791126a3f811b6e437f3"
1212

1313
[dependencies.M_CLI2]
1414
git = "https://github.com/urbanjost/M_CLI2.git"
15-
rev = "e59fb2bfcf36199f1af506f937b3849180454a0f"
15+
rev = "3351d3453e4e228583e63409b4b8c727b2f242e5"
1616

1717
[[test]]
1818
name = "cli-test"

‎src/fpm_command_line.f90

Lines changed: 27 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -27,8 +27,10 @@ module fpm_command_line
2727
OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
2828
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD
2929
use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified
30+
use M_CLI2, only : get_subcommand, CLI_RESPONSE_FILE
3031
use fpm_strings, only : lower, split, fnv_1a
31-
use fpm_filesystem, only : basename, canon_path, to_fortran_name
32+
use fpm_filesystem, only : basename, canon_path, to_fortran_name, which
33+
use fpm_environment, only : run, get_command_arguments_quoted
3234
use fpm_compiler, only : get_default_compile_flags
3335
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, &
3436
& stdout=>output_unit, &
@@ -142,11 +144,8 @@ subroutine get_command_line_settings(cmd_settings)
142144
& os_type]
143145
! find the subcommand name by looking for first word on command
144146
! not starting with dash
145-
cmdarg=' '
146-
do i = 1, command_argument_count()
147-
call get_command_argument(i, cmdarg)
148-
if(adjustl(cmdarg(1:1)) .ne. '-')exit
149-
enddo
147+
CLI_RESPONSE_FILE=.true.
148+
cmdarg = get_subcommand()
150149

151150
! now set subcommand-specific help text and process commandline
152151
! arguments. Then call subcommand routine
@@ -440,26 +439,29 @@ subroutine get_command_line_settings(cmd_settings)
440439
clean=lget('clean'))
441440

442441
case default
443-
444-
call set_args('&
445-
& --list F&
446-
& --verbose F&
447-
&', help_fpm, version_text)
448-
! Note: will not get here if --version or --usage or --help
449-
! is present on commandline
450-
help_text=help_usage
451-
if(lget('list'))then
452-
help_text=help_list_dash
453-
elseif(len_trim(cmdarg).eq.0)then
454-
write(stdout,'(*(a))')'Fortran Package Manager:'
455-
write(stdout,'(*(a))')' '
456-
call printhelp(help_list_nodash)
442+
if(which('fpm-'//cmdarg).ne.'')then
443+
call run('fpm-'//trim(cmdarg)//' '// get_command_arguments_quoted(),.false.)
457444
else
458-
write(stderr,'(*(a))')'<ERROR> unknown subcommand [', &
459-
& trim(cmdarg), ']'
460-
call printhelp(help_list_dash)
445+
call set_args('&
446+
& --list F&
447+
& --verbose F&
448+
&', help_fpm, version_text)
449+
! Note: will not get here if --version or --usage or --help
450+
! is present on commandline
451+
help_text=help_usage
452+
if(lget('list'))then
453+
help_text=help_list_dash
454+
elseif(len_trim(cmdarg).eq.0)then
455+
write(stdout,'(*(a))')'Fortran Package Manager:'
456+
write(stdout,'(*(a))')' '
457+
call printhelp(help_list_nodash)
458+
else
459+
write(stderr,'(*(a))')'<ERROR> unknown subcommand [', &
460+
& trim(cmdarg), ']'
461+
call printhelp(help_list_dash)
462+
endif
463+
call printhelp(help_text)
461464
endif
462-
call printhelp(help_text)
463465

464466
end select
465467
contains
@@ -655,7 +657,7 @@ subroutine set_help()
655657
' + run Run the local package binaries. defaults to all binaries for ', &
656658
' that release. ', &
657659
' + test Run the tests. ', &
658-
' + help Alternate method for displaying subcommand help. ', &
660+
' + help Alternate to the --help switch for displaying help text. ', &
659661
' + list Display brief descriptions of all subcommands. ', &
660662
' + install Install project ', &
661663
' ', &

‎src/fpm_environment.f90

Lines changed: 128 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,13 +3,18 @@
33
!! * [get_os_type] -- Determine the OS type
44
!! * [get_env] -- return the value of an environment variable
55
module fpm_environment
6+
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, &
7+
& stdout=>output_unit, &
8+
& stderr=>error_unit
69
implicit none
710
private
811
public :: get_os_type
912
public :: os_is_unix
1013
public :: run
1114
public :: get_env
1215
public :: get_archiver
16+
public :: get_command_arguments_quoted
17+
public :: separator
1318

1419
integer, parameter, public :: OS_UNKNOWN = 0
1520
integer, parameter, public :: OS_LINUX = 1
@@ -210,4 +215,127 @@ function get_archiver() result(archiver)
210215
end if
211216
end associate
212217
end function
218+
function get_command_arguments_quoted() result(args)
219+
character(len=:),allocatable :: args
220+
character(len=:),allocatable :: arg
221+
character(len=1) :: quote
222+
integer :: ilength, istatus, i
223+
ilength=0
224+
args=''
225+
quote=merge('"',"'",separator().eq.'\')
226+
do i=2,command_argument_count() ! look at all arguments after subcommand
227+
call get_command_argument(number=i,length=ilength,status=istatus)
228+
if(istatus /= 0) then
229+
write(stderr,'(*(g0,1x))')'<ERROR>*get_command_arguments_stack* error obtaining argument ',i
230+
exit
231+
else
232+
if(allocated(arg))deallocate(arg)
233+
allocate(character(len=ilength) :: arg)
234+
call get_command_argument(number=i,value=arg,length=ilength,status=istatus)
235+
if(istatus /= 0) then
236+
write(stderr,'(*(g0,1x))')'<ERROR>*get_command_arguments_stack* error obtaining argument ',i
237+
exit
238+
elseif(ilength.gt.0)then
239+
if(index(arg//' ','-').ne.1)then
240+
args=args//quote//arg//quote//' '
241+
else
242+
args=args//arg//' '
243+
endif
244+
else
245+
args=args//repeat(quote,2)//' '
246+
endif
247+
endif
248+
enddo
249+
end function get_command_arguments_quoted
250+
251+
function separator() result(sep)
252+
!>
253+
!!##NAME
254+
!! separator(3f) - [M_io:ENVIRONMENT] try to determine pathname directory separator character
255+
!! (LICENSE:PD)
256+
!!
257+
!!##SYNOPSIS
258+
!!
259+
!! function separator() result(sep)
260+
!!
261+
!! character(len=1) :: sep
262+
!!
263+
!!##DESCRIPTION
264+
!! First using the name the program was invoked with, then the name
265+
!! returned by an INQUIRE(3f) of that name, then ".\NAME" and "./NAME"
266+
!! try to determine the separator character used to separate directory
267+
!! names from file basenames.
268+
!!
269+
!! If a slash or backslash is not found in the name, the environment
270+
!! variable PATH is examined first for a backslash, then a slash.
271+
!!
272+
!! Can be very system dependent. If the queries fail the default returned
273+
!! is "/".
274+
!!
275+
!!##EXAMPLE
276+
!!
277+
!! sample usage
278+
!!
279+
!! program demo_separator
280+
!! use M_io, only : separator
281+
!! implicit none
282+
!! write(*,*)'separator=',separator()
283+
!! end program demo_separator
284+
285+
! use the pathname returned as arg0 to determine pathname separator
286+
implicit none
287+
character(len=:),allocatable :: arg0
288+
integer :: arg0_length
289+
integer :: istat
290+
logical :: existing
291+
character(len=1) :: sep
292+
!*ifort_bug*!character(len=1),save :: sep_cache=' '
293+
character(len=4096) :: name
294+
character(len=:),allocatable :: fname
295+
296+
!*ifort_bug*! if(sep_cache.ne.' ')then ! use cached value. NOTE: A parallel code might theoretically use multiple OS
297+
!*ifort_bug*! sep=sep_cache
298+
!*ifort_bug*! return
299+
!*ifort_bug*! endif
300+
301+
arg0_length=0
302+
name=' '
303+
call get_command_argument(0,length=arg0_length,status=istat)
304+
if(allocated(arg0))deallocate(arg0)
305+
allocate(character(len=arg0_length) :: arg0)
306+
call get_command_argument(0,arg0,status=istat)
307+
! check argument name
308+
if(index(arg0,'\').ne.0)then
309+
sep='\'
310+
elseif(index(arg0,'/').ne.0)then
311+
sep='/'
312+
else
313+
! try name returned by INQUIRE(3f)
314+
existing=.false.
315+
name=' '
316+
inquire(file=arg0,iostat=istat,exist=existing,name=name)
317+
if(index(name,'\').ne.0)then
318+
sep='\'
319+
elseif(index(name,'/').ne.0)then
320+
sep='/'
321+
else
322+
! well, try some common syntax and assume in current directory
323+
fname='.\'//arg0
324+
inquire(file=fname,iostat=istat,exist=existing)
325+
if(existing)then
326+
sep='\'
327+
else
328+
fname='./'//arg0
329+
inquire(file=fname,iostat=istat,exist=existing)
330+
if(existing)then
331+
sep='/'
332+
else ! check environment variable PATH
333+
sep=merge('\','/',index(get_env('PATH'),'\').ne.0)
334+
!*!write(*,*)'<WARNING>unknown system directory path separator'
335+
endif
336+
endif
337+
endif
338+
endif
339+
!*ifort_bug*!sep_cache=sep
340+
end function separator
213341
end module fpm_environment

‎src/fpm_filesystem.f90

Lines changed: 83 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,15 +5,18 @@ module fpm_filesystem
55
use fpm_environment, only: get_os_type, &
66
OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
77
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD
8+
use fpm_environment, only: separator, get_env
89
use fpm_strings, only: f_string, replace, string_t, split
910
implicit none
1011
private
1112
public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, read_lines, list_files, env_variable, &
1213
mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file, to_fortran_name
1314
public :: fileopen, fileclose, filewrite, warnwrite
15+
public :: which
1416

1517
integer, parameter :: LINE_BUFFER_LEN = 1000
1618

19+
1720
contains
1821

1922

@@ -609,4 +612,84 @@ pure function to_fortran_name(string) result(res)
609612
res = replace(string, SPECIAL_CHARACTERS, '_')
610613
end function to_fortran_name
611614

615+
function which(command) result(pathname)
616+
!>
617+
!!##NAME
618+
!! which(3f) - [M_io:ENVIRONMENT] given a command name find the pathname by searching
619+
!! the directories in the environment variable $PATH
620+
!! (LICENSE:PD)
621+
!!
622+
!!##SYNTAX
623+
!! function which(command) result(pathname)
624+
!!
625+
!! character(len=*),intent(in) :: command
626+
!! character(len=:),allocatable :: pathname
627+
!!
628+
!!##DESCRIPTION
629+
!! Given a command name find the first file with that name in the directories
630+
!! specified by the environment variable $PATH.
631+
!!
632+
!!##OPTIONS
633+
!! COMMAND the command to search for
634+
!!
635+
!!##RETURNS
636+
!! PATHNAME the first pathname found in the current user path. Returns blank
637+
!! if the command is not found.
638+
!!
639+
!!##EXAMPLE
640+
!!
641+
!! Sample program:
642+
!!
643+
!! Checking the error message and counting lines:
644+
!!
645+
!! program demo_which
646+
!! use M_io, only : which
647+
!! implicit none
648+
!! write(*,*)'ls is ',which('ls')
649+
!! write(*,*)'dir is ',which('dir')
650+
!! write(*,*)'install is ',which('install')
651+
!! end program demo_which
652+
!!
653+
!!##AUTHOR
654+
!! John S. Urban
655+
!!##LICENSE
656+
!! Public Domain
657+
658+
character(len=*),intent(in) :: command
659+
character(len=:),allocatable :: pathname, checkon, paths(:), exts(:)
660+
integer :: i, j
661+
pathname=''
662+
call split(get_env('PATH'),paths,delimiters=merge(';',':',separator().eq.'\'))
663+
SEARCH: do i=1,size(paths)
664+
checkon=trim(join_path(trim(paths(i)),command))
665+
select case(separator())
666+
case('/')
667+
if(exists(checkon))then
668+
pathname=checkon
669+
exit SEARCH
670+
endif
671+
case('\')
672+
if(exists(checkon))then
673+
pathname=checkon
674+
exit SEARCH
675+
endif
676+
if(exists(checkon//'.bat'))then
677+
pathname=checkon//'.bat'
678+
exit SEARCH
679+
endif
680+
if(exists(checkon//'.exe'))then
681+
pathname=checkon//'.exe'
682+
exit SEARCH
683+
endif
684+
call split(get_env('PATHEXT'),exts,delimiters=';')
685+
do j=1,size(exts)
686+
if(exists(checkon//'.'//trim(exts(j))))then
687+
pathname=checkon//'.'//trim(exts(j))
688+
exit SEARCH
689+
endif
690+
enddo
691+
end select
692+
enddo SEARCH
693+
end function which
694+
612695
end module fpm_filesystem

0 commit comments

Comments
 (0)