aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorLaurence Kedward <laurence.kedward@bristol.ac.uk>2022-02-12 11:16:05 +0000
committerLaurence Kedward <laurence.kedward@bristol.ac.uk>2022-02-12 11:16:05 +0000
commite8c08540a74fed38f14e69dcc2e140e9a8553441 (patch)
tree77d3f05ad6ec01bb7e97b89ad73929371985fd9d /src
parentb1b6a7b9bd1d3607dd80d8ba3fd767e88a852855 (diff)
parent68061db6f86951e9b3f3d553c54da728a9982dbd (diff)
downloadfpm-e8c08540a74fed38f14e69dcc2e140e9a8553441.tar.gz
fpm-e8c08540a74fed38f14e69dcc2e140e9a8553441.zip
Merge branch 'main' into backend-output
Diffstat (limited to 'src')
-rw-r--r--src/fpm/cmd/new.f9060
-rw-r--r--src/fpm_command_line.f9025
-rw-r--r--src/fpm_compiler.f9032
-rw-r--r--src/fpm_sources.f9016
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