diff options
author | Laurence Kedward <laurence.kedward@bristol.ac.uk> | 2022-02-12 11:16:05 +0000 |
---|---|---|
committer | Laurence Kedward <laurence.kedward@bristol.ac.uk> | 2022-02-12 11:16:05 +0000 |
commit | e8c08540a74fed38f14e69dcc2e140e9a8553441 (patch) | |
tree | 77d3f05ad6ec01bb7e97b89ad73929371985fd9d /src | |
parent | b1b6a7b9bd1d3607dd80d8ba3fd767e88a852855 (diff) | |
parent | 68061db6f86951e9b3f3d553c54da728a9982dbd (diff) | |
download | fpm-e8c08540a74fed38f14e69dcc2e140e9a8553441.tar.gz fpm-e8c08540a74fed38f14e69dcc2e140e9a8553441.zip |
Merge branch 'main' into backend-output
Diffstat (limited to 'src')
-rw-r--r-- | src/fpm/cmd/new.f90 | 60 | ||||
-rw-r--r-- | src/fpm_command_line.f90 | 25 | ||||
-rw-r--r-- | src/fpm_compiler.f90 | 32 | ||||
-rw-r--r-- | src/fpm_sources.f90 | 16 |
4 files changed, 111 insertions, 22 deletions
diff --git a/src/fpm/cmd/new.f90 b/src/fpm/cmd/new.f90 index 61afc74..739f4e0 100644 --- a/src/fpm/cmd/new.f90 +++ b/src/fpm/cmd/new.f90 @@ -56,9 +56,10 @@ module fpm_cmd_new use fpm_command_line, only : fpm_new_settings use fpm_environment, only : OS_LINUX, OS_MACOS, OS_WINDOWS use fpm_filesystem, only : join_path, exists, basename, mkdir, is_dir -use fpm_filesystem, only : fileopen, fileclose, filewrite, warnwrite, run +use fpm_filesystem, only : fileopen, fileclose, filewrite, warnwrite, which, run use fpm_strings, only : join, to_fortran_name use fpm_error, only : fpm_stop + use,intrinsic :: iso_fortran_env, only : stderr=>error_unit implicit none private @@ -572,9 +573,58 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) call create_verified_basic_manifest(join_path(settings%name, 'fpm.toml')) endif ! assumes git(1) is installed and in path - call run('git init ' // settings%name) + if(which('git').ne.'')then + call run('git init ' // settings%name) + endif contains +function git_metadata(what) result(returned) +!> get metadata values such as email address and git name from git(1) or return appropriate default + use fpm_filesystem, only : get_temp_filename, getline + character(len=*), intent(in) :: what ! keyword designating what git metatdata to query + character(len=:), allocatable :: returned ! value to return for requested keyword + character(len=:), allocatable :: command + character(len=:), allocatable :: temp_filename + character(len=:), allocatable :: iomsg + character(len=:), allocatable :: temp_value + integer :: stat, unit + temp_filename = get_temp_filename() + ! for known keywords set default value for RETURNED and associated git(1) command for query + select case(what) + case('uname') + returned = "Jane Doe" + command = "git config --get user.name > " // temp_filename + case('email') + returned = "jane.doe@example.com" + command = "git config --get user.email > " // temp_filename + case default + write(stderr,'(*(g0,1x))')& + & '<ERROR> *git_metadata* unknown metadata name ',trim(what) + returned='' + return + end select + ! Execute command if git(1) is in command path + if(which('git')/='')then + call run(command, exitstat=stat) + if (stat /= 0) then ! If command failed just return default + return + else ! Command did not return an error so try to read expected output file + open(file=temp_filename, newunit=unit,iostat=stat) + if(stat == 0)then + ! Read file into a scratch variable until status of doing so is checked + call getline(unit, temp_value, stat, iomsg) + if (stat == 0 .and. temp_value /= '') then + ! Return output from successful command + returned=temp_value + endif + endif + ! Always do the CLOSE because a failed open has unpredictable results. + ! Add IOSTAT so a failed close does not cause program to stop + close(unit, status="delete",iostat=stat) + endif + endif +end function git_metadata + subroutine create_verified_basic_manifest(filename) !> create a basic but verified default manifest file use fpm_toml, only : toml_table, toml_serializer, set_value @@ -603,9 +653,9 @@ character(len=*),intent(in) :: filename call set_value(table, "name", BNAME) call set_value(table, "version", "0.1.0") call set_value(table, "license", "license") - call set_value(table, "author", "Jane Doe") - call set_value(table, "maintainer", "jane.doe@example.com") - call set_value(table, "copyright", 'Copyright '//date(1:4)//', Jane Doe') + call set_value(table, "author", git_metadata('uname')) + call set_value(table, "maintainer", git_metadata('email')) + call set_value(table, "copyright", 'Copyright '//date(1:4)//', '//git_metadata('uname')) ! continue building of manifest ! ... call new_package(package, table, error=error) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 99fdef2..836c1a9 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -31,10 +31,12 @@ use M_CLI2, only : get_subcommand, CLI_RESPONSE_FILE use fpm_strings, only : lower, split, fnv_1a, to_fortran_name, is_fortran_name use fpm_filesystem, only : basename, canon_path, which, run use fpm_environment, only : get_command_arguments_quoted -use fpm_error, only : fpm_stop +use fpm_error, only : fpm_stop, error_t +use fpm_os, only : get_current_directory use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & & stderr=>error_unit + implicit none private @@ -179,6 +181,7 @@ contains character(len=*), parameter :: fc_env = "FC", cc_env = "CC", ar_env = "AR", & & fflags_env = "FFLAGS", cflags_env = "CFLAGS", ldflags_env = "LDFLAGS", & & fc_default = "gfortran", cc_default = " ", ar_default = " ", flags_default = " " + type(error_t), allocatable :: error call set_help() ! text for --version switch, @@ -317,9 +320,13 @@ contains & help_new, version_text) select case(size(unnamed)) case(1) - write(stderr,'(*(7x,g0,/))') & - & '<USAGE> fpm new NAME [[--lib|--src] [--app] [--test] [--example]]|[--full|--bare] [--backfill]' - call fpm_stop(1,'directory name required') + 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 @@ -328,6 +335,13 @@ contains call fpm_stop(2,'only one directory name allowed') end select !*! canon_path is not converting ".", etc. + if(name.eq.'.')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) :: & @@ -336,6 +350,7 @@ contains 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 @@ -1079,7 +1094,7 @@ contains ' fpm new A --full # create example/ and an annotated fpm.toml as well', & ' fpm new A --bare # create no directories ', & ' create any missing files in current directory ', & - ' fpm new `pwd` --full --backfill ', & + ' fpm new --full --backfill ', & '' ] help_test=[character(len=80) :: & 'NAME ', & diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index 1c086cc..d94963c 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -39,7 +39,7 @@ use fpm_environment, only: & OS_UNKNOWN use fpm_filesystem, only: join_path, basename, get_temp_filename, delete_file, unix_path, & & getline, run -use fpm_strings, only: string_cat, string_t +use fpm_strings, only: split, string_cat, string_t implicit none public :: compiler_t, new_compiler, archiver_t, new_archiver public :: debug @@ -60,6 +60,8 @@ enum, bind(C) id_nvhpc, & id_nag, & id_flang, & + id_flang_new, & + id_f18, & id_ibmxl, & id_cray, & id_lahey, & @@ -383,7 +385,8 @@ function get_include_flag(self, path) result(flags) case default flags = "-I "//path - case(id_caf, id_gcc, id_f95, id_cray, id_nvhpc, id_pgi, id_flang, & + case(id_caf, id_gcc, id_f95, id_cray, id_nvhpc, id_pgi, & + & id_flang, id_flang_new, id_f18, & & id_intel_classic_nix, id_intel_classic_mac, & & id_intel_llvm_nix, id_lahey, id_nag, id_ibmxl, & & id_lfortran) @@ -410,6 +413,9 @@ function get_module_flag(self, path) result(flags) case(id_nvhpc, id_pgi, id_flang) flags = "-module "//path + case(id_flang_new, id_f18) + flags = "-module-dir "//path + case(id_intel_classic_nix, id_intel_classic_mac, & & id_intel_llvm_nix) flags = "-module "//path @@ -446,7 +452,7 @@ subroutine get_default_c_compiler(f_compiler, c_compiler) case(id_intel_llvm_nix,id_intel_llvm_windows) c_compiler = 'icx' - case(id_flang) + case(id_flang, id_flang_new, id_f18) c_compiler='clang' case(id_ibmxl) @@ -470,7 +476,7 @@ function get_compiler_id(compiler) result(id) character(len=*), intent(in) :: compiler integer(kind=compiler_enum) :: id - character(len=:), allocatable :: command, output + character(len=:), allocatable :: full_command, full_command_parts(:), command, output integer :: stat, io ! Check whether we are dealing with an MPI compiler wrapper first @@ -478,14 +484,18 @@ function get_compiler_id(compiler) result(id) & .or. check_compiler(compiler, "mpif90") & & .or. check_compiler(compiler, "mpif77")) then output = get_temp_filename() - call run(compiler//" -showme:command > "//output//" 2>&1", & + call run(compiler//" -show > "//output//" 2>&1", & & echo=.false., exitstat=stat) if (stat == 0) then open(file=output, newunit=io, iostat=stat) - if (stat == 0) call getline(io, command, stat) + if (stat == 0) call getline(io, full_command, stat) close(io, iostat=stat) ! If we get a command from the wrapper, we will try to identify it + call split(full_command, full_command_parts, delimiters=' ') + if(size(full_command_parts) > 0)then + command = trim(full_command_parts(1)) + endif if (allocated(command)) then id = get_id(command) if (id /= id_unknown) return @@ -557,6 +567,16 @@ function get_id(compiler) result(id) return end if + if (check_compiler(compiler, "flang-new")) then + id = id_flang_new + return + end if + + if (check_compiler(compiler, "f18")) then + id = id_f18 + return + end if + if (check_compiler(compiler, "flang")) then id = id_flang return diff --git a/src/fpm_sources.f90 b/src/fpm_sources.f90 index f349a0e..af2870f 100644 --- a/src/fpm_sources.f90 +++ b/src/fpm_sources.f90 @@ -163,6 +163,7 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error) if (allocated(executables(i)%link)) then sources(j)%link_libraries = executables(i)%link end if + sources(j)%unit_type = FPM_UNIT_PROGRAM cycle exe_loop end if @@ -170,12 +171,15 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error) end do ! Add if not already discovered (auto_discovery off) - exe_source = parse_source(join_path(executables(i)%source_dir,executables(i)%main),error) - exe_source%exe_name = executables(i)%name - if (allocated(executables(i)%link)) then - exe_source%link_libraries = executables(i)%link - end if - exe_source%unit_scope = scope + associate(exe => executables(i)) + exe_source = parse_source(join_path(exe%source_dir,exe%main),error) + exe_source%exe_name = exe%name + if (allocated(exe%link)) then + exe_source%link_libraries = exe%link + end if + exe_source%unit_type = FPM_UNIT_PROGRAM + exe_source%unit_scope = scope + end associate if (allocated(error)) return |