! 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_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 = " ", build_dir_env = "BUILD_DIR", build_dir_default = "build" 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)//'"' // & ' --build-dir "'//get_fpm_env(build_dir_env, build_dir_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) ! Collect target names 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='"') ! Allocate and populate (parent build settings via helper) allocate(fpm_run_settings :: cmd_settings) select type (cmd => cmd_settings) type is (fpm_run_settings) call build_settings(cmd, list=lget('list'), build_tests=.false., & config_file=sget('config-file')) ! Runner defaults/overrides val_runner = sget('runner') if (specified('runner') .and. val_runner == '') val_runner = 'echo' ! Run-specific fields if (allocated(remaining)) cmd%args = remaining cmd%example = lget('example') cmd%name = names cmd%runner = val_runner cmd%runner_args = val_runner_args end select case('build') call set_args(common_args // compiler_args //'& & --list F & & --show-model F & & --dump " " & & --tests F & & --config-file " " & & --',help_build,version_text) ! Create and populate a base fpm_build_settings from CLI/env allocate( fpm_build_settings :: cmd_settings ) select type (cmd => cmd_settings) class is (fpm_build_settings) call build_settings(cmd, list=lget('list'), & show_model=lget('show-model'), & build_tests=lget('tests'), & config_file=sget('config-file') ) end select 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) config_file = sget('config-file') allocate(install_settings) call build_settings(install_settings, list=lget('list'), & build_tests=lget('test'), config_file=config_file) install_settings%no_rebuild = lget('no-rebuild') 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) 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='"') allocate(fpm_test_settings :: cmd_settings) val_runner=sget('runner') if(specified('runner') .and. val_runner=='')val_runner='echo' select type (cmd => cmd_settings) type is (fpm_test_settings) call build_settings(cmd, list=lget('list'), build_tests=.true., & config_file=sget('config-file')) if (allocated(remaining)) cmd%args = remaining cmd%example = .false. cmd%name = names cmd%runner = val_runner cmd%runner_args = val_runner_args end select 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) allocate(export_settings) call build_settings(export_settings, show_model=.true.) 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 // compiler_args // & & ' --registry-cache' // & & ' --skip' // & & ' --all' // & & ' --test' // & & ' --apps' // & & ' --examples' // & & ' --config-file ""', help_clean, version_text) block logical :: skip, clean_all, clean_test, clean_apps, clean_examples logical :: target_specific skip = lget('skip') clean_all = lget('all') clean_test = lget('test') clean_apps = lget('apps') clean_examples = lget('examples') config_file = sget('config-file') target_specific = any([clean_test, clean_apps, clean_examples]) if (all([skip, clean_all])) then call fpm_stop(6, 'Do not specify both --skip and --all options on the clean subcommand.') end if if (target_specific .and. any([skip, clean_all])) then call fpm_stop(6, 'Cannot combine target-specific flags (--test, --apps, --examples) with --skip or --all.') end if allocate(fpm_clean_settings :: cmd_settings) select type (cln => cmd_settings) type is (fpm_clean_settings) call build_settings(cln, config_file=config_file) cln%clean_skip = skip cln%registry_cache = lget('registry-cache') cln%clean_all = clean_all cln%clean_test = clean_test cln%clean_apps = clean_apps cln%clean_examples = clean_examples ! Ensure tests will be modeled if they have to be cleaned if (clean_test) cln%build_tests = .true. end select 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) config_file = sget('config-file') token_s = sget('token') allocate(fpm_publish_settings :: cmd_settings) select type (pub => cmd_settings) type is (fpm_publish_settings) call build_settings(pub, list=lget('list'), show_model=lget('show-model'), & build_tests=lget('tests'), config_file=config_file) pub%show_package_version = lget('show-package-version') pub%show_upload_data = lget('show-upload-data') pub%is_dry_run = lget('dry-run') pub%token = token_s end select 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 end subroutine get_command_line_settings