diff --git a/app/main.f90 b/app/main.f90 index 10f75b8318..95df065097 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -9,6 +9,7 @@ program main fpm_install_settings, & fpm_update_settings, & fpm_clean_settings, & + fpm_publish_settings, & get_command_line_settings use fpm_error, only: error_t use fpm_filesystem, only: exists, parent_dir, join_path @@ -16,6 +17,7 @@ program main use fpm_cmd_install, only: cmd_install use fpm_cmd_new, only: cmd_new use fpm_cmd_update, only : cmd_update +use fpm_cmd_publish, only: cmd_publish use fpm_os, only: change_directory, get_current_directory implicit none @@ -80,6 +82,8 @@ program main call cmd_update(settings) type is (fpm_clean_settings) call cmd_clean(settings) +type is (fpm_publish_settings) + call cmd_publish(settings) end select if (allocated(project_root)) then diff --git a/fpm.toml b/fpm.toml index 98c6643547..dcd3f27743 100644 --- a/fpm.toml +++ b/fpm.toml @@ -11,11 +11,11 @@ macros=["FPM_RELEASE_VERSION={version}"] [dependencies] toml-f.git = "https://github.com/toml-f/toml-f" -toml-f.rev = "54686e45993f3a9a1d05d5c7419f39e7d5a4eb3f" +toml-f.rev = "d7b892b1d074b7cfc5d75c3e0eb36ebc1f7958c1" M_CLI2.git = "https://github.com/urbanjost/M_CLI2.git" M_CLI2.rev = "7264878cdb1baff7323cc48596d829ccfe7751b8" jonquil.git = "https://github.com/toml-f/jonquil" -jonquil.rev = "05d30818bb12fb877226ce284b9a3a41b971a889" +jonquil.rev = "4c27c8c1e411fa8790dffcf8c3fa7a27b6322273" [[test]] name = "cli-test" diff --git a/src/fpm.f90 b/src/fpm.f90 index 5247f9e58d..dcb2321493 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -7,7 +7,6 @@ module fpm fpm_run_settings, fpm_install_settings, fpm_test_settings, & fpm_clean_settings use fpm_dependency, only : new_dependency_tree -use fpm_environment, only: get_env use fpm_filesystem, only: is_dir, join_path, list_files, exists, & basename, filewrite, mkdir, run, os_delete_dir use fpm_model, only: fpm_model_t, srcfile_t, show_model, fortran_features_t, & diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 new file mode 100644 index 0000000000..8ca9a21d2d --- /dev/null +++ b/src/fpm/cmd/publish.f90 @@ -0,0 +1,86 @@ +!> Upload a package to the registry using the `publish` command. +!> +!> To upload a package you need to provide a token that will be linked to your username and created for a namespace. +!> The token can be obtained from the registry website. It can be used as `fpm publish --token `. +module fpm_cmd_publish + use fpm_command_line, only: fpm_publish_settings + use fpm_manifest, only: package_config_t, get_package_data + use fpm_model, only: fpm_model_t + use fpm_error, only: error_t, fpm_stop + use fpm_versioning, only: version_t + use fpm_filesystem, only: exists, join_path, get_tmp_directory + use fpm_git, only: git_archive, compressed_package_name + use fpm_downloader, only: downloader_t + use fpm_strings, only: string_t + use fpm_settings, only: official_registry_base_url + use fpm, only: build_model + + implicit none + private + public :: cmd_publish + +contains + + !> The `publish` command first builds the root package to obtain all the relevant information such as the + !> package version. It then creates a tarball of the package and uploads it to the registry. + subroutine cmd_publish(settings) + type(fpm_publish_settings), intent(inout) :: settings + + type(package_config_t) :: package + type(fpm_model_t) :: model + type(error_t), allocatable :: error + type(version_t), allocatable :: version + type(string_t), allocatable :: form_data(:) + character(len=:), allocatable :: tmpdir + type(downloader_t) :: downloader + integer :: i + + call get_package_data(package, 'fpm.toml', error, apply_defaults=.true.) + if (allocated(error)) call fpm_stop(1, '*cmd_build* Package error: '//error%message) + version = package%version + + ! Build model to obtain dependency tree. + call build_model(model, settings%fpm_build_settings, package, error) + if (allocated(error)) call fpm_stop(1, '*cmd_build* Model error: '//error%message) + + !> Checks before uploading the package. + if (.not. allocated(package%license)) call fpm_stop(1, 'No license specified in fpm.toml.') + if (.not. allocated(version)) call fpm_stop(1, 'No version specified in fpm.toml.') + if (version%s() == '0') call fpm_stop(1, 'Invalid version: "'//version%s()//'".') + if (.not. exists('fpm.toml')) call fpm_stop(1, "Cannot find 'fpm.toml' file. Are you in the project root?") + + ! Check if package contains git dependencies. Only publish packages without git dependencies. + do i = 1, model%deps%ndep + if (allocated(model%deps%dep(i)%git)) then + call fpm_stop(1, "Do not publish packages containing git dependencies. '"//model%deps%dep(i)%name//"' is a git dependency.") + end if + end do + + form_data = [ & + string_t('package_name="'//package%name//'"'), & + string_t('package_license="'//package%license//'"'), & + string_t('package_version="'//version%s()//'"') & + & ] + + if (allocated(settings%token)) form_data = [form_data, string_t('upload_token="'//settings%token//'"')] + + call get_tmp_directory(tmpdir, error) + if (allocated(error)) call fpm_stop(1, '*cmd_publish* Tmp directory error: '//error%message) + call git_archive('.', tmpdir, error) + if (allocated(error)) call fpm_stop(1, '*cmd_publish* Pack error: '//error%message) + form_data = [form_data, string_t('tarball=@"'//join_path(tmpdir, compressed_package_name)//'"')] + + if (settings%show_form_data) then + do i = 1, size(form_data) + print *, form_data(i)%s + end do + return + end if + + ! Make sure a token is provided for publishing. + if (.not. allocated(settings%token)) call fpm_stop(1, 'No token provided.') + + call downloader%upload_form(official_registry_base_url//'/packages', form_data, error) + if (allocated(error)) call fpm_stop(1, '*cmd_publish* Upload error: '//error%message) + end +end diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index d89b6eb836..a12078f5e4 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -668,8 +668,8 @@ subroutine get_from_registry(self, target_dir, global_settings, error, downloade ! Define location of the temporary folder and file. tmp_pkg_path = join_path(global_settings%path_to_config_folder, 'tmp') - tmp_pkg_file = join_path(tmp_pkg_path, 'package_data.tmp') if (.not. exists(tmp_pkg_path)) call mkdir(tmp_pkg_path) + tmp_pkg_file = join_path(tmp_pkg_path, 'package_data.tmp') open (newunit=unit, file=tmp_pkg_file, action='readwrite', iostat=stat) if (stat /= 0) then call fatal_error(error, "Error creating temporary file for downloading package '"//self%name//"'."); return @@ -697,7 +697,6 @@ subroutine get_from_registry(self, target_dir, global_settings, error, downloade if (is_dir(cache_path)) call os_delete_dir(os_is_unix(), cache_path) call mkdir(cache_path) - print *, "Downloading '"//join_path(self%namespace, self%name, version%s())//"' ..." call downloader%get_file(target_url, tmp_pkg_file, error) if (allocated(error)) then close (unit, status='delete'); return @@ -782,7 +781,7 @@ subroutine check_and_read_pkg_data(json, node, download_url, version, error) call fatal_error(error, "Failed to read download url for '"//join_path(node%namespace, node%name)//"'."); return end if - download_url = official_registry_base_url//'/'//download_url + download_url = official_registry_base_url//download_url if (.not. q%has_key('version')) then call fatal_error(error, "Failed to download '"//join_path(node%namespace, node%name)//"': No version found."); return diff --git a/src/fpm/downloader.f90 b/src/fpm/downloader.f90 index 1f631ca0a0..7c5046df4e 100644 --- a/src/fpm/downloader.f90 +++ b/src/fpm/downloader.f90 @@ -3,6 +3,7 @@ module fpm_downloader use fpm_filesystem, only: which use fpm_versioning, only: version_t use jonquil, only: json_object, json_value, json_error, json_load, cast_to_object + use fpm_strings, only: string_t implicit none private @@ -12,12 +13,12 @@ module fpm_downloader !> This type could be entirely avoided but it is quite practical because it can be mocked for testing. type downloader_t contains - procedure, nopass :: get_pkg_data, get_file, unpack + procedure, nopass :: get_pkg_data, get_file, upload_form, unpack end type contains - !> Perform an http get request and save output to file. + !> Perform an http get request, save output to file, and parse json. subroutine get_pkg_data(url, version, tmp_pkg_file, json, error) character(*), intent(in) :: url type(version_t), allocatable, intent(in) :: version @@ -51,6 +52,7 @@ subroutine get_pkg_data(url, version, tmp_pkg_file, json, error) json = ptr end + !> Download a file from a url using either curl or wget. subroutine get_file(url, tmp_pkg_file, error) character(*), intent(in) :: url character(*), intent(in) :: tmp_pkg_file @@ -59,10 +61,10 @@ subroutine get_file(url, tmp_pkg_file, error) integer :: stat if (which('curl') /= '') then - print *, "Downloading package data from '"//url//"' ..." + print *, "Downloading '"//url//"' -> '"//tmp_pkg_file//"'" call execute_command_line('curl '//url//' -s -o '//tmp_pkg_file, exitstat=stat) else if (which('wget') /= '') then - print *, "Downloading package data from '"//url//"' ..." + print *, "Downloading '"//url//"' -> '"//tmp_pkg_file//"'" call execute_command_line('wget '//url//' -q -O '//tmp_pkg_file, exitstat=stat) else call fatal_error(error, "Neither 'curl' nor 'wget' installed."); return @@ -73,6 +75,33 @@ subroutine get_file(url, tmp_pkg_file, error) end if end + !> Perform an http post request with form data. + subroutine upload_form(endpoint, form_data, error) + character(len=*), intent(in) :: endpoint + type(string_t), intent(in) :: form_data(:) + type(error_t), allocatable, intent(out) :: error + + integer :: stat, i + character(len=:), allocatable :: form_data_str + + form_data_str = '' + do i = 1, size(form_data) + form_data_str = form_data_str//"-F '"//form_data(i)%s//"' " + end do + + if (which('curl') /= '') then + print *, 'Uploading package ...' + call execute_command_line('curl -X POST -H "Content-Type: multipart/form-data" ' & + & //form_data_str//endpoint, exitstat=stat) + else + call fatal_error(error, "'curl' not installed."); return + end if + + if (stat /= 0) then + call fatal_error(error, "Error uploading package to registry."); return + end if + end + !> Unpack a tarball to a destination. subroutine unpack(tmp_pkg_file, destination, error) character(*), intent(in) :: tmp_pkg_file diff --git a/src/fpm/error.f90 b/src/fpm/error.f90 index 66bd6ee49d..f4587f654c 100644 --- a/src/fpm/error.f90 +++ b/src/fpm/error.f90 @@ -171,7 +171,7 @@ subroutine fpm_stop(value,message) flush(unit=stderr,iostat=iostat) flush(unit=stdout,iostat=iostat) if(value>0)then - write(stderr,'("",a)')trim(message) + write(stderr,'(" ",a)')trim(message) else write(stderr,'(" ",a)')trim(message) endif diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index bd0af2b443..be4b99bcf6 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -1,16 +1,14 @@ !> Implementation for interacting with git repositories. module fpm_git use fpm_error, only: error_t, fatal_error - use fpm_filesystem, only : get_temp_filename, getline, join_path + use fpm_filesystem, only : get_temp_filename, getline, join_path, execute_and_read_output implicit none - public :: git_target_t - public :: git_target_default, git_target_branch, git_target_tag, & - & git_target_revision - public :: git_revision - public :: git_matches_manifest - public :: operator(==) - + public :: git_target_t, git_target_default, git_target_branch, git_target_tag, git_target_revision, git_revision, & + & git_archive, git_matches_manifest, operator(==), compressed_package_name + + !> Name of the compressed package that is generated temporarily. + character(len=*), parameter :: compressed_package_name = 'compressed_package' !> Possible git target type :: enum_descriptor @@ -307,5 +305,33 @@ subroutine info(self, unit, verbosity) end subroutine info + !> Archive a folder using `git archive`. + subroutine git_archive(source, destination, error) + !> Directory to archive. + character(*), intent(in) :: source + !> Destination of the archive. + character(*), intent(in) :: destination + !> Error handling. + type(error_t), allocatable, intent(out) :: error + + integer :: stat + character(len=:), allocatable :: cmd_output, archive_format + + call execute_and_read_output('git archive -l', cmd_output, error) + if (allocated(error)) return + + if (index(cmd_output, 'tar.gz') /= 0) then + archive_format = 'tar.gz' + else + call fatal_error(error, "Cannot find a suitable archive format for 'git archive'."); return + end if + + call execute_command_line('git archive HEAD --format='//archive_format//' -o '// & + & join_path(destination, compressed_package_name), exitstat=stat) + if (stat /= 0) then + call fatal_error(error, "Error packing '"//source//"'."); return + end if + end + end module fpm_git diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index e966bfa461..ddad144d75 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -80,6 +80,9 @@ module fpm_manifest_package !> Fortran meta data type(fortran_config_t) :: fortran + !> License meta data + character(len=:), allocatable :: license + !> Library meta data type(library_config_t), allocatable :: library @@ -151,6 +154,8 @@ subroutine new_package(self, table, root, error) return endif + call get_value(table, "license", self%license) + if (len(self%name) <= 0) then call syntax_error(error, "Package name must be a non-empty string") return diff --git a/src/fpm/manifest/test.f90 b/src/fpm/manifest/test.f90 index c82212ebea..7d0ac78a15 100644 --- a/src/fpm/manifest/test.f90 +++ b/src/fpm/manifest/test.f90 @@ -15,7 +15,7 @@ !>[test.dependencies] !>``` module fpm_manifest_test - use fpm_manifest_dependency, only : dependency_config_t, new_dependencies + use fpm_manifest_dependency, only : new_dependencies use fpm_manifest_executable, only : executable_config_t use fpm_error, only : error_t, syntax_error, bad_name_error use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 867eecb76a..0a68e501b1 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -49,6 +49,7 @@ module fpm_command_line fpm_test_settings, & fpm_update_settings, & fpm_clean_settings, & + fpm_publish_settings, & get_command_line_settings type, abstract :: fpm_cmd_settings @@ -117,6 +118,12 @@ module fpm_command_line logical :: clean_call=.false. end type +type, extends(fpm_build_settings) :: fpm_publish_settings + logical :: show_package_version = .false. + logical :: show_form_data = .false. + character(len=:), allocatable :: token +end type + character(len=:),allocatable :: name character(len=:),allocatable :: os_type character(len=ibug),allocatable :: names(:) @@ -127,10 +134,10 @@ module fpm_command_line & help_test(:), help_build(:), help_usage(:), help_runner(:), & & help_text(:), help_install(:), help_help(:), help_update(:), & & help_list(:), help_list_dash(:), help_list_nodash(:), & - & help_clean(:) + & help_clean(:), help_publish(:) character(len=20),parameter :: manual(*)=[ character(len=20) ::& & ' ', 'fpm', 'new', 'build', 'run', 'clean', & -& 'test', 'runner', 'install', 'update', 'list', 'help', 'version' ] +& 'test', 'runner', 'install', 'update', 'list', 'help', 'version', 'publish' ] character(len=:), allocatable :: val_runner, val_compiler, val_flag, val_cflag, val_cxxflag, val_ldflag, & val_profile @@ -211,6 +218,7 @@ subroutine get_command_line_settings(cmd_settings) integer :: os logical :: unix type(fpm_install_settings), allocatable :: install_settings + type(fpm_publish_settings), allocatable :: publish_settings type(version_t) :: version character(len=:), allocatable :: common_args, compiler_args, run_args, working_dir, & & c_compiler, cxx_compiler, archiver, version_s @@ -481,6 +489,8 @@ subroutine get_command_line_settings(cmd_settings) 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, & & ' unknown help topic "'//trim(unnamed(i))//'"'] @@ -608,6 +618,42 @@ subroutine get_command_line_settings(cmd_settings) & clean_skip=lget('skip'), & clean_call=lget('all')) + case('publish') + call set_args(common_args // compiler_args //'& + & --show-package-version F & + & --show-form-data 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') + + allocate(publish_settings, source=fpm_publish_settings( & + & show_package_version = lget('show-package-version'), & + & show_form_data = lget('show-form-data'), & + & 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'))) + call get_char_arg(publish_settings%token, 'token') + call move_alloc(publish_settings, cmd_settings) + case default if(cmdarg.ne.''.and.which('fpm-'//cmdarg).ne.'')then @@ -643,12 +689,8 @@ subroutine get_command_line_settings(cmd_settings) contains subroutine check_build_vals() - character(len=:), allocatable :: flags - val_compiler=sget('compiler') - if(val_compiler=='') then - val_compiler='gfortran' - endif + if(val_compiler=='') val_compiler='gfortran' val_flag = " " // sget('flag') val_cflag = " " // sget('c-flag') @@ -691,6 +733,7 @@ subroutine set_help() ' update Update and manage project dependencies ', & ' install Install project ', & ' clean Delete the build ', & + ' publish Publish package to the registry ', & ' ', & ' Enter "fpm --list" for a brief list of subcommand options. Enter ', & ' "fpm --help" or "fpm SUBCOMMAND --help" for detailed descriptions. ', & @@ -711,6 +754,7 @@ subroutine set_help() ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', & ' [options] ', & ' clean [--skip] [--all] ', & + ' publish [--show-package-version] [--show-form-data] [--token TOKEN] ', & ' '] help_usage=[character(len=80) :: & '' ] @@ -815,6 +859,7 @@ subroutine set_help() ' + install Install project. ', & ' + clean Delete directories in the "build/" directory, except ', & ' dependencies. Prompts for confirmation to delete. ', & + ' + publish Publish package to the registry. ', & ' ', & ' Their syntax is ', & ' ', & @@ -832,7 +877,8 @@ subroutine set_help() ' list [--list] ', & ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', & ' [options] ', & - ' clean [--skip] [--all] ', & + ' clean [--skip] [--all] ', & + ' publish [--show-package-version] [--show-form-data] [--token TOKEN] ', & ' ', & 'SUBCOMMAND OPTIONS ', & ' -C, --directory PATH', & @@ -1307,6 +1353,22 @@ subroutine set_help() 'OPTIONS', & ' --skip delete the build without prompting but skip dependencies.', & ' --all delete the build without prompting including dependencies.', & + '' ] + help_publish=[character(len=80) :: & + 'NAME', & + ' publish(1) - publish package to the registry', & + '', & + 'SYNOPSIS', & + ' fpm publish [--token TOKEN]', & + '', & + 'DESCRIPTION', & + ' Collect relevant source files and upload package to the registry.', & + ' It is mandatory to provide a token. The token can be generated on the', & + ' registry website and will be linked to your username and namespace.', & + '', & + 'OPTIONS', & + ' --show-package-version show package version without publishing', & + ' --show-form-data show sent form data without publishing', & '' ] end subroutine set_help diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 3846654354..b192107afc 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -14,7 +14,8 @@ module fpm_filesystem public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, list_files, get_local_prefix, & mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file, fileopen, fileclose, & filewrite, warnwrite, parent_dir, is_hidden_file, read_lines, read_lines_expanded, which, run, & - LINE_BUFFER_LEN, os_delete_dir, is_absolute_path, env_variable, get_home + LINE_BUFFER_LEN, os_delete_dir, is_absolute_path, env_variable, get_home, get_tmp_directory, & + execute_and_read_output integer, parameter :: LINE_BUFFER_LEN = 1000 #ifndef FPM_BOOTSTRAP @@ -1020,4 +1021,65 @@ subroutine get_home(home, error) end if end subroutine get_home + !> Execute command line and return output as a string. + subroutine execute_and_read_output(cmd, output, error, exitstat) + !> Command to execute. + character(len=*), intent(in) :: cmd + !> Command line output. + character(len=:), allocatable, intent(out) :: output + !> Error to handle. + type(error_t), allocatable, intent(out) :: error + !> Can optionally used for error handling. + integer, intent(out), optional :: exitstat + + integer :: cmdstat, unit, stat = 0 + character(len=:), allocatable :: cmdmsg, tmp_path + character(len=1000) :: output_line + + call get_tmp_directory(tmp_path, error) + if (allocated(error)) return + + if (.not. exists(tmp_path)) call mkdir(tmp_path) + tmp_path = join_path(tmp_path, 'command_line_output') + call delete_file(tmp_path) + call filewrite(tmp_path, ['']) + + call execute_command_line(cmd//' > '//tmp_path, exitstat=exitstat, cmdstat=cmdstat) + if (cmdstat /= 0) call fpm_stop(1,'*run*: '//"Command failed: '"//cmd//"'. Message: '"//trim(cmdmsg)//"'.") + + open(unit, file=tmp_path, action='read', status='old') + output = '' + do + read(unit, *, iostat=stat) output_line + if (stat /= 0) exit + output = output//trim(output_line)//' ' + end do + close(unit, status='delete') + end + + !> Get system-dependent tmp directory. + subroutine get_tmp_directory(tmp_dir, error) + !> System-dependant tmp directory. + character(len=:), allocatable, intent(out) :: tmp_dir + !> Error to handle. + type(error_t), allocatable, intent(out) :: error + + tmp_dir = get_env('TMPDIR', '') + if (tmp_dir /= '') then + tmp_dir = tmp_dir//'fpm'; return + end if + + tmp_dir = get_env('TMP', '') + if (tmp_dir /= '') then + tmp_dir = tmp_dir//'fpm'; return + end if + + tmp_dir = get_env('TEMP', '') + if (tmp_dir /= '') then + tmp_dir = tmp_dir//'fpm'; return + end if + + call fatal_error(error, "Couldn't determine system temporary directory.") + end + end module fpm_filesystem diff --git a/src/fpm_settings.f90 b/src/fpm_settings.f90 index cc53df2f7d..75fbb21d2b 100644 --- a/src/fpm_settings.f90 +++ b/src/fpm_settings.f90 @@ -10,7 +10,7 @@ module fpm_settings private public :: fpm_global_settings, get_global_settings, get_registry_settings, official_registry_base_url - character(*), parameter :: official_registry_base_url = 'https://fpm-registry.onrender.com' + character(*), parameter :: official_registry_base_url = 'https://registry-apis.vercel.app' type :: fpm_global_settings !> Path to the global config file excluding the file name. diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index ddd34cd7d4..ae1f120296 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -146,7 +146,7 @@ subroutine targets_from_sources(targets,model,prune,error) !> Enable tree-shaking/pruning of module dependencies logical, intent(in) :: prune - + !> Error structure type(error_t), intent(out), allocatable :: error diff --git a/test/cli_test/cli_test.f90 b/test/cli_test/cli_test.f90 index 9f82cb7056..69fd433145 100644 --- a/test/cli_test/cli_test.f90 +++ b/test/cli_test/cli_test.f90 @@ -29,10 +29,13 @@ program main logical :: w_t,act_w_t ; namelist/act_cli/act_w_t logical :: c_s,act_c_s ; namelist/act_cli/act_c_s logical :: c_a,act_c_a ; namelist/act_cli/act_c_a +logical :: show_v,act_show_v ; namelist/act_cli/act_show_v +logical :: show_f_d,act_show_f_d; namelist/act_cli/act_show_f_d +character(len=:), allocatable :: token, act_token ; namelist/act_cli/act_token -character(len=63) :: profile,act_profile ; namelist/act_cli/act_profile -character(len=:),allocatable :: args,act_args ; namelist/act_cli/act_args -namelist/expected/cmd,cstat,estat,w_e,w_t,c_s,c_a,name,profile,args +character(len=:), allocatable :: profile,act_profile ; namelist/act_cli/act_profile +character(len=:), allocatable :: args,act_args ; namelist/act_cli/act_args +namelist/expected/cmd,cstat,estat,w_e,w_t,c_s,c_a,name,profile,args,show_v,show_f_d,token integer :: lun logical,allocatable :: tally(:) logical,allocatable :: subtally(:) @@ -70,7 +73,10 @@ program main 'CMD="clean", NAME= ARGS="",', & 'CMD="clean --skip", C_S=T, NAME= ARGS="",', & -'CMD="clean --all", C_A=T, NAME= ARGS="",', & +'CMD="clean --all", C_A=T, NAME= ARGS="",', & +'CMD="publish --token abc --show-package-version", SHOW_V=T, NAME= token="abc",ARGS="",', & +'CMD="publish --token abc --show-form-data", SHOW_F_D=T, NAME= token="abc",ARGS="",', & +'CMD="publish --token abc", NAME= token="abc",ARGS="",', & ' ' ] character(len=256) :: readme(3) @@ -98,11 +104,14 @@ program main endif ! blank out name group EXPECTED name=[(repeat(' ',len(name)),i=1,max_names)] ! the words on the command line sans the subcommand name - profile="" ! --profile PROF + profile='' ! --profile PROF w_e=.false. ! --app w_t=.false. ! --test c_s=.false. ! --skip c_a=.false. ! --all + show_v=.false. ! --show-package-version + show_f_d=.false. ! --show-form-data + token='' ! --token TOKEN args=repeat(' ',132) ! -- ARGS cmd=repeat(' ',132) ! the command line arguments to test cstat=0 ! status values from EXECUTE_COMMAND_LINE() @@ -122,6 +131,9 @@ program main act_w_t=.false. act_c_s=.false. act_c_a=.false. + act_show_v=.false. + act_show_f_d=.false. + act_token='' act_args=repeat(' ',132) read(lun,nml=act_cli,iostat=ios,iomsg=message) if(ios/=0)then @@ -135,6 +147,9 @@ program main call test_test('WITH_EXPECTED',act_w_e.eqv.w_e) call test_test('WITH_TESTED',act_w_t.eqv.w_t) call test_test('WITH_TEST',act_w_t.eqv.w_t) + call test_test('SHOW-PACKAGE-VERSION',act_show_v.eqv.show_v) + call test_test('SHOW-FORM-DATA',act_show_f_d.eqv.show_f_d) + call test_test('TOKEN',act_token==token) call test_test('ARGS',act_args==args) if(all(subtally))then write(*,'(*(g0))')'PASSED: TEST ',i,' STATUS: expected ',cstat,' ',estat,' actual ',act_cstat,' ',act_estat,& @@ -205,10 +220,12 @@ subroutine parse() fpm_test_settings, & fpm_clean_settings, & fpm_install_settings, & - get_command_line_settings + get_command_line_settings, & + fpm_publish_settings use fpm, only: cmd_run, cmd_clean use fpm_cmd_install, only: cmd_install use fpm_cmd_new, only: cmd_new +use fpm_cmd_publish, only: cmd_publish class(fpm_cmd_settings), allocatable :: cmd_settings ! duplicates the calls as seen in the main program for fpm call get_command_line_settings(cmd_settings) @@ -219,6 +236,9 @@ subroutine parse() act_w_t=.false. act_c_s=.false. act_c_a=.false. +act_show_v=.false. +act_show_f_d=.false. +act_token='' act_profile='' select type(settings=>cmd_settings) @@ -240,6 +260,10 @@ subroutine parse() act_c_s=settings%clean_skip act_c_a=settings%clean_call type is (fpm_install_settings) +type is (fpm_publish_settings) + act_show_v=settings%show_package_version + act_show_f_d=settings%show_form_data + act_token=settings%token end select open(file='_test_cli',newunit=lun,delim='quote') diff --git a/test/help_test/help_test.f90 b/test/help_test/help_test.f90 index e78a4ea788..8112b81a37 100644 --- a/test/help_test/help_test.f90 +++ b/test/help_test/help_test.f90 @@ -34,6 +34,7 @@ program help_test 'help list >> fpm_scratch_help.txt',& 'help help >> fpm_scratch_help.txt',& 'help clean >> fpm_scratch_help.txt',& +'help publish >> fpm_scratch_help.txt',& '--version >> fpm_scratch_help.txt',& ! generate manual ' help manual > fpm_scratch_manual.txt']