get_command_line_settings Subroutine

public subroutine get_command_line_settings(cmd_settings)

! canon_path is not converting “.”, etc. & ‘ unknown help topic “’//trim(unnamed(i)).’not found in:’,manual]

Arguments

Type IntentOptional Attributes Name
class(fpm_cmd_settings), intent(out), allocatable :: cmd_settings

Source Code

    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