diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 93075fd812..86b5215c53 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -14,11 +14,12 @@ on: env: CI: "ON" # We can detect this in the build system and other vendors implement it - HOMEBREW_NO_ANALYTICS: "ON" # Make Homebrew installation a little quicker - HOMEBREW_NO_AUTO_UPDATE: "ON" - HOMEBREW_NO_BOTTLE_SOURCE_FALLBACK: "ON" - HOMEBREW_NO_GITHUB_API: "ON" - HOMEBREW_NO_INSTALL_CLEANUP: "ON" + HOMEBREW_NO_ANALYTICS: 1 # Make Homebrew installation a little quicker + HOMEBREW_NO_AUTO_UPDATE: 1 + HOMEBREW_NO_BOTTLE_SOURCE_FALLBACK: 1 + HOMEBREW_NO_GITHUB_API: 1 + HOMEBREW_NO_INSTALL_CLEANUP: 1 + HOMEBREW_NO_INSTALLED_DEPENDENTS_CHECK: 1 jobs: @@ -198,7 +199,7 @@ jobs: - name: (macOS) Install homebrew OpenMPI if: contains(matrix.mpi,'openmpi') && contains(matrix.os,'macos') run: | - brew install --cc=gcc-${{ env.GCC_V }} openmpi + brew install openmpi #--cc=gcc-${{ env.GCC_V }} openmpi # Phase 1: Bootstrap fpm with existing version - name: Install fpm diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index c92cc5ff14..43636c0e30 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -65,7 +65,7 @@ subroutine cmd_publish(settings) end do tmp_file = get_temp_filename() - call git_archive('.', tmp_file, error) + call git_archive('.', tmp_file, 'HEAD', settings%verbose, error) if (allocated(error)) call fpm_stop(1, '*cmd_publish* Archive error: '//error%message) upload_data = [ & @@ -91,7 +91,6 @@ subroutine cmd_publish(settings) end if if (settings%verbose) then - print *, '' call print_upload_data(upload_data) print *, '' end if @@ -102,7 +101,7 @@ subroutine cmd_publish(settings) print *, 'Dry run successful. Generated tarball: ', tmp_file; return end if - call downloader%upload_form(official_registry_base_url//'/packages', upload_data, error) + call downloader%upload_form(official_registry_base_url//'/packages', upload_data, settings%verbose, error) call delete_file(tmp_file) if (allocated(error)) call fpm_stop(1, '*cmd_publish* Upload error: '//error%message) end diff --git a/src/fpm/downloader.f90 b/src/fpm/downloader.f90 index 7c5046df4e..39a3314ccf 100644 --- a/src/fpm/downloader.f90 +++ b/src/fpm/downloader.f90 @@ -1,6 +1,6 @@ module fpm_downloader use fpm_error, only: error_t, fatal_error - use fpm_filesystem, only: which + use fpm_filesystem, only: which, run 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 @@ -76,9 +76,14 @@ subroutine get_file(url, tmp_pkg_file, error) end !> Perform an http post request with form data. - subroutine upload_form(endpoint, form_data, error) + subroutine upload_form(endpoint, form_data, verbose, error) + !> Endpoint to upload to. character(len=*), intent(in) :: endpoint + !> Form data to upload. type(string_t), intent(in) :: form_data(:) + !> Print additional information if true. + logical, intent(in) :: verbose + !> Error handling. type(error_t), allocatable, intent(out) :: error integer :: stat, i @@ -91,8 +96,8 @@ subroutine upload_form(endpoint, form_data, error) 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) + call run('curl -X POST -H "Content-Type: multipart/form-data" '// & + & form_data_str//endpoint, exitstat=stat, echo=verbose) else call fatal_error(error, "'curl' not installed."); return end if @@ -104,8 +109,11 @@ subroutine upload_form(endpoint, form_data, error) !> Unpack a tarball to a destination. subroutine unpack(tmp_pkg_file, destination, error) + !> Path to tarball. character(*), intent(in) :: tmp_pkg_file + !> Destination to unpack to. character(*), intent(in) :: destination + !> Error handling. type(error_t), allocatable, intent(out) :: error integer :: stat diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index ad86ca3f73..c007743a90 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -1,7 +1,8 @@ !> 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, execute_and_read_output + use fpm_filesystem, only : get_temp_filename, getline, join_path, execute_and_read_output, run + implicit none public :: git_target_t, git_target_default, git_target_branch, git_target_tag, git_target_revision, git_revision, & @@ -308,18 +309,22 @@ subroutine info(self, unit, verbosity) end subroutine info !> Archive a folder using `git archive`. - subroutine git_archive(source, destination, error) + subroutine git_archive(source, destination, ref, verbose, error) !> Directory to archive. character(*), intent(in) :: source !> Destination of the archive. character(*), intent(in) :: destination + !> (Symbolic) Reference to be archived. + character(*), intent(in) :: ref + !> Print additional information if true. + logical, intent(in) :: verbose !> 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) + call execute_and_read_output('git archive -l', cmd_output, error, verbose) if (allocated(error)) return if (index(cmd_output, 'tar.gz') /= 0) then @@ -328,11 +333,10 @@ subroutine git_archive(source, destination, error) 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 '//destination, exitstat=stat) + call run('git archive '//ref//' --format='//archive_format//' -o '//destination, echo=verbose, 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_compiler.F90 b/src/fpm_compiler.F90 index 2ba571cda5..02b99af135 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -28,7 +28,6 @@ module fpm_compiler use,intrinsic :: iso_fortran_env, only: stderr=>error_unit use fpm_environment, only: & - get_env, & get_os_type, & OS_LINUX, & OS_MACOS, & diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index db0dde98e1..177ee85fea 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -14,8 +14,7 @@ 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, & - os_delete_dir, is_absolute_path, env_variable, get_home, execute_and_read_output, & - get_dos_path + os_delete_dir, is_absolute_path, get_home, execute_and_read_output, get_dos_path #ifndef FPM_BOOTSTRAP interface @@ -53,32 +52,7 @@ end function c_is_dir contains - -!> return value of environment variable -subroutine env_variable(var, name) - character(len=:), allocatable, intent(out) :: var - character(len=*), intent(in) :: name - integer :: length, stat - - call get_environment_variable(name, length=length, status=stat) - if (stat /= 0) return - - allocate(character(len=length) :: var) - - if (length > 0) then - call get_environment_variable(name, var, status=stat) - if (stat /= 0) then - deallocate(var) - return - end if - end if - -end subroutine env_variable - - -!> Extract filename from path with or without suffix. -!> -!> The suffix is included by default. +!> Extract filename from path with/without suffix function basename(path,suffix) result (base) character(*), intent(In) :: path @@ -710,7 +684,6 @@ subroutine getline(unit, line, iostat, iomsg) integer :: size integer :: stat - allocate(character(len=0) :: line) do read(unit, '(a)', advance='no', iostat=stat, iomsg=msg, size=size) & @@ -1079,15 +1052,15 @@ function get_local_prefix(os) result(prefix) character(len=:), allocatable :: home if (os_is_unix(os)) then - call env_variable(home, "HOME") - if (allocated(home)) then + home=get_env('HOME','') + if (home /= '' ) then prefix = join_path(home, ".local") else prefix = default_prefix_unix end if else - call env_variable(home, "APPDATA") - if (allocated(home)) then + home=get_env('APPDATA','') + if (home /= '' ) then prefix = join_path(home, "local") else prefix = default_prefix_win @@ -1130,14 +1103,14 @@ subroutine get_home(home, error) type(error_t), allocatable, intent(out) :: error if (os_is_unix()) then - call env_variable(home, 'HOME') - if (.not. allocated(home)) then + home=get_env('HOME','') + if ( home == '' ) then call fatal_error(error, "Couldn't retrieve 'HOME' variable") return end if else - call env_variable(home, 'USERPROFILE') - if (.not. allocated(home)) then + home=get_env('USERPROFILE','') + if ( home == '' ) then call fatal_error(error, "Couldn't retrieve '%USERPROFILE%' variable") return end if @@ -1145,24 +1118,30 @@ subroutine get_home(home, error) end subroutine get_home !> Execute command line and return output as a string. - subroutine execute_and_read_output(cmd, output, error, exitstat) + subroutine execute_and_read_output(cmd, output, error, verbose) !> 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 + !> Print additional information if true. + logical, intent(in), optional :: verbose - integer :: cmdstat, unit, stat = 0 - character(len=:), allocatable :: cmdmsg, tmp_file - character(len=:),allocatable :: output_line + integer :: exitstat, unit, stat + character(len=:), allocatable :: cmdmsg, tmp_file, output_line + logical :: is_verbose + + if (present(verbose)) then + is_verbose = verbose + else + is_verbose = .false. + end if tmp_file = get_temp_filename() - call execute_command_line(cmd//' > '//tmp_file, exitstat=exitstat, cmdstat=cmdstat) - if (cmdstat /= 0) call fatal_error(error, '*run*: '//"Command failed: '"//cmd//"'. Message: '"//trim(cmdmsg)//"'.") + call run(cmd//' > '//tmp_file, exitstat=exitstat, echo=is_verbose) + if (exitstat /= 0) call fatal_error(error, '*run*: '//"Command failed: '"//cmd//"'. Message: '"//trim(cmdmsg)//"'.") open(newunit=unit, file=tmp_file, action='read', status='old') output = '' @@ -1171,8 +1150,9 @@ subroutine execute_and_read_output(cmd, output, error, exitstat) if (stat /= 0) exit output = output//output_line//' ' end do - close(unit, status='delete',iostat=stat) - end subroutine execute_and_read_output + if (is_verbose) print *, output + close(unit, status='delete') + end !> Ensure a windows path is converted to an 8.3 DOS path if it contains spaces function get_dos_path(path,error) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index c8fd4171de..f86e3a6b27 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -3,11 +3,15 @@ !> This is a wrapper data type that encapsulate all pre-processing information !> (compiler flags, linker libraries, etc.) required to correctly enable a package !> to use a core library. +!> !> -!> -!>### Available core libraries +!>### Available core libraries !> !> - OpenMP +!> - MPI +!> - fortran-lang stdlib +!> - fortran-lang minpack +!> !> !> @note Core libraries are enabled in the [build] section of the fpm.toml manifest !> diff --git a/test/fpm_test/test_os.f90 b/test/fpm_test/test_os.f90 index 594aa937a5..71989167f5 100644 --- a/test/fpm_test/test_os.f90 +++ b/test/fpm_test/test_os.f90 @@ -1,7 +1,7 @@ module test_os use testsuite, only: new_unittest, unittest_t, error_t, test_failed - use fpm_filesystem, only: env_variable, join_path, mkdir, os_delete_dir, is_dir, get_local_prefix, get_home - use fpm_environment, only: os_is_unix + use fpm_filesystem, only: join_path, mkdir, os_delete_dir, is_dir, get_local_prefix, get_home + use fpm_environment, only: os_is_unix, get_env use fpm_os, only: get_absolute_path, get_absolute_path_by_cd, get_current_directory implicit none @@ -134,7 +134,7 @@ subroutine abs_path_nonexisting(error) subroutine abs_path_root(error) type(error_t), allocatable, intent(out) :: error - character(len=:), allocatable :: home_drive, home_path, result + character(len=:), allocatable :: home_path, result if (os_is_unix()) then call get_absolute_path('/', result, error) @@ -144,8 +144,7 @@ subroutine abs_path_root(error) call test_failed(error, "Result '"//result//"' doesn't equal input value: '/'"); return end if else - call env_variable(home_drive, 'HOMEDRIVE') - home_path = home_drive//'\' + home_path = get_env('HOMEDRIVE','') //'\' call get_absolute_path(home_path, result, error) if (allocated(error)) return @@ -177,7 +176,7 @@ subroutine abs_path_home(error) subroutine abs_path_cd_root(error) type(error_t), allocatable, intent(out) :: error - character(len=:), allocatable :: home_drive, home_path, current_dir_before, current_dir_after, result + character(len=:), allocatable :: home_path, current_dir_before, current_dir_after, result call get_current_directory(current_dir_before, error) if (allocated(error)) return @@ -189,8 +188,7 @@ subroutine abs_path_cd_root(error) call test_failed(error, "Result '"//result//"' doesn't equal input value: '/'"); return end if else - call env_variable(home_drive, 'HOMEDRIVE') - home_path = home_drive//'\' + home_path = get_env('HOMEDRIVE','')//'\' call get_absolute_path_by_cd(home_path, result, error)