! 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(fpm_publish_settings), allocatable :: publish_settings type(fpm_export_settings) , allocatable :: export_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, config_file 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 & & --config-file " " & & --',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') config_file = sget('config-file') 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, & & path_to_config=config_file, & & 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 & & --dump " " & & --tests F & & --config-file " " & & --',help_build,version_text) call check_build_vals() c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') config_file = sget('config-file') val_dump = sget('dump') if (specified('dump') .and. val_dump=='')val_dump='fpm_model.toml' allocate( fpm_build_settings :: cmd_settings ) cmd_settings=fpm_build_settings( & & profile=val_profile,& & dump=val_dump,& & prune=.not.lget('no-prune'), & & compiler=val_compiler, & & c_compiler=c_compiler, & & cxx_compiler=cxx_compiler, & & archiver=archiver, & & path_to_config=config_file, & & 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 & & --test F & & --libdir "lib" & & --bindir "bin" & & --testdir "test" & & --includedir "include" & & --config-file " " & &', help_install, version_text) call check_build_vals() c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') config_file = sget('config-file') allocate(install_settings, source=fpm_install_settings(& list=lget('list'), & build_tests=lget('test'), & profile=val_profile,& prune=.not.lget('no-prune'), & compiler=val_compiler, & c_compiler=c_compiler, & cxx_compiler=cxx_compiler, & archiver=archiver, & path_to_config=config_file, & 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%testdir, 'testdir') 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 // '& & --config-file " " & & -- ', 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') config_file = sget('config-file') 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, & & path_to_config=config_file, & & 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 & & --dump " " & & --config-file " " & &', help_update, version_text) if( size(unnamed) > 1 )then names=unnamed(2:) else names=[character(len=len(names)) :: ] endif config_file = sget('config-file') val_dump = sget('dump') if (specified('dump') .and. val_dump=='')val_dump='fpm_dependencies.toml' allocate(fpm_update_settings :: cmd_settings) cmd_settings=fpm_update_settings(name=names, & & fetch_only=lget('fetch-only'), & & dump=val_dump, & & verbose=lget('verbose'), & & path_to_config=config_file, & & clean=lget('clean')) case('export') call set_args(common_args // compiler_args // '& & --manifest "filename" & & --model "filename" & & --dependencies "filename" ', & help_build, version_text) call check_build_vals() c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') allocate(export_settings, source=fpm_export_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, & show_model=.true., & cxxflag=val_cxxflag, & ldflag=val_ldflag, & verbose=lget('verbose'))) call get_char_arg(export_settings%dump_model, 'model') call get_char_arg(export_settings%dump_manifest, 'manifest') call get_char_arg(export_settings%dump_dependencies, 'dependencies') call move_alloc(export_settings, cmd_settings) case('clean') call set_args(common_args // & & ' --registry-cache' // & & ' --skip' // & & ' --all' // & & ' --config-file ""', help_clean, version_text) block logical :: skip, clean_all skip = lget('skip') clean_all = lget('all') config_file = sget('config-file') if (all([skip, clean_all])) then call fpm_stop(6, 'Do not specify both --skip and --all options on the clean subcommand.') end if allocate(fpm_clean_settings :: cmd_settings) call get_current_directory(working_dir, error) cmd_settings = fpm_clean_settings( & & working_dir=working_dir, & & clean_skip=skip, & & registry_cache=lget('registry-cache'), & & clean_all=clean_all, & & path_to_config=config_file) end block 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 & & --config-file " " & & --', help_publish, version_text) call check_build_vals() c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') config_file = sget('config-file') 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'),& & path_to_config=config_file, & & 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