aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/filesystem_utilities.c41
-rw-r--r--src/fpm.f907
-rw-r--r--src/fpm/cmd/install.f902
-rw-r--r--src/fpm/cmd/new.f903
-rw-r--r--src/fpm/cmd/update.f903
-rw-r--r--src/fpm/dependency.f909
-rw-r--r--src/fpm/manifest/build.f906
-rw-r--r--src/fpm/manifest/example.f904
-rw-r--r--src/fpm/manifest/executable.f906
-rw-r--r--src/fpm/manifest/library.f904
-rw-r--r--src/fpm/manifest/package.f905
-rw-r--r--src/fpm/manifest/test.f904
-rw-r--r--src/fpm/toml.f9011
-rw-r--r--src/fpm/versioning.f905
-rw-r--r--src/fpm_backend.f908
-rw-r--r--src/fpm_command_line.f9057
-rw-r--r--src/fpm_environment.f9020
-rw-r--r--src/fpm_filesystem.F90 (renamed from src/fpm_filesystem.f90)151
-rw-r--r--src/fpm_model.f901
-rw-r--r--src/fpm_strings.f9036
-rw-r--r--src/fpm_targets.f903
21 files changed, 298 insertions, 88 deletions
diff --git a/src/filesystem_utilities.c b/src/filesystem_utilities.c
new file mode 100644
index 0000000..7075f42
--- /dev/null
+++ b/src/filesystem_utilities.c
@@ -0,0 +1,41 @@
+#include <sys/stat.h>
+#include <dirent.h>
+
+#ifdef __APPLE__
+DIR * opendir$INODE64( const char * dirName );
+struct dirent * readdir$INODE64( DIR * dir );
+#endif
+
+int c_is_dir(const char *path)
+{
+ struct stat m;
+ int r = stat(path, &m);
+ return r == 0 && S_ISDIR(m.st_mode);
+}
+
+const char *get_d_name(struct dirent *d)
+{
+ return (const char *) d->d_name;
+}
+
+
+
+DIR *c_opendir(const char *dirname){
+
+#ifdef __APPLE__
+ return opendir$INODE64(dirname);
+#else
+ return opendir(dirname);
+#endif
+
+}
+
+struct dirent *c_readdir(DIR *dirp){
+
+#ifdef __APPLE__
+ return readdir$INODE64(dirp);
+#else
+ return readdir(dirp);
+#endif
+
+} \ No newline at end of file
diff --git a/src/fpm.f90 b/src/fpm.f90
index 89eca1a..68e2bbd 100644
--- a/src/fpm.f90
+++ b/src/fpm.f90
@@ -5,7 +5,7 @@ use fpm_command_line, only: fpm_build_settings, fpm_new_settings, &
fpm_run_settings, fpm_install_settings, fpm_test_settings
use fpm_dependency, only : new_dependency_tree
use fpm_environment, only: run, get_env
-use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename
+use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename, filewrite, mkdir
use fpm_model, only: fpm_model_t, srcfile_t, show_model, &
FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, &
FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST
@@ -58,6 +58,11 @@ subroutine build_model(model, settings, package, error)
call model%deps%add(package, error)
if (allocated(error)) return
+ ! build/ directory should now exist
+ if (.not.exists("build/.gitignore")) then
+ call filewrite(join_path("build", ".gitignore"),["*"])
+ end if
+
if(settings%compiler.eq.'')then
model%fortran_compiler = 'gfortran'
else
diff --git a/src/fpm/cmd/install.f90 b/src/fpm/cmd/install.f90
index e53609b..4c8596e 100644
--- a/src/fpm/cmd/install.f90
+++ b/src/fpm/cmd/install.f90
@@ -27,7 +27,7 @@ contains
type(fpm_model_t) :: model
type(build_target_ptr), allocatable :: targets(:)
type(installer_t) :: installer
- character(len=:), allocatable :: lib, exe, dir
+ character(len=:), allocatable :: lib, dir
logical :: installable
call get_package_data(package, "fpm.toml", error, apply_defaults=.true.)
diff --git a/src/fpm/cmd/new.f90 b/src/fpm/cmd/new.f90
index 2b8d990..abc1d67 100644
--- a/src/fpm/cmd/new.f90
+++ b/src/fpm/cmd/new.f90
@@ -98,9 +98,6 @@ character(len=:,kind=tfc),allocatable :: littlefile(:)
! like realpath() or getcwd().
bname=basename(settings%name)
- ! create NAME/.gitignore file
- call warnwrite(join_path(settings%name, '.gitignore'), ['build/*'])
-
littlefile=[character(len=80) :: '# '//bname, 'My cool new project!']
! create NAME/README.md
diff --git a/src/fpm/cmd/update.f90 b/src/fpm/cmd/update.f90
index aa99ca3..a9918bf 100644
--- a/src/fpm/cmd/update.f90
+++ b/src/fpm/cmd/update.f90
@@ -2,7 +2,7 @@ module fpm_cmd_update
use fpm_command_line, only : fpm_update_settings
use fpm_dependency, only : dependency_tree_t, new_dependency_tree
use fpm_error, only : error_t, fpm_stop
- use fpm_filesystem, only : exists, mkdir, join_path, delete_file
+ use fpm_filesystem, only : exists, mkdir, join_path, delete_file, filewrite
use fpm_manifest, only : package_config_t, get_package_data
implicit none
private
@@ -26,6 +26,7 @@ contains
if (.not.exists("build")) then
call mkdir("build")
+ call filewrite(join_path("build", ".gitignore"),["*"])
end if
cache = join_path("build", "cache.toml")
diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90
index 144ffbe..bd85b6f 100644
--- a/src/fpm/dependency.f90
+++ b/src/fpm/dependency.f90
@@ -233,7 +233,6 @@ contains
type(dependency_config_t) :: dependency
character(len=:), allocatable :: root
- logical :: main
if (allocated(self%cache)) then
call self%load(self%cache, error)
@@ -386,8 +385,7 @@ contains
type(error_t), allocatable, intent(out) :: error
integer :: id
- type(package_config_t) :: package
- character(len=:), allocatable :: manifest, proj_dir, revision, root
+ character(len=:), allocatable :: proj_dir, root
id = self%find(name)
root = "."
@@ -507,8 +505,6 @@ contains
!> Index of the dependency
integer :: pos
- integer :: ii
-
pos = self%find(dependency%name)
end function find_dependency
@@ -540,7 +536,6 @@ contains
class(dependency_tree_t), intent(in) :: self
!> All dependencies are updated
logical :: finished
- integer :: ii
finished = all(self%dep(:self%ndep)%done)
@@ -561,7 +556,6 @@ contains
!> Error handling
type(error_t), allocatable, intent(out) :: error
- character(len=:), allocatable :: url
logical :: update
update = .false.
@@ -649,7 +643,6 @@ contains
character(len=:), allocatable :: version, url, obj, rev, proj_dir
type(toml_key), allocatable :: list(:)
type(toml_table), pointer :: ptr
- type(dependency_config_t) :: dep
call table%get_keys(list)
diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90
index c9b3f44..b24cf43 100644
--- a/src/fpm/manifest/build.f90
+++ b/src/fpm/manifest/build.f90
@@ -12,7 +12,7 @@
module fpm_manifest_build
use fpm_error, only : error_t, syntax_error, fatal_error
use fpm_strings, only : string_t
- use fpm_toml, only : toml_table, toml_key, toml_stat, get_value
+ use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list
implicit none
private
@@ -87,10 +87,10 @@ contains
end if
- call get_value(table, "link", self%link, error)
+ call get_list(table, "link", self%link, error)
if (allocated(error)) return
- call get_value(table, "external-modules", self%external_modules, error)
+ call get_list(table, "external-modules", self%external_modules, error)
if (allocated(error)) return
end subroutine new_build_config
diff --git a/src/fpm/manifest/example.f90 b/src/fpm/manifest/example.f90
index 3319401..0b1a5a2 100644
--- a/src/fpm/manifest/example.f90
+++ b/src/fpm/manifest/example.f90
@@ -18,7 +18,7 @@ module fpm_manifest_example
use fpm_manifest_dependency, only : dependency_config_t, 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
+ use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list
implicit none
private
@@ -73,7 +73,7 @@ contains
if (allocated(error)) return
end if
- call get_value(table, "link", self%link, error)
+ call get_list(table, "link", self%link, error)
if (allocated(error)) return
end subroutine new_example
diff --git a/src/fpm/manifest/executable.f90 b/src/fpm/manifest/executable.f90
index 60c20ec..3a018ec 100644
--- a/src/fpm/manifest/executable.f90
+++ b/src/fpm/manifest/executable.f90
@@ -13,8 +13,8 @@
module fpm_manifest_executable
use fpm_manifest_dependency, only : dependency_config_t, new_dependencies
use fpm_error, only : error_t, syntax_error, bad_name_error
- use fpm_strings, only : string_t
- use fpm_toml, only : toml_table, toml_key, toml_stat, get_value
+ use fpm_strings, only : string_t
+ use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list
implicit none
private
@@ -84,7 +84,7 @@ contains
if (allocated(error)) return
end if
- call get_value(table, "link", self%link, error)
+ call get_list(table, "link", self%link, error)
if (allocated(error)) return
end subroutine new_executable
diff --git a/src/fpm/manifest/library.f90 b/src/fpm/manifest/library.f90
index c8ce049..68ccc20 100644
--- a/src/fpm/manifest/library.f90
+++ b/src/fpm/manifest/library.f90
@@ -11,7 +11,7 @@
module fpm_manifest_library
use fpm_error, only : error_t, syntax_error
use fpm_strings, only: string_t, string_cat
- use fpm_toml, only : toml_table, toml_key, toml_stat, get_value
+ use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list
implicit none
private
@@ -59,7 +59,7 @@ contains
call get_value(table, "source-dir", self%source_dir, "src")
call get_value(table, "build-script", self%build_script)
- call get_value(table, "include-dir", self%include_dir, error)
+ call get_list(table, "include-dir", self%include_dir, error)
if (allocated(error)) return
! Set default value of include-dir if not found in manifest
diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90
index 1f85144..5cd8765 100644
--- a/src/fpm/manifest/package.f90
+++ b/src/fpm/manifest/package.f90
@@ -29,6 +29,7 @@
!>[[ executable ]]
!>[[ example ]]
!>[[ test ]]
+!>[extra]
!>```
module fpm_manifest_package
use fpm_manifest_build, only: build_config_t, new_build_config
@@ -161,7 +162,7 @@ contains
end if
call new_install_config(self%install, child, error)
if (allocated(error)) return
-
+
call get_value(table, "version", version, "0")
call new_version(self%version, version, error)
if (allocated(error) .and. present(root)) then
@@ -303,7 +304,7 @@ contains
case("version", "license", "author", "maintainer", "copyright", &
& "description", "keywords", "categories", "homepage", "build", &
& "dependencies", "dev-dependencies", "test", "executable", &
- & "example", "library", "install")
+ & "example", "library", "install", "extra")
continue
end select
diff --git a/src/fpm/manifest/test.f90 b/src/fpm/manifest/test.f90
index e689774..258d639 100644
--- a/src/fpm/manifest/test.f90
+++ b/src/fpm/manifest/test.f90
@@ -18,7 +18,7 @@ module fpm_manifest_test
use fpm_manifest_dependency, only : dependency_config_t, 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
+ use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list
implicit none
private
@@ -73,7 +73,7 @@ contains
if (allocated(error)) return
end if
- call get_value(table, "link", self%link, error)
+ call get_list(table, "link", self%link, error)
if (allocated(error)) return
end subroutine new_test
diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90
index dbaafcb..3b05229 100644
--- a/src/fpm/toml.f90
+++ b/src/fpm/toml.f90
@@ -22,16 +22,11 @@ module fpm_toml
private
public :: read_package_file
- public :: toml_table, toml_array, toml_key, toml_stat, get_value, set_value
+ public :: toml_table, toml_array, toml_key, toml_stat, get_value, set_value, get_list
public :: new_table, add_table, add_array, len
public :: toml_error, toml_serializer, toml_parse
- interface get_value
- module procedure :: get_child_value_string_list
- end interface get_value
-
-
contains
@@ -71,7 +66,7 @@ contains
end subroutine read_package_file
- subroutine get_child_value_string_list(table, key, list, error)
+ subroutine get_list(table, key, list, error)
!> Instance of the TOML data structure
type(toml_table), intent(inout) :: table
@@ -114,7 +109,7 @@ contains
end if
end if
- end subroutine get_child_value_string_list
+ end subroutine get_list
end module fpm_toml
diff --git a/src/fpm/versioning.f90 b/src/fpm/versioning.f90
index b24fc3c..da362ee 100644
--- a/src/fpm/versioning.f90
+++ b/src/fpm/versioning.f90
@@ -87,8 +87,7 @@ contains
!> Error handling
type(error_t), allocatable, intent(out) :: error
- character :: tok
- integer :: ii, istart, iend, stat, nn
+ integer :: istart, iend, stat, nn
integer :: num(max_limit)
logical :: is_number
@@ -147,7 +146,7 @@ contains
integer :: ii, nn
logical :: was_number
- character :: tok, last
+ character :: tok
was_number = is_number
nn = len(string)
diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90
index e82d847..4d0c709 100644
--- a/src/fpm_backend.f90
+++ b/src/fpm_backend.f90
@@ -83,7 +83,7 @@ subroutine build_package(targets,model)
! Check if build already failed
!$omp atomic read
skip_current = build_failed
-
+
if (.not.skip_current) then
call build_target(model,queue(j)%ptr,stat(j))
end if
@@ -126,8 +126,7 @@ end subroutine build_package
recursive subroutine sort_target(target)
type(build_target_t), intent(inout), target :: target
- integer :: i, j, fh, stat
- type(build_target_t), pointer :: exe_obj
+ integer :: i, fh, stat
! Check if target has already been processed (as a dependency)
if (target%sorted .or. target%skip) then
@@ -257,8 +256,7 @@ subroutine build_target(model,target,stat)
type(build_target_t), intent(in), target :: target
integer, intent(out) :: stat
- integer :: ilib, fh
- character(:), allocatable :: link_flags
+ integer :: fh
if (.not.exists(dirname(target%output_file))) then
call mkdir(dirname(target%output_file))
diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90
index 2ed7ac6..959a13f 100644
--- a/src/fpm_command_line.f90
+++ b/src/fpm_command_line.f90
@@ -537,17 +537,18 @@ contains
' ']
help_list_dash = [character(len=80) :: &
' ', &
- ' build [--compiler COMPILER_NAME] [--profile PROF] [--flag FFLAGS] [--list] ', &
+ ' build [--compiler COMPILER_NAME] [--profile PROF] [--flag FFLAGS] [--list] ', &
' help [NAME(s)] ', &
' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', &
' [--full|--bare][--backfill] ', &
' update [NAME(s)] [--fetch-only] [--clean] [--verbose] ', &
' list [--list] ', &
- ' run [[--target] NAME(s) [--example] [--profile PROF] [--flag FFLAGS] [--all] ', &
+ ' run [[--target] NAME(s) [--example] [--profile PROF] [--flag FFLAGS] [--all] ', &
' [--runner "CMD"] [--compiler COMPILER_NAME] [--list] [-- ARGS] ', &
- ' test [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--runner "CMD"] [--list]', &
- ' [--compiler COMPILER_NAME] [-- ARGS] ', &
- ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] [options] ', &
+ ' test [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--runner "CMD"] ', &
+ ' [--list] [--compiler COMPILER_NAME] [-- ARGS] ', &
+ ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', &
+ ' [options] ', &
' ']
help_usage=[character(len=80) :: &
'' ]
@@ -652,20 +653,21 @@ contains
' + install Install project ', &
' ', &
' Their syntax is ', &
- ' ', &
- ' build [--profile PROF] [--flag FFLAGS] [--list] [--compiler COMPILER_NAME]', &
- ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', &
- ' [--full|--bare][--backfill] ', &
- ' update [NAME(s)] [--fetch-only] [--clean] ', &
- ' run [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--list] [--example]', &
- ' [--all] [--runner "CMD"] [--compiler COMPILER_NAME] [-- ARGS] ', &
- ' test [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--list] ', &
- ' [--runner "CMD"] [--compiler COMPILER_NAME] [-- ARGS] ', &
- ' help [NAME(s)] ', &
- ' list [--list] ', &
- ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] [options]', &
- ' ', &
- 'SUBCOMMAND OPTIONS ', &
+ ' ', &
+ ' build [--profile PROF] [--flag FFLAGS] [--list] [--compiler COMPILER_NAME] ', &
+ ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', &
+ ' [--full|--bare][--backfill] ', &
+ ' update [NAME(s)] [--fetch-only] [--clean] ', &
+ ' run [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--list] [--all] ', &
+ ' [--example] [--runner "CMD"] [--compiler COMPILER_NAME] [-- ARGS] ', &
+ ' test [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--list] ', &
+ ' [--runner "CMD"] [--compiler COMPILER_NAME] [-- ARGS] ', &
+ ' help [NAME(s)] ', &
+ ' list [--list] ', &
+ ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', &
+ ' [options] ', &
+ ' ', &
+ 'SUBCOMMAND OPTIONS ', &
' -C, --directory PATH', &
' Change working directory to PATH before running any command', &
' --profile PROF selects the compilation profile for the build.',&
@@ -730,11 +732,11 @@ contains
' fpm run ', &
' fpm run --example ', &
' fpm new --help ', &
- ' fpm run myprogram --profile release -- -x 10 -y 20 --title "my title"', &
- ' fpm install --prefix ~/.local ', &
- ' ', &
- 'SEE ALSO ', &
- ' ', &
+ ' fpm run myprogram --profile release -- -x 10 -y 20 --title "my title" ', &
+ ' fpm install --prefix ~/.local ', &
+ ' ', &
+ 'SEE ALSO ', &
+ ' ', &
' + The fpm(1) home page is at https://github.com/fortran-lang/fpm ', &
' + Registered fpm(1) packages are at https://fortran-lang.org/packages ', &
' + The fpm(1) TOML file format is described at ', &
@@ -936,14 +938,11 @@ contains
' o runs the command "git init" in that directory ', &
' o populates the directory with the default project directories ', &
' o adds sample Fortran source files ', &
- ' o adds a ".gitignore" file for ignoring the build/ directory ', &
- ' (where fpm-generated output will be placed) ', &
' ', &
' The default file structure (that will be automatically scanned) is ', &
' ', &
' NAME/ ', &
' fpm.toml ', &
- ' .gitignore ', &
' src/ ', &
' NAME.f90 ', &
' app/ ', &
@@ -1004,8 +1003,8 @@ contains
' depend extensively on non-default build options. ', &
' ', &
' --bare A minimal manifest file ("fpm.toml") is created and ', &
- ' a ".gitignore" and "README.md" file is created but no ', &
- ' directories or sample Fortran is generated. ', &
+ ' "README.md" file is created but no directories or ', &
+ ' sample Fortran are generated. ', &
' ', &
' --help print this help and exit ', &
' --version print program version information and exit ', &
diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90
index e9da3c7..a9f8c65 100644
--- a/src/fpm_environment.f90
+++ b/src/fpm_environment.f90
@@ -40,7 +40,16 @@ contains
character(len=32) :: val
integer :: length, rc
logical :: file_exists
+ logical, save :: first_run = .true.
+ integer, save :: ret = OS_UNKNOWN
+ !omp threadprivate(ret, first_run)
+ if (.not. first_run) then
+ r = ret
+ return
+ end if
+
+ first_run = .false.
r = OS_UNKNOWN
! Check environment variable `OS`.
@@ -48,6 +57,7 @@ contains
if (rc == 0 .and. length > 0 .and. index(val, 'Windows_NT') > 0) then
r = OS_WINDOWS
+ ret = r
return
end if
@@ -58,42 +68,49 @@ contains
! Linux
if (index(val, 'linux') > 0) then
r = OS_LINUX
+ ret = r
return
end if
! macOS
if (index(val, 'darwin') > 0) then
r = OS_MACOS
+ ret = r
return
end if
! Windows, MSYS, MinGW, Git Bash
if (index(val, 'win') > 0 .or. index(val, 'msys') > 0) then
r = OS_WINDOWS
+ ret = r
return
end if
! Cygwin
if (index(val, 'cygwin') > 0) then
r = OS_CYGWIN
+ ret = r
return
end if
! Solaris, OpenIndiana, ...
if (index(val, 'SunOS') > 0 .or. index(val, 'solaris') > 0) then
r = OS_SOLARIS
+ ret = r
return
end if
! FreeBSD
if (index(val, 'FreeBSD') > 0 .or. index(val, 'freebsd') > 0) then
r = OS_FREEBSD
+ ret = r
return
end if
! OpenBSD
if (index(val, 'OpenBSD') > 0 .or. index(val, 'openbsd') > 0) then
r = OS_OPENBSD
+ ret = r
return
end if
end if
@@ -103,6 +120,7 @@ contains
if (file_exists) then
r = OS_LINUX
+ ret = r
return
end if
@@ -111,6 +129,7 @@ contains
if (file_exists) then
r = OS_MACOS
+ ret = r
return
end if
@@ -119,6 +138,7 @@ contains
if (file_exists) then
r = OS_FREEBSD
+ ret = r
return
end if
end function get_os_type
diff --git a/src/fpm_filesystem.f90 b/src/fpm_filesystem.F90
index 2a32b54..597ed7b 100644
--- a/src/fpm_filesystem.f90
+++ b/src/fpm_filesystem.F90
@@ -7,6 +7,7 @@ module fpm_filesystem
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD
use fpm_environment, only: separator, get_env
use fpm_strings, only: f_string, replace, string_t, split
+ use iso_c_binding, only: c_char, c_ptr, c_int, c_null_char, c_associated, c_f_pointer
use fpm_error, only : fpm_stop
implicit none
private
@@ -17,6 +18,39 @@ module fpm_filesystem
integer, parameter :: LINE_BUFFER_LEN = 1000
+#ifndef FPM_BOOTSTRAP
+ interface
+ function c_opendir(dir) result(r) bind(c, name="c_opendir")
+ import c_char, c_ptr
+ character(kind=c_char), intent(in) :: dir(*)
+ type(c_ptr) :: r
+ end function c_opendir
+
+ function c_readdir(dir) result(r) bind(c, name="c_readdir")
+ import c_ptr
+ type(c_ptr), intent(in), value :: dir
+ type(c_ptr) :: r
+ end function c_readdir
+
+ function c_closedir(dir) result(r) bind(c, name="closedir")
+ import c_ptr, c_int
+ type(c_ptr), intent(in), value :: dir
+ integer(kind=c_int) :: r
+ end function c_closedir
+
+ function c_get_d_name(dir) result(r) bind(c, name="get_d_name")
+ import c_ptr
+ type(c_ptr), intent(in), value :: dir
+ type(c_ptr) :: r
+ end function c_get_d_name
+
+ function c_is_dir(path) result(r) bind(c, name="c_is_dir")
+ import c_char, c_int
+ character(kind=c_char), intent(in) :: path(*)
+ integer(kind=c_int) :: r
+ end function c_is_dir
+ end interface
+#endif
contains
@@ -45,7 +79,7 @@ end subroutine env_variable
!> Extract filename from path with/without suffix
function basename(path,suffix) result (base)
-
+
character(*), intent(In) :: path
logical, intent(in), optional :: suffix
character(:), allocatable :: base
@@ -90,7 +124,7 @@ function canon_path(path)
character(len=:), allocatable :: canon_path
character(len=:), allocatable :: nixpath
- integer :: ii, istart, iend, stat, nn, last
+ integer :: istart, iend, nn, last
logical :: is_path, absolute
nixpath = unix_path(path)
@@ -141,7 +175,7 @@ contains
logical, intent(inout) :: is_path
integer :: ii, nn
- character :: tok, last
+ character :: tok
nn = len(string)
@@ -226,13 +260,23 @@ function join_path(a1,a2,a3,a4,a5) result(path)
character(len=*), intent(in), optional :: a3, a4, a5
character(len=:), allocatable :: path
character(len=1) :: filesep
+ logical, save :: has_cache = .false.
+ character(len=1), save :: cache = '/'
+ !$omp threadprivate(has_cache, cache)
- select case (get_os_type())
- case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD)
- filesep = '/'
- case (OS_WINDOWS)
- filesep = '\'
- end select
+ if (has_cache) then
+ filesep = cache
+ else
+ select case (get_os_type())
+ case default
+ filesep = '/'
+ case (OS_WINDOWS)
+ filesep = '\'
+ end select
+
+ cache = filesep
+ has_cache = .true.
+ end if
path = a1 // filesep // a2
@@ -311,7 +355,94 @@ subroutine mkdir(dir)
end if
end subroutine mkdir
+#ifndef FPM_BOOTSTRAP
+!> Get file & directory names in directory `dir` using iso_c_binding.
+!!
+!! - File/directory names return are relative to cwd, ie. preprended with `dir`
+!! - Includes files starting with `.` except current directory and parent directory
+!!
+recursive subroutine list_files(dir, files, recurse)
+ character(len=*), intent(in) :: dir
+ type(string_t), allocatable, intent(out) :: files(:)
+ logical, intent(in), optional :: recurse
+
+ integer :: i
+ type(string_t), allocatable :: dir_files(:)
+ type(string_t), allocatable :: sub_dir_files(:)
+
+ type(c_ptr) :: dir_handle
+ type(c_ptr) :: dir_entry_c
+ character(len=:,kind=c_char), allocatable :: fortran_name
+ character(len=:), allocatable :: string_fortran
+ integer, parameter :: N_MAX = 256
+ type(string_t) :: files_tmp(N_MAX)
+ integer(kind=c_int) :: r
+
+ if (c_is_dir(dir(1:len_trim(dir))//c_null_char) .eq. 0) then
+ allocate (files(0))
+ return
+ end if
+
+ dir_handle = c_opendir(dir(1:len_trim(dir))//c_null_char)
+ if (.not. c_associated(dir_handle)) then
+ print *, 'c_opendir() failed'
+ error stop
+ end if
+
+ i = 0
+ allocate(files(0))
+ do
+ dir_entry_c = c_readdir(dir_handle)
+ if (.not. c_associated(dir_entry_c)) then
+ exit
+ else
+ string_fortran = f_string(c_get_d_name(dir_entry_c))
+
+ if ((string_fortran .eq. '.' .or. string_fortran .eq. '..')) then
+ cycle
+ end if
+
+ i = i + 1
+
+ if (i .gt. N_MAX) then
+ files = [files, files_tmp]
+ i = 1
+ end if
+
+ files_tmp(i)%s = join_path(dir, string_fortran)
+ end if
+ end do
+
+ r = c_closedir(dir_handle)
+
+ if (r .ne. 0) then
+ print *, 'c_closedir() failed'
+ error stop
+ end if
+
+ if (i .gt. 0) then
+ files = [files, files_tmp(1:i)]
+ end if
+
+ if (present(recurse)) then
+ if (recurse) then
+
+ allocate(sub_dir_files(0))
+
+ do i=1,size(files)
+ if (c_is_dir(files(i)%s//c_null_char) .ne. 0) then
+ call list_files(files(i)%s, dir_files, recurse=.true.)
+ sub_dir_files = [sub_dir_files, dir_files]
+ end if
+ end do
+
+ files = [files, sub_dir_files]
+ end if
+ end if
+end subroutine list_files
+
+#else
!> Get file & directory names in directory `dir`.
!!
!! - File/directory names return are relative to cwd, ie. preprended with `dir`
@@ -376,6 +507,8 @@ recursive subroutine list_files(dir, files, recurse)
end subroutine list_files
+#endif
+
!> test if pathname already exists
logical function exists(filename) result(r)
diff --git a/src/fpm_model.f90 b/src/fpm_model.f90
index 9746e5f..49f598e 100644
--- a/src/fpm_model.f90
+++ b/src/fpm_model.f90
@@ -251,7 +251,6 @@ function info_srcfile_short(source) result(s)
! Prints a shortened version of srcfile_t
type(srcfile_t), intent(in) :: source
character(:), allocatable :: s
- integer :: i
s = "srcfile_t("
s = s // 'file_name="' // source%file_name // '"'
s = s // ", ...)"
diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90
index ee5c20a..6ce36cf 100644
--- a/src/fpm_strings.f90
+++ b/src/fpm_strings.f90
@@ -6,7 +6,7 @@
!!### Types
!! - **TYPE(STRING_T)** define a type to contain strings of variable length
!!### Type Conversions
-!! - [[F_STRING]] return Fortran **CHARACTER** variable when given a C-like array of
+!! - [[F_STRING]] return Fortran **CHARACTER** variable when given a C-like array of
!! single characters terminated with a C_NULL_CHAR **CHARACTER**
!! - [[STR]] Converts **INTEGER** or** LOGICAL** to **CHARACTER** string
!!### Case
@@ -14,7 +14,7 @@
!!### Parsing and joining
!! - [[SPLIT]] parse string on delimiter characters and store tokens into an allocatable array
!! - [[STRING_CAT]] Concatenate an array of **type(string_t)** into a single **CHARACTER** variable
-!! - [[JOIN]] append an array of **CHARACTER** variables into a single **CHARACTER** variable
+!! - [[JOIN]] append an array of **CHARACTER** variables into a single **CHARACTER** variable
!!### Testing
!! - [[STR_ENDS_WITH]] test if a **CHARACTER** string or array ends with a specified suffix
!! - [[STRING_ARRAY_CONTAINS]] Check if array of **TYPE(STRING_T)** matches a particular **CHARACTER** string
@@ -31,6 +31,7 @@
module fpm_strings
use iso_fortran_env, only: int64
+use iso_c_binding, only: c_char, c_ptr, c_int, c_null_char, c_associated, c_f_pointer, c_size_t
implicit none
private
@@ -73,6 +74,10 @@ interface string_t
module procedure new_string_t
end interface string_t
+interface f_string
+ module procedure f_string, f_string_cptr, f_string_cptr_n
+end interface f_string
+
contains
!> test if a CHARACTER string ends with a specified suffix
@@ -128,6 +133,33 @@ function f_string(c_string)
end function f_string
+!> return Fortran character variable when given a null-terminated c_ptr
+function f_string_cptr(cptr) result(s)
+ type(c_ptr), intent(in), value :: cptr
+ character(len=:,kind=c_char), allocatable :: s
+
+ interface
+ function c_strlen(s) result(r) bind(c, name="strlen")
+ import c_size_t, c_ptr
+ type(c_ptr), intent(in), value :: s
+ integer(kind=c_size_t) :: r
+ end function
+ end interface
+
+ s = f_string_cptr_n(cptr, c_strlen(cptr))
+end function
+
+!> return Fortran character variable when given a null-terminated c_ptr and its length
+function f_string_cptr_n(cptr, n) result(s)
+ type(c_ptr), intent(in), value :: cptr
+ integer(kind=c_size_t), intent(in) :: n
+ character(len=n,kind=c_char) :: s
+ character(len=n,kind=c_char), pointer :: sptr
+
+ call c_f_pointer(cptr, sptr)
+ s = sptr
+end function
+
!> Hash a character(*) string of default kind
pure function fnv_1a_char(input, seed) result(hash)
character(*), intent(in) :: input
diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90
index 66bbdd5..d480866 100644
--- a/src/fpm_targets.f90
+++ b/src/fpm_targets.f90
@@ -160,7 +160,6 @@ subroutine build_target_list(targets,model)
integer :: i, j, n_source
character(:), allocatable :: xsuffix, exe_dir
- type(build_target_t), pointer :: dep
logical :: with_lib
! Check for empty build (e.g. header-only lib)
@@ -258,7 +257,6 @@ subroutine build_target_list(targets,model)
integer :: i
character(1), parameter :: filesep = '/'
- character(:), allocatable :: dir
object_file = canon_path(source%file_name)
@@ -285,7 +283,6 @@ subroutine add_target(targets,type,output_file,source,link_libraries)
type(string_t), intent(in), optional :: link_libraries(:)
integer :: i
- type(build_target_ptr), allocatable :: temp(:)
type(build_target_t), pointer :: new_target
if (.not.allocated(targets)) allocate(targets(0))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-15 02:02:37 +0000