diff options
author | John S. Urban <urbanjost@comcast.net> | 2021-07-18 19:42:58 -0400 |
---|---|---|
committer | John S. Urban <urbanjost@comcast.net> | 2021-07-18 19:42:58 -0400 |
commit | 83f1fc0be44831b32869126be0afc55431791b56 (patch) | |
tree | 5c5e7d4b624610a39687ab925cc2c57ae645f6e5 /src | |
parent | 1715c04c7e662599d20d2a43e8cc1e9cfbd2fa54 (diff) | |
download | fpm-83f1fc0be44831b32869126be0afc55431791b56.tar.gz fpm-83f1fc0be44831b32869126be0afc55431791b56.zip |
remove warnings and fix truncated help text
Diffstat (limited to 'src')
-rw-r--r-- | src/fpm/cmd/install.f90 | 2 | ||||
-rw-r--r-- | src/fpm/dependency.f90 | 9 | ||||
-rw-r--r-- | src/fpm/manifest/executable.f90 | 2 | ||||
-rw-r--r-- | src/fpm/manifest/package.f90 | 2 | ||||
-rw-r--r-- | src/fpm/versioning.f90 | 5 | ||||
-rw-r--r-- | src/fpm_backend.f90 | 8 | ||||
-rw-r--r-- | src/fpm_command_line.f90 | 50 | ||||
-rw-r--r-- | src/fpm_filesystem.f90 | 6 | ||||
-rw-r--r-- | src/fpm_model.f90 | 1 | ||||
-rw-r--r-- | src/fpm_strings.f90 | 4 | ||||
-rw-r--r-- | src/fpm_targets.f90 | 3 |
11 files changed, 40 insertions, 52 deletions
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/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/executable.f90 b/src/fpm/manifest/executable.f90 index 60c20ec..e81ab8e 100644 --- a/src/fpm/manifest/executable.f90 +++ b/src/fpm/manifest/executable.f90 @@ -13,7 +13,7 @@ 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_strings, only : string_t use fpm_toml, only : toml_table, toml_key, toml_stat, get_value implicit none private diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index 1f85144..dba4d21 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -161,7 +161,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 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..86e6d5d 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 ', & diff --git a/src/fpm_filesystem.f90 b/src/fpm_filesystem.f90 index 2a32b54..284f558 100644 --- a/src/fpm_filesystem.f90 +++ b/src/fpm_filesystem.f90 @@ -45,7 +45,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 +90,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 +141,7 @@ contains logical, intent(inout) :: is_path integer :: ii, nn - character :: tok, last + character :: tok nn = len(string) 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..efbf054 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 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)) |