! canon_path is not converting “.”, etc.
& ‘
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| class(fpm_cmd_settings), | intent(out), | allocatable | :: | cmd_settings |
subroutine get_command_line_settings(cmd_settings)
class(fpm_cmd_settings), allocatable, intent(out) :: cmd_settings
integer, parameter :: widest = 256
character(len=4096) :: cmdarg
integer :: i
integer :: os
type(fpm_install_settings), allocatable :: install_settings
type(version_t) :: version
character(len=:), allocatable :: common_args, compiler_args, run_args, working_dir, &
& c_compiler, cxx_compiler, archiver, version_s, token_s
character(len=*), parameter :: fc_env = "FC", cc_env = "CC", ar_env = "AR", &
& fflags_env = "FFLAGS", cflags_env = "CFLAGS", cxxflags_env = "CXXFLAGS", ldflags_env = "LDFLAGS", &
& fc_default = "gfortran", cc_default = " ", ar_default = " ", flags_default = " ", &
& cxx_env = "CXX", cxx_default = " "
type(error_t), allocatable :: error
call set_help()
os = get_os_type()
! text for --version switch,
select case (os)
case (OS_LINUX); os_type = "OS Type: Linux"
case (OS_MACOS); os_type = "OS Type: macOS"
case (OS_WINDOWS); os_type = "OS Type: Windows"
case (OS_CYGWIN); os_type = "OS Type: Cygwin"
case (OS_SOLARIS); os_type = "OS Type: Solaris"
case (OS_FREEBSD); os_type = "OS Type: FreeBSD"
case (OS_OPENBSD); os_type = "OS Type: OpenBSD"
case (OS_UNKNOWN); os_type = "OS Type: Unknown"
case default ; os_type = "OS Type: UNKNOWN"
end select
! Get current release version
version = fpm_version()
version_s = version%s()
version_text = [character(len=80) :: &
& 'Version: '//trim(version_s)//', alpha', &
& 'Program: fpm(1)', &
& 'Description: A Fortran package manager and build system', &
& '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
CLI_RESPONSE_FILE=.true.
cmdarg = get_subcommand()
common_args = &
' --directory:C " "' // &
' --verbose F'
run_args = &
' --target " "' // &
' --list F' // &
' --runner " "' // &
' --runner-args " "'
compiler_args = &
' --profile " "' // &
' --no-prune F' // &
' --compiler "'//get_fpm_env(fc_env, fc_default)//'"' // &
' --c-compiler "'//get_fpm_env(cc_env, cc_default)//'"' // &
' --cxx-compiler "'//get_fpm_env(cxx_env, cxx_default)//'"' // &
' --archiver "'//get_fpm_env(ar_env, ar_default)//'"' // &
' --flag:: "'//get_fpm_env(fflags_env, flags_default)//'"' // &
' --c-flag:: "'//get_fpm_env(cflags_env, flags_default)//'"' // &
' --cxx-flag:: "'//get_fpm_env(cxxflags_env, flags_default)//'"' // &
' --link-flag:: "'//get_fpm_env(ldflags_env, flags_default)//'"'
! now set subcommand-specific help text and process commandline
! arguments. Then call subcommand routine
select case(trim(cmdarg))
case('run')
call set_args(common_args // compiler_args // run_args //'&
& --all F &
& --example F&
& --',help_run,version_text)
call check_build_vals()
if( size(unnamed) > 1 )then
names=unnamed(2:)
else
names=[character(len=len(names)) :: ]
endif
if(specified('target') )then
call split(sget('target'),tnames,delimiters=' ,:')
names=[character(len=max(len(names),len(tnames))) :: names,tnames]
endif
! convert --all to '*'
if(lget('all'))then
names=[character(len=max(len(names),1)) :: names,'*' ]
endif
! convert special string '..' to equivalent (shorter) '*'
! to allow for a string that does not require shift-key and quoting
do i=1,size(names)
if(names(i)=='..')names(i)='*'
enddo
! If there are additional command-line arguments, remove the additional
! double quotes which have been added by M_CLI2
val_runner_args=sget('runner-args')
call remove_characters_in_set(val_runner_args,set='"')
c_compiler = sget('c-compiler')
cxx_compiler = sget('cxx-compiler')
archiver = sget('archiver')
allocate(fpm_run_settings :: cmd_settings)
val_runner=sget('runner')
if(specified('runner') .and. val_runner=='')val_runner='echo'
cmd_settings=fpm_run_settings(&
& args=remaining,&
& profile=val_profile,&
& prune=.not.lget('no-prune'), &
& compiler=val_compiler, &
& c_compiler=c_compiler, &
& cxx_compiler=cxx_compiler, &
& archiver=archiver, &
& flag=val_flag, &
& cflag=val_cflag, &
& cxxflag=val_cxxflag, &
& ldflag=val_ldflag, &
& example=lget('example'), &
& list=lget('list'),&
& build_tests=.false.,&
& name=names,&
& runner=val_runner,&
& runner_args=val_runner_args, &
& verbose=lget('verbose') )
case('build')
call set_args(common_args // compiler_args //'&
& --list F &
& --show-model F &
& --tests F &
& --',help_build,version_text)
call check_build_vals()
c_compiler = sget('c-compiler')
cxx_compiler = sget('cxx-compiler')
archiver = sget('archiver')
allocate( fpm_build_settings :: cmd_settings )
cmd_settings=fpm_build_settings( &
& profile=val_profile,&
& prune=.not.lget('no-prune'), &
& compiler=val_compiler, &
& c_compiler=c_compiler, &
& cxx_compiler=cxx_compiler, &
& archiver=archiver, &
& flag=val_flag, &
& cflag=val_cflag, &
& cxxflag=val_cxxflag, &
& ldflag=val_ldflag, &
& list=lget('list'),&
& show_model=lget('show-model'),&
& build_tests=lget('tests'),&
& verbose=lget('verbose') )
case('new')
call set_args(common_args // '&
& --src F &
& --lib F &
& --app F &
& --test F &
& --example F &
& --backfill F &
& --full F &
& --bare F', &
& help_new, version_text)
select case(size(unnamed))
case(1)
if(lget('backfill'))then
name='.'
else
write(stderr,'(*(7x,g0,/))') &
& '<USAGE> fpm new NAME [[--lib|--src] [--app] [--test] [--example]]|[--full|--bare] [--backfill]'
call fpm_stop(1,'directory name required')
endif
case(2)
name=trim(unnamed(2))
case default
write(stderr,'(7x,g0)') &
& '<USAGE> fpm new NAME [[--lib|--src] [--app] [--test] [--example]]| [--full|--bare] [--backfill]'
call fpm_stop(2,'only one directory name allowed')
end select
!*! canon_path is not converting ".", etc.
if(name=='.')then
call get_current_directory(name, error)
if (allocated(error)) then
write(stderr, '("[Error]", 1x, a)') error%message
stop 1
endif
endif
name=canon_path(name)
if( .not.is_fortran_name(to_fortran_name(basename(name))) )then
write(stderr,'(g0)') [ character(len=72) :: &
& '<ERROR> the fpm project name must be made of up to 63 ASCII letters,', &
& ' numbers, underscores, or hyphens, and start with a letter.']
call fpm_stop(4,' ')
endif
allocate(fpm_new_settings :: cmd_settings)
if (any( specified([character(len=10) :: 'src','lib','app','test','example','bare'])) &
& .and.lget('full') )then
write(stderr,'(*(a))')&
&'<ERROR> --full and any of [--src|--lib,--app,--test,--example,--bare]', &
&' are mutually exclusive.'
call fpm_stop(5,' ')
elseif (any( specified([character(len=10) :: 'src','lib','app','test','example','full'])) &
& .and.lget('bare') )then
write(stderr,'(*(a))')&
&'<ERROR> --bare and any of [--src|--lib,--app,--test,--example,--full]', &
&' are mutually exclusive.'
call fpm_stop(3,' ')
elseif (any( specified([character(len=10) :: 'src','lib','app','test','example']) ) )then
cmd_settings=fpm_new_settings(&
& backfill=lget('backfill'), &
& name=name, &
& with_executable=lget('app'), &
& with_lib=any([lget('lib'),lget('src')]), &
& with_test=lget('test'), &
& with_example=lget('example'), &
& verbose=lget('verbose') )
else ! default if no specific directories are requested
cmd_settings=fpm_new_settings(&
& backfill=lget('backfill') , &
& name=name, &
& with_executable=.true., &
& with_lib=.true., &
& with_test=.true., &
& with_example=lget('full'), &
& with_full=lget('full'), &
& with_bare=lget('bare'), &
& verbose=lget('verbose') )
endif
case('help','manual')
call set_args(common_args, help_help,version_text)
if(size(unnamed)<2)then
if(unnamed(1)=='help')then
unnamed=[' ', 'fpm']
else
unnamed=manual
endif
elseif(unnamed(2)=='manual')then
unnamed=manual
endif
allocate(character(len=widest) :: help_text(0))
do i=2,size(unnamed)
select case(unnamed(i))
case(' ' )
case('fpm ' )
help_text=[character(len=widest) :: help_text, help_fpm]
case('new ' )
help_text=[character(len=widest) :: help_text, help_new]
case('build ' )
help_text=[character(len=widest) :: help_text, help_build]
case('install' )
help_text=[character(len=widest) :: help_text, help_install]
case('run ' )
help_text=[character(len=widest) :: help_text, help_run]
case('test ' )
help_text=[character(len=widest) :: help_text, help_test]
case('runner' )
help_text=[character(len=widest) :: help_text, help_runner]
case('list ' )
help_text=[character(len=widest) :: help_text, help_list]
case('update ' )
help_text=[character(len=widest) :: help_text, help_update]
case('help ' )
help_text=[character(len=widest) :: help_text, help_help]
case('version' )
help_text=[character(len=widest) :: help_text, version_text]
case('clean' )
help_text=[character(len=widest) :: help_text, help_clean]
case('publish')
help_text=[character(len=widest) :: help_text, help_publish]
case default
help_text=[character(len=widest) :: help_text, &
& '<ERROR> unknown help topic "'//trim(unnamed(i))//'"']
!!& '<ERROR> unknown help topic "'//trim(unnamed(i)).'not found in:',manual]
end select
enddo
call printhelp(help_text)
case('install')
call set_args(common_args // compiler_args // '&
& --no-rebuild F --prefix " " &
& --list F &
& --libdir "lib" --bindir "bin" --includedir "include"', &
help_install, version_text)
call check_build_vals()
c_compiler = sget('c-compiler')
cxx_compiler = sget('cxx-compiler')
archiver = sget('archiver')
allocate(install_settings, source=fpm_install_settings(&
list=lget('list'), &
profile=val_profile,&
prune=.not.lget('no-prune'), &
compiler=val_compiler, &
c_compiler=c_compiler, &
cxx_compiler=cxx_compiler, &
archiver=archiver, &
flag=val_flag, &
cflag=val_cflag, &
cxxflag=val_cxxflag, &
ldflag=val_ldflag, &
no_rebuild=lget('no-rebuild'), &
verbose=lget('verbose')))
call get_char_arg(install_settings%prefix, 'prefix')
call get_char_arg(install_settings%libdir, 'libdir')
call get_char_arg(install_settings%bindir, 'bindir')
call get_char_arg(install_settings%includedir, 'includedir')
call move_alloc(install_settings, cmd_settings)
case('list')
call set_args(common_args // '&
& --list F&
&', help_list, version_text)
if(lget('list'))then
help_text = [character(widest) :: help_list_nodash, help_list_dash]
else
help_text = help_list_nodash
endif
call printhelp(help_text)
case('test')
call set_args(common_args // compiler_args // run_args // ' --', &
help_test,version_text)
call check_build_vals()
if( size(unnamed) > 1 )then
names=unnamed(2:)
else
names=[character(len=len(names)) :: ]
endif
if(specified('target') )then
call split(sget('target'),tnames,delimiters=' ,:')
names=[character(len=max(len(names),len(tnames))) :: names,tnames]
endif
! convert special string '..' to equivalent (shorter) '*'
! to allow for a string that does not require shift-key and quoting
do i=1,size(names)
if(names(i)=='..')names(i)='*'
enddo
! If there are additional command-line arguments, remove the additional
! double quotes which have been added by M_CLI2
val_runner_args=sget('runner-args')
call remove_characters_in_set(val_runner_args,set='"')
c_compiler = sget('c-compiler')
cxx_compiler = sget('cxx-compiler')
archiver = sget('archiver')
allocate(fpm_test_settings :: cmd_settings)
val_runner=sget('runner')
if(specified('runner') .and. val_runner=='')val_runner='echo'
cmd_settings=fpm_test_settings(&
& args=remaining, &
& profile=val_profile, &
& prune=.not.lget('no-prune'), &
& compiler=val_compiler, &
& c_compiler=c_compiler, &
& cxx_compiler=cxx_compiler, &
& archiver=archiver, &
& flag=val_flag, &
& cflag=val_cflag, &
& cxxflag=val_cxxflag, &
& ldflag=val_ldflag, &
& example=.false., &
& list=lget('list'), &
& build_tests=.true., &
& name=names, &
& runner=val_runner, &
& runner_args=val_runner_args, &
& verbose=lget('verbose'))
case('update')
call set_args(common_args // ' --fetch-only F --clean F', &
help_update, version_text)
if( size(unnamed) > 1 )then
names=unnamed(2:)
else
names=[character(len=len(names)) :: ]
endif
allocate(fpm_update_settings :: cmd_settings)
cmd_settings=fpm_update_settings(name=names, &
fetch_only=lget('fetch-only'), verbose=lget('verbose'), &
clean=lget('clean'))
case('clean')
call set_args(common_args // &
& ' --skip' // &
& ' --all', &
help_clean, version_text)
allocate(fpm_clean_settings :: cmd_settings)
call get_current_directory(working_dir, error)
cmd_settings=fpm_clean_settings( &
& clean_skip=lget('skip'), &
& clean_call=lget('all'))
case('publish')
call set_args(common_args // compiler_args //'&
& --show-package-version F &
& --show-upload-data F &
& --dry-run F &
& --token " " &
& --list F &
& --show-model F &
& --tests F &
& --', help_publish, version_text)
call check_build_vals()
c_compiler = sget('c-compiler')
cxx_compiler = sget('cxx-compiler')
archiver = sget('archiver')
token_s = sget('token')
allocate(fpm_publish_settings :: cmd_settings)
cmd_settings = fpm_publish_settings( &
& show_package_version = lget('show-package-version'), &
& show_upload_data = lget('show-upload-data'), &
& is_dry_run = lget('dry-run'), &
& profile=val_profile,&
& prune=.not.lget('no-prune'), &
& compiler=val_compiler, &
& c_compiler=c_compiler, &
& cxx_compiler=cxx_compiler, &
& archiver=archiver, &
& flag=val_flag, &
& cflag=val_cflag, &
& cxxflag=val_cxxflag, &
& ldflag=val_ldflag, &
& list=lget('list'),&
& show_model=lget('show-model'),&
& build_tests=lget('tests'),&
& verbose=lget('verbose'),&
& token=token_s)
case default
if(cmdarg.ne.''.and.which('fpm-'//cmdarg).ne.'')then
call run('fpm-'//trim(cmdarg)//' '// get_command_arguments_quoted(),.false.)
stop
else
call set_args('&
& --list F&
&', help_fpm, version_text)
! Note: will not get here if --version or --usage or --help
! is present on commandline
if(lget('list'))then
help_text = help_list_dash
elseif(len_trim(cmdarg)==0)then
write(stdout,'(*(a))')'Fortran Package Manager:'
write(stdout,'(*(a))')' '
help_text = [character(widest) :: help_list_nodash, help_usage]
else
write(stderr,'(*(a))')'<ERROR> unknown subcommand [', &
& trim(cmdarg), ']'
help_text = [character(widest) :: help_list_dash, help_usage]
endif
call printhelp(help_text)
endif
end select
if (allocated(cmd_settings)) then
working_dir = sget("directory")
call move_alloc(working_dir, cmd_settings%working_dir)
end if
contains
subroutine check_build_vals()
val_compiler=sget('compiler')
if(val_compiler=='') val_compiler='gfortran'
val_flag = " " // sget('flag')
val_cflag = " " // sget('c-flag')
val_cxxflag = " "// sget('cxx-flag')
val_ldflag = " " // sget('link-flag')
val_profile = sget('profile')
end subroutine check_build_vals
!> Print help text and stop
subroutine printhelp(lines)
character(len=:),intent(in),allocatable :: lines(:)
integer :: iii,ii
if(allocated(lines))then
ii=size(lines)
if(ii > 0 .and. len(lines)> 0) then
write(stdout,'(g0)')(trim(lines(iii)), iii=1, ii)
else
write(stdout,'(a)')'<WARNING> *printhelp* output requested is empty'
endif
endif
stop
end subroutine printhelp
end subroutine get_command_line_settings