aboutsummaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
authorJohn S. Urban <urbanjost@comcast.net>2021-07-18 19:42:58 -0400
committerJohn S. Urban <urbanjost@comcast.net>2021-07-18 19:42:58 -0400
commit83f1fc0be44831b32869126be0afc55431791b56 (patch)
tree5c5e7d4b624610a39687ab925cc2c57ae645f6e5 /test
parent1715c04c7e662599d20d2a43e8cc1e9cfbd2fa54 (diff)
downloadfpm-83f1fc0be44831b32869126be0afc55431791b56.tar.gz
fpm-83f1fc0be44831b32869126be0afc55431791b56.zip
remove warnings and fix truncated help text
Diffstat (limited to 'test')
-rw-r--r--test/fpm_test/test_backend.f9026
-rw-r--r--test/fpm_test/test_filesystem.f902
-rw-r--r--test/fpm_test/test_manifest.f902
-rw-r--r--test/fpm_test/test_module_dependencies.f904
-rw-r--r--test/fpm_test/test_package_dependencies.f9010
-rw-r--r--test/fpm_test/test_source_parsing.f902
-rw-r--r--test/fpm_test/test_versioning.f901
-rw-r--r--test/help_test/help_test.f902
8 files changed, 20 insertions, 29 deletions
diff --git a/test/fpm_test/test_backend.f90 b/test/fpm_test/test_backend.f90
index 662e470..eea0460 100644
--- a/test/fpm_test/test_backend.f90
+++ b/test/fpm_test/test_backend.f90
@@ -28,7 +28,7 @@ contains
& new_unittest("schedule-targets", test_schedule_targets), &
& new_unittest("schedule-targets-empty", test_schedule_empty) &
]
-
+
end subroutine collect_backend
@@ -39,7 +39,7 @@ contains
type(error_t), allocatable, intent(out) :: error
type(build_target_ptr), allocatable :: targets(:)
-
+
integer :: i
targets = new_test_package()
@@ -98,7 +98,7 @@ contains
- !> Check incremental rebuild for existing archive
+ !> Check incremental rebuild for existing archive
!> all object sources are unmodified: all objects should be skipped
subroutine test_target_sort_skip_all(error)
@@ -106,7 +106,7 @@ contains
type(error_t), allocatable, intent(out) :: error
type(build_target_ptr), allocatable :: targets(:)
-
+
integer :: fh, i
targets = new_test_package()
@@ -162,7 +162,7 @@ contains
type(error_t), allocatable, intent(out) :: error
type(build_target_ptr), allocatable :: targets(:)
-
+
integer :: fh, i
targets = new_test_package()
@@ -212,7 +212,7 @@ contains
type(error_t), allocatable, intent(out) :: error
type(build_target_ptr), allocatable :: targets(:)
-
+
integer :: i, j
type(build_target_ptr), allocatable :: queue(:)
integer, allocatable :: schedule_ptr(:)
@@ -259,16 +259,16 @@ contains
do i=1,size(schedule_ptr)-1
do j=schedule_ptr(i),(schedule_ptr(i+1)-1)
-
+
if (queue(j)%ptr%schedule /= i) then
call test_failed(error,"Target scheduled in the wrong region")
return
end if
-
+
end do
-
+
end do
end subroutine test_schedule_targets
@@ -282,7 +282,7 @@ contains
type(error_t), allocatable, intent(out) :: error
type(build_target_ptr), allocatable :: targets(:)
-
+
integer :: i
type(build_target_ptr), allocatable :: queue(:)
integer, allocatable :: schedule_ptr(:)
@@ -310,7 +310,7 @@ contains
call test_failed(error,"Expecting an empty build queue, but not empty")
return
-
+
end if
! Check schedule loop is not entered
@@ -336,7 +336,7 @@ contains
call add_target(targets,FPM_TARGET_OBJECT,get_temp_filename())
call add_target(targets,FPM_TARGET_OBJECT,get_temp_filename())
-
+
! Library depends on all objects
call add_dependency(targets(1)%ptr,targets(2)%ptr)
call add_dependency(targets(1)%ptr,targets(3)%ptr)
@@ -350,4 +350,4 @@ contains
end function new_test_package
-end module test_backend \ No newline at end of file
+end module test_backend
diff --git a/test/fpm_test/test_filesystem.f90 b/test/fpm_test/test_filesystem.f90
index 5a7e18a..94eadda 100644
--- a/test/fpm_test/test_filesystem.f90
+++ b/test/fpm_test/test_filesystem.f90
@@ -18,7 +18,7 @@ contains
testsuite = [ &
& new_unittest("canon-path", test_canon_path) &
]
-
+
end subroutine collect_filesystem
diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90
index 0f64aca..6fde671 100644
--- a/test/fpm_test/test_manifest.f90
+++ b/test/fpm_test/test_manifest.f90
@@ -19,7 +19,7 @@ contains
!> Collection of tests
type(unittest_t), allocatable, intent(out) :: testsuite(:)
-
+
testsuite = [ &
& new_unittest("valid-manifest", test_valid_manifest), &
& new_unittest("invalid-manifest", test_invalid_manifest, should_fail=.true.), &
diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90
index 992f227..8600bf0 100644
--- a/test/fpm_test/test_module_dependencies.f90
+++ b/test/fpm_test/test_module_dependencies.f90
@@ -132,7 +132,6 @@ contains
integer, intent(in) :: exe_scope
type(error_t), allocatable, intent(out) :: error
- integer :: i
type(fpm_model_t) :: model
type(build_target_ptr), allocatable :: targets(:)
character(:), allocatable :: scope_str
@@ -193,7 +192,6 @@ contains
!> Error handling
type(error_t), allocatable, intent(out) :: error
- integer :: i
type(fpm_model_t) :: model
type(build_target_ptr), allocatable :: targets(:)
@@ -408,7 +406,7 @@ contains
uses=[string_t('app_mod')])
call targets_from_sources(targets,model,error)
-
+
end subroutine test_subdirectory_module_use
!> Check program with no duplicate modules
diff --git a/test/fpm_test/test_package_dependencies.f90 b/test/fpm_test/test_package_dependencies.f90
index b70ac13..a3192ff 100644
--- a/test/fpm_test/test_package_dependencies.f90
+++ b/test/fpm_test/test_package_dependencies.f90
@@ -25,7 +25,7 @@ contains
!> Collection of tests
type(unittest_t), allocatable, intent(out) :: testsuite(:)
-
+
testsuite = [ &
& new_unittest("cache-load-dump", test_cache_load_dump), &
& new_unittest("cache-dump-load", test_cache_dump_load), &
@@ -139,7 +139,6 @@ contains
type(toml_table) :: table
type(toml_table), pointer :: ptr
- type(toml_key), allocatable :: list(:)
type(dependency_tree_t) :: deps
table = toml_table()
@@ -169,8 +168,7 @@ contains
type(error_t), allocatable, intent(out) :: error
type(toml_table) :: table
- type(toml_table), pointer :: child, ptr
- type(toml_key), allocatable :: list(:)
+ type(toml_table), pointer :: ptr
type(mock_dependency_tree_t) :: deps
type(dependency_config_t), allocatable :: nodes(:)
@@ -224,10 +222,6 @@ contains
!> Error handling
type(error_t), allocatable, intent(out) :: error
- type(package_config_t) :: package
- character(len=:), allocatable :: manifest, proj_dir, revision
- logical :: fetch
-
if (dependency%done) then
call test_failed(error, "Should only visit this node once")
return
diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90
index 12fc419..047b289 100644
--- a/test/fpm_test/test_source_parsing.f90
+++ b/test/fpm_test/test_source_parsing.f90
@@ -655,7 +655,7 @@ contains
end subroutine test_csource
-
+
!> Try to parse fortran program with invalid use statement
subroutine test_invalid_use_stmt(error)
diff --git a/test/fpm_test/test_versioning.f90 b/test/fpm_test/test_versioning.f90
index f6dcb57..6a77d10 100644
--- a/test/fpm_test/test_versioning.f90
+++ b/test/fpm_test/test_versioning.f90
@@ -272,7 +272,6 @@ contains
type(error_t), allocatable, intent(out) :: error
type(version_t) :: v1, v2
- type(version_t) :: varray(4)
call new_version(v1, [1, 1, 0])
call new_version(v2, [1])
diff --git a/test/help_test/help_test.f90 b/test/help_test/help_test.f90
index 8f0c455..4f23bcb 100644
--- a/test/help_test/help_test.f90
+++ b/test/help_test/help_test.f90
@@ -5,7 +5,7 @@ use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit,
use fpm_filesystem, only : dirname, join_path, exists
use fpm_environment, only : get_os_type, OS_WINDOWS
implicit none
-integer :: i, j
+integer :: i
integer :: be, af
character(len=:),allocatable :: path
integer :: estat, cstat