Skip to content

Commit 59837ec

Browse files
committed
finish . and ..
finish .. document
1 parent ab57ec6 commit 59837ec

File tree

2 files changed

+26
-13
lines changed

2 files changed

+26
-13
lines changed

fpm/src/fpm.f90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -301,7 +301,7 @@ subroutine cmd_run(settings,test)
301301
& (size(settings%name).eq.0 .and. size(executables).gt.1 .and. .not.test) .and.&
302302
& .not.settings%list) then
303303
line=join(settings%name)
304-
if(line.ne.'.'.and. line.ne.'..')then ! do not report these special strings
304+
if(line.ne.'.')then ! do not report these special strings
305305
if(any(.not.found))then
306306
write(stderr,'(A)',advance="no")'fpm::run<ERROR> specified names '
307307
do j=1,size(settings%name)
@@ -340,7 +340,7 @@ subroutine cmd_run(settings,test)
340340
end do
341341

342342
write(stderr,*)
343-
if(line.eq.'.' .or. line.eq.' '.or. line.eq.'..')then ! do not report these special strings
343+
if(line.eq.'.' .or. line.eq.' ')then ! do not report these special strings
344344
stop
345345
else
346346
stop 1

fpm/src/fpm_command_line.f90

Lines changed: 24 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -172,6 +172,12 @@ subroutine get_command_line_settings(cmd_settings)
172172
names=[character(len=max(len(names),len(tnames))) :: names,tnames]
173173
endif
174174

175+
! convert special string '..' to equivalent (shorter) '*'
176+
! to allow for a string that does not require shift-key and quoting
177+
do i=1,size(names)
178+
if(names(i).eq.'..')names(i)='*'
179+
enddo
180+
175181
allocate(fpm_run_settings :: cmd_settings)
176182
val_runner=sget('runner')
177183
cmd_settings=fpm_run_settings(&
@@ -375,6 +381,12 @@ subroutine get_command_line_settings(cmd_settings)
375381
names=[character(len=max(len(names),len(tnames))) :: names,tnames]
376382
endif
377383

384+
! convert special string '..' to equivalent (shorter) '*'
385+
! to allow for a string that does not require shift-key and quoting
386+
do i=1,size(names)
387+
if(names(i).eq.'..')names(i)='*'
388+
enddo
389+
378390
allocate(fpm_test_settings :: cmd_settings)
379391
val_runner=sget('runner')
380392
cmd_settings=fpm_test_settings(&
@@ -699,16 +711,17 @@ subroutine set_help()
699711
' are automatically rebuilt before being run if they are out of date. ', &
700712
' ', &
701713
'OPTIONS ', &
702-
' --target NAME(s) list of specific application names to execute. ', &
703-
' No name is required if only one application exists.', &
704-
' If no name is supplied and more than one candidate ', &
705-
' exists or a name has no match a list is produced ', &
706-
' and fpm(1) exits. ', &
707-
' Simple "globbing" is supported where "?" represents', &
708-
' any single character and "*" represents any string. ', &
709-
' Therefore a quoted asterisk ''*'' runs all programs. ', &
710-
' The special string "." also causes all targets to ', &
711-
' be listed, even if only a single target exists. ', &
714+
' --target NAME(s) list of specific application names to execute. ', &
715+
' No name is required if only one target exists. ', &
716+
' If no name is supplied and more than one candidate ', &
717+
' exists or a name has no match a list is produced ', &
718+
' and fpm(1) exits. ', &
719+
' Basic "globbing" is supported where "?" represents', &
720+
' any single character and "*" represents any string. ', &
721+
' The special string "." causes all targets to ', &
722+
' be listed, even if only a single target exists. ', &
723+
' The special string ".." causes all targets to ', &
724+
' be executed. ', &
712725
' --example Run example programs instead of applications. ', &
713726
' --release selects the optimized build instead of the debug build. ', &
714727
' --compiler COMPILER_NAME Specify a compiler name. The default is ', &
@@ -726,8 +739,8 @@ subroutine set_help()
726739
' fpm(1) - run or display project applications: ', &
727740
' ', &
728741
' fpm run # run a target when only one exists or list targets ', &
729-
' fpm run ''*'' # run all targets ', &
730742
' fpm run . # list all targets, running nothing ', &
743+
' fpm run .. # run all targets, no matter how many there are ', &
731744
' ', &
732745
' # run default program built or to be built with the compiler command ', &
733746
' # "f90". If more than one app exists a list displays and target names', &

0 commit comments

Comments
 (0)