aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/fpm.f9040
-rw-r--r--src/fpm/cmd/install.f905
-rw-r--r--src/fpm/cmd/new.f907
-rw-r--r--src/fpm/cmd/update.f905
-rw-r--r--src/fpm/error.f9075
-rw-r--r--src/fpm/manifest/example.f905
-rw-r--r--src/fpm/manifest/executable.f907
-rw-r--r--src/fpm/manifest/package.f905
-rw-r--r--src/fpm/manifest/test.f905
-rw-r--r--src/fpm_backend.f909
-rw-r--r--src/fpm_command_line.f9042
-rw-r--r--src/fpm_environment.f904
-rw-r--r--src/fpm_filesystem.F9032
-rw-r--r--src/fpm_source_parsing.f90126
-rw-r--r--src/fpm_strings.f9034
-rw-r--r--src/fpm_targets.f906
-rw-r--r--test/fpm_test/test_manifest.f904
-rw-r--r--test/fpm_test/test_toml.f904
18 files changed, 216 insertions, 199 deletions
diff --git a/src/fpm.f90 b/src/fpm.f90
index c670378..d32051b 100644
--- a/src/fpm.f90
+++ b/src/fpm.f90
@@ -18,7 +18,7 @@ use fpm_targets, only: targets_from_sources, resolve_module_dependencies, &
resolve_target_linking, build_target_t, build_target_ptr, &
FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE
use fpm_manifest, only : get_package_data, package_config_t
-use fpm_error, only : error_t, fatal_error
+use fpm_error, only : error_t, fatal_error, fpm_stop
use fpm_manifest_test, only : test_config_t
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, &
& stdout=>output_unit, &
@@ -196,7 +196,7 @@ subroutine build_model(model, settings, package, error)
! Check for duplicate modules
call check_modules_for_duplicates(model, duplicates_found)
if (duplicates_found) then
- error stop 'Error: One or more duplicate module names found.'
+ call fpm_stop(1,'*build_model*:Error: One or more duplicate module names found.')
end if
end subroutine build_model
@@ -255,20 +255,17 @@ integer :: i
call get_package_data(package, "fpm.toml", error, apply_defaults=.true.)
if (allocated(error)) then
- print '(a)', error%message
- error stop 1
+ call fpm_stop(1,'*cmd_build*:package error:'//error%message)
end if
call build_model(model, settings, package, error)
if (allocated(error)) then
- print '(a)', error%message
- error stop 1
+ call fpm_stop(1,'*cmd_build*:model error:'//error%message)
end if
call targets_from_sources(targets,model,error)
if (allocated(error)) then
- print '(a)', error%message
- error stop 1
+ call fpm_stop(1,'*cmd_build*:target error:'//error%message)
end if
if(settings%list)then
@@ -304,20 +301,17 @@ subroutine cmd_run(settings,test)
call get_package_data(package, "fpm.toml", error, apply_defaults=.true.)
if (allocated(error)) then
- print '(a)', error%message
- error stop 1
+ call fpm_stop(1, '*cmd_run*:package error:'//error%message)
end if
call build_model(model, settings%fpm_build_settings, package, error)
if (allocated(error)) then
- print '(a)', error%message
- error stop 1
+ call fpm_stop(1, '*cmd_run*:model error:'//error%message)
end if
call targets_from_sources(targets,model,error)
if (allocated(error)) then
- print '(a)', error%message
- error stop 1
+ call fpm_stop(1, '*cmd_run*:targets error:'//error%message)
end if
if (test) then
@@ -373,11 +367,10 @@ subroutine cmd_run(settings,test)
! Check if any apps/tests were found
if (col_width < 0) then
if (test) then
- write(stderr,*) 'No tests to run'
+ call fpm_stop(0,'No tests to run')
else
- write(stderr,*) 'No executables to run'
+ call fpm_stop(0,'No executables to run')
end if
- stop
end if
! Check all names are valid
@@ -391,7 +384,7 @@ subroutine cmd_run(settings,test)
line=join(settings%name)
if(line.ne.'.')then ! do not report these special strings
if(any(.not.found))then
- write(stderr,'(A)',advance="no")'fpm::run<ERROR> specified names '
+ write(stderr,'(A)',advance="no")'<ERROR>*cmd_run*:specified names '
do j=1,size(settings%name)
if (.not.found(j)) write(stderr,'(A)',advance="no") '"'//trim(settings%name(j))//'" '
end do
@@ -406,9 +399,9 @@ subroutine cmd_run(settings,test)
call compact_list_all()
if(line.eq.'.' .or. line.eq.' ')then ! do not report these special strings
- stop
+ call fpm_stop(0,'')
else
- stop 1
+ call fpm_stop(1,'')
endif
end if
@@ -430,18 +423,17 @@ subroutine cmd_run(settings,test)
exitstat=stat(i))
endif
else
- write(stderr,*)'fpm::run<ERROR>',executables(i)%s,' not found'
- stop 1
+ call fpm_stop(1,'*cmd_run*:'//executables(i)%s//' not found')
end if
end do
if (any(stat /= 0)) then
do i=1,size(stat)
if (stat(i) /= 0) then
- write(*,*) '<ERROR> Execution failed for "',basename(executables(i)%s),'"'
+ write(stderr,'(*(g0:,1x))') '<ERROR> Execution failed for object "',basename(executables(i)%s),'"'
end if
end do
- stop 1
+ call fpm_stop(1,'*cmd_run*:stopping due to failed executions')
end if
endif
diff --git a/src/fpm/cmd/install.f90 b/src/fpm/cmd/install.f90
index db7a9f8..e53609b 100644
--- a/src/fpm/cmd/install.f90
+++ b/src/fpm/cmd/install.f90
@@ -3,7 +3,7 @@ module fpm_cmd_install
use fpm, only : build_model
use fpm_backend, only : build_package
use fpm_command_line, only : fpm_install_settings
- use fpm_error, only : error_t, fatal_error
+ use fpm_error, only : error_t, fatal_error, fpm_stop
use fpm_filesystem, only : join_path, list_files
use fpm_installer, only : installer_t, new_installer
use fpm_manifest, only : package_config_t, get_package_data
@@ -168,8 +168,7 @@ contains
subroutine handle_error(error)
type(error_t), intent(in), optional :: error
if (present(error)) then
- print '("[Error]", 1x, a)', error%message
- error stop 1
+ call fpm_stop(1,error%message)
end if
end subroutine handle_error
diff --git a/src/fpm/cmd/new.f90 b/src/fpm/cmd/new.f90
index 1e92678..81cf62f 100644
--- a/src/fpm/cmd/new.f90
+++ b/src/fpm/cmd/new.f90
@@ -55,9 +55,10 @@ module fpm_cmd_new
use fpm_command_line, only : fpm_new_settings
use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS
-use fpm_filesystem, only : join_path, exists, basename, mkdir, is_dir, to_fortran_name
+use fpm_filesystem, only : join_path, exists, basename, mkdir, is_dir
use fpm_filesystem, only : fileopen, fileclose, filewrite, warnwrite
-use fpm_strings, only : join
+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
@@ -606,7 +607,7 @@ character(len=*),intent(in) :: filename
! continue building of manifest
! ...
call new_package(package, table, error=error)
- if (allocated(error)) stop 3
+ if (allocated(error)) call fpm_stop( 3,'')
if(settings%verbose)then
call table%accept(ser)
endif
diff --git a/src/fpm/cmd/update.f90 b/src/fpm/cmd/update.f90
index d7cc549..aa99ca3 100644
--- a/src/fpm/cmd/update.f90
+++ b/src/fpm/cmd/update.f90
@@ -1,7 +1,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
+ use fpm_error, only : error_t, fpm_stop
use fpm_filesystem, only : exists, mkdir, join_path, delete_file
use fpm_manifest, only : package_config_t, get_package_data
implicit none
@@ -60,8 +60,7 @@ contains
!> Potential error
type(error_t), intent(in), optional :: error
if (present(error)) then
- print '(a)', error%message
- error stop 1
+ call fpm_stop(1, error%message)
end if
end subroutine handle_error
diff --git a/src/fpm/error.f90 b/src/fpm/error.f90
index e69ff1e..f966996 100644
--- a/src/fpm/error.f90
+++ b/src/fpm/error.f90
@@ -1,11 +1,15 @@
!> Implementation of basic error handling.
module fpm_error
+ use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
+ use fpm_strings, only : is_fortran_name, to_fortran_name
implicit none
private
public :: error_t
public :: fatal_error, syntax_error, file_not_found_error
public :: file_parse_error
+ public :: bad_name_error
+ public :: fpm_stop
!> Data type defining an error
@@ -16,16 +20,8 @@ module fpm_error
end type error_t
-
- !> Alias syntax errors to fatal errors for now
- interface syntax_error
- module procedure :: fatal_error
- end interface syntax_error
-
-
contains
-
!> Generic fatal runtime error
subroutine fatal_error(error, message)
@@ -40,6 +36,43 @@ contains
end subroutine fatal_error
+ subroutine syntax_error(error, message)
+
+ !> Instance of the error data
+ type(error_t), allocatable, intent(out) :: error
+
+ !> Error message
+ character(len=*), intent(in) :: message
+
+ allocate(error)
+ error%message = message
+
+ end subroutine syntax_error
+
+ function bad_name_error(error, label,name)
+
+ !> Instance of the error data
+ type(error_t), allocatable, intent(out) :: error
+
+ !> Error message label to add to message
+ character(len=*), intent(in) :: label
+
+ !> name value to check
+ character(len=*), intent(in) :: name
+
+ logical :: bad_name_error
+
+ if(.not.is_fortran_name(to_fortran_name(name)))then
+ bad_name_error=.true.
+ allocate(error)
+ error%message = 'manifest file syntax error: '//label//' name must be composed only of &
+ &alphanumerics, "-" and "_" and start with a letter ::'//name
+ else
+ bad_name_error=.false.
+ endif
+
+ end function bad_name_error
+
!> Error created when a file is missing or not found
subroutine file_not_found_error(error, file_name)
@@ -82,9 +115,9 @@ contains
allocate(error)
error%message = 'Parse error: '//message//new_line('a')
-
+
error%message = error%message//file_name
-
+
if (present(line_num)) then
write(temp_string,'(I0)') line_num
@@ -115,14 +148,32 @@ contains
error%message = error%message//new_line('a')
error%message = error%message//' | '//repeat(' ',line_col-1)//'^'
-
+
end if
-
+
end if
end if
end subroutine file_parse_error
+ subroutine fpm_stop(value,message)
+ ! TODO: if verbose mode, call ERROR STOP instead of STOP
+ ! TODO: if M_escape is used, add color
+ ! to work with older compilers might need a case statement for values
+
+ !> value to use on STOP
+ integer, intent(in) :: value
+ !> Error message
+ character(len=*), intent(in) :: message
+ if(message.ne.'')then
+ if(value.gt.0)then
+ write(stderr,'("<ERROR>",a)')trim(message)
+ else
+ write(stderr,'("<INFO> ",a)')trim(message)
+ endif
+ endif
+ stop value
+ end subroutine fpm_stop
end module fpm_error
diff --git a/src/fpm/manifest/example.f90 b/src/fpm/manifest/example.f90
index fc2a0af..3319401 100644
--- a/src/fpm/manifest/example.f90
+++ b/src/fpm/manifest/example.f90
@@ -17,7 +17,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
+ use fpm_error, only : error_t, syntax_error, bad_name_error
use fpm_toml, only : toml_table, toml_key, toml_stat, get_value
implicit none
private
@@ -61,6 +61,9 @@ contains
call syntax_error(error, "Could not retrieve example name")
return
end if
+ if (bad_name_error(error,'example',self%name))then
+ return
+ endif
call get_value(table, "source-dir", self%source_dir, "example")
call get_value(table, "main", self%main, "main.f90")
diff --git a/src/fpm/manifest/executable.f90 b/src/fpm/manifest/executable.f90
index be02974..60c20ec 100644
--- a/src/fpm/manifest/executable.f90
+++ b/src/fpm/manifest/executable.f90
@@ -12,8 +12,8 @@
!>```
module fpm_manifest_executable
use fpm_manifest_dependency, only : dependency_config_t, new_dependencies
- use fpm_error, only : error_t, syntax_error
- use fpm_strings, only : string_t
+ 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
implicit none
private
@@ -72,6 +72,9 @@ contains
call syntax_error(error, "Could not retrieve executable name")
return
end if
+ if (bad_name_error(error,'executable',self%name))then
+ return
+ endif
call get_value(table, "source-dir", self%source_dir, "app")
call get_value(table, "main", self%main, "main.f90")
diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90
index 0430761..1f85144 100644
--- a/src/fpm/manifest/package.f90
+++ b/src/fpm/manifest/package.f90
@@ -39,7 +39,7 @@ module fpm_manifest_package
use fpm_manifest_install, only: install_config_t, new_install_config
use fpm_manifest_test, only : test_config_t, new_test
use fpm_filesystem, only : exists, getline, join_path
- use fpm_error, only : error_t, fatal_error, syntax_error
+ use fpm_error, only : error_t, fatal_error, syntax_error, bad_name_error
use fpm_toml, only : toml_table, toml_array, toml_key, toml_stat, get_value, &
& len
use fpm_versioning, only : version_t, new_version
@@ -131,6 +131,9 @@ contains
call syntax_error(error, "Could not retrieve package name")
return
end if
+ if (bad_name_error(error,'package',self%name))then
+ return
+ endif
if (len(self%name) <= 0) then
call syntax_error(error, "Package name must be a non-empty string")
diff --git a/src/fpm/manifest/test.f90 b/src/fpm/manifest/test.f90
index bcacbd8..e689774 100644
--- a/src/fpm/manifest/test.f90
+++ b/src/fpm/manifest/test.f90
@@ -17,7 +17,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
+ use fpm_error, only : error_t, syntax_error, bad_name_error
use fpm_toml, only : toml_table, toml_key, toml_stat, get_value
implicit none
private
@@ -61,6 +61,9 @@ contains
call syntax_error(error, "Could not retrieve test name")
return
end if
+ if (bad_name_error(error,'test',self%name))then
+ return
+ endif
call get_value(table, "source-dir", self%source_dir, "test")
call get_value(table, "main", self%main, "main.f90")
diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90
index 8628ec4..e82d847 100644
--- a/src/fpm_backend.f90
+++ b/src/fpm_backend.f90
@@ -27,6 +27,8 @@
!>
module fpm_backend
+use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
+use fpm_error, only : fpm_stop
use fpm_environment, only: run, get_os_type, OS_WINDOWS
use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir, unix_path
use fpm_model, only: fpm_model_t
@@ -98,10 +100,10 @@ subroutine build_package(targets,model)
if (build_failed) then
do j=1,size(stat)
if (stat(j) /= 0) then
- write(*,*) '<ERROR> Compilation failed for object "',basename(queue(j)%ptr%output_file),'"'
+ write(stderr,'(*(g0:,1x))') '<ERROR> Compilation failed for object "',basename(queue(j)%ptr%output_file),'"'
end if
end do
- stop 1
+ call fpm_stop(1,'stopping due to failed compilation')
end if
end do
@@ -135,8 +137,7 @@ recursive subroutine sort_target(target)
! Check for a circular dependency
! (If target has been touched but not processed)
if (target%touched) then
- write(*,*) '(!) Circular dependency found with: ',target%output_file
- stop
+ call fpm_stop(1,'(!) Circular dependency found with: '//target%output_file)
else
target%touched = .true. ! Set touched flag
end if
diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90
index b130f89..2ed7ac6 100644
--- a/src/fpm_command_line.f90
+++ b/src/fpm_command_line.f90
@@ -28,10 +28,11 @@ use fpm_environment, only : get_os_type, get_env, &
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD
use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified
use M_CLI2, only : get_subcommand, CLI_RESPONSE_FILE
-use fpm_strings, only : lower, split, fnv_1a
-use fpm_filesystem, only : basename, canon_path, to_fortran_name, which
+use fpm_strings, only : lower, split, fnv_1a, to_fortran_name, is_fortran_name
+use fpm_filesystem, only : basename, canon_path, which
use fpm_environment, only : run, get_command_arguments_quoted
-use fpm_compiler, only : get_default_compile_flags
+use fpm_compiler, only : get_default_compile_flags
+use fpm_error, only : fpm_stop
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, &
& stdout=>output_unit, &
& stderr=>error_unit
@@ -138,7 +139,7 @@ contains
case default ; os_type = "OS Type: UNKNOWN"
end select
version_text = [character(len=80) :: &
- & 'Version: 0.3.0, alpha', &
+ & 'Version: 0.3.0, alpha', &
& 'Program: fpm(1)', &
& 'Description: A Fortran package manager and build system', &
& 'Home Page: https://github.com/fortran-lang/fpm', &
@@ -244,17 +245,15 @@ contains
& help_new, version_text)
select case(size(unnamed))
case(1)
- write(stderr,'(*(g0,/))')'<ERROR> directory name required'
write(stderr,'(*(7x,g0,/))') &
& '<USAGE> fpm new NAME [[--lib|--src] [--app] [--test] [--example]]|[--full|--bare] [--backfill]'
- stop 1
+ call fpm_stop(1,'directory name required')
case(2)
name=trim(unnamed(2))
case default
- write(stderr,'(g0)')'<ERROR> only one directory name allowed'
write(stderr,'(7x,g0)') &
& '<USAGE> fpm new NAME [[--lib|--src] [--app] [--test] [--example]]| [--full|--bare] [--backfill]'
- stop 2
+ call fpm_stop(2,'only one directory name allowed')
end select
!*! canon_path is not converting ".", etc.
name=canon_path(name)
@@ -262,7 +261,7 @@ contains
write(stderr,'(g0)') [ character(len=72) :: &
& '<ERROR> the fpm project name must be made of up to 63 ASCII letters,', &
& ' numbers, underscores, or hyphens, and start with a letter.']
- stop 4
+ call fpm_stop(4,' ')
endif
allocate(fpm_new_settings :: cmd_settings)
@@ -271,13 +270,13 @@ contains
write(stderr,'(*(a))')&
&'<ERROR> --full and any of [--src|--lib,--app,--test,--example,--bare]', &
&' are mutually exclusive.'
- stop 5
+ call fpm_stop(5,' ')
elseif (any( specified([character(len=10) :: 'src','lib','app','test','example','full'])) &
& .and.lget('bare') )then
write(stderr,'(*(a))')&
&'<ERROR> --bare and any of [--src|--lib,--app,--test,--example,--full]', &
&' are mutually exclusive.'
- stop 3
+ call fpm_stop(3,' ')
elseif (any( specified([character(len=10) :: 'src','lib','app','test','example']) ) )then
cmd_settings=fpm_new_settings(&
& backfill=lget('backfill'), &
@@ -517,27 +516,6 @@ contains
end subroutine get_command_line_settings
- function is_fortran_name(line) result (lout)
- ! determine if a string is a valid Fortran name ignoring trailing spaces
- ! (but not leading spaces)
- character(len=*),parameter :: int='0123456789'
- character(len=*),parameter :: lower='abcdefghijklmnopqrstuvwxyz'
- character(len=*),parameter :: upper='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
- character(len=*),parameter :: allowed=upper//lower//int//'_'
- character(len=*),intent(in) :: line
- character(len=:),allocatable :: name
- logical :: lout
- name=trim(line)
- if(len(name).ne.0)then
- lout = .true. &
- & .and. verify(name(1:1), lower//upper) == 0 &
- & .and. verify(name,allowed) == 0 &
- & .and. len(name) <= 63
- else
- lout = .false.
- endif
- end function is_fortran_name
-
subroutine set_help()
help_list_nodash=[character(len=80) :: &
'USAGE: fpm [ SUBCOMMAND [SUBCOMMAND_OPTIONS] ]|[--list|--help|--version]', &
diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90
index cf76250..e9da3c7 100644
--- a/src/fpm_environment.f90
+++ b/src/fpm_environment.f90
@@ -6,6 +6,7 @@ module fpm_environment
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, &
& stdout=>output_unit, &
& stderr=>error_unit
+ use fpm_error, only : fpm_stop
implicit none
private
public :: get_os_type
@@ -157,8 +158,7 @@ contains
exitstat = stat
else
if (stat /= 0) then
- print *, 'Command failed'
- error stop
+ call fpm_stop(1,'*run*:Command failed')
end if
end if
diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90
index 2851bfd..e5cfa9d 100644
--- a/src/fpm_filesystem.F90
+++ b/src/fpm_filesystem.F90
@@ -1,17 +1,18 @@
!> This module contains general routines for interacting with the file system
!!
module fpm_filesystem
-use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
+ use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
use fpm_environment, only: get_os_type, &
OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
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
public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, read_lines, list_files, env_variable, &
- mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file, to_fortran_name
+ mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file
public :: fileopen, fileclose, filewrite, warnwrite, parent_dir
public :: which
@@ -340,8 +341,7 @@ subroutine mkdir(dir)
end select
if (stat /= 0) then
- print *, 'execute_command_line() failed'
- error stop
+ call fpm_stop(1, '*mkdir*:directory creation failed')
end if
end subroutine mkdir
@@ -478,8 +478,7 @@ recursive subroutine list_files(dir, files, recurse)
end select
if (stat /= 0) then
- print *, 'execute_command_line() failed'
- error stop
+ call fpm_stop(2,'*list_files*:directory listing failed')
end if
open (newunit=fh, file=temp_file, status='old')
@@ -692,13 +691,11 @@ character(len=256) :: message
ios=0
endif
if(ios.ne.0)then
- write(stderr,'(*(a:,1x))')&
- & '<ERROR> *filewrite*:',filename,trim(message)
lun=-1
if(present(ier))then
ier=ios
else
- stop 1
+ call fpm_stop(3,'*fileopen*:'//filename//':'//trim(message))
endif
endif
@@ -713,11 +710,10 @@ integer :: ios
if(lun.ne.-1)then
close(unit=lun,iostat=ios,iomsg=message)
if(ios.ne.0)then
- write(stderr,'(*(a:,1x))')'<ERROR> *filewrite*:',trim(message)
if(present(ier))then
ier=ios
else
- stop 2
+ call fpm_stop(4,'*fileclose*:'//trim(message))
endif
endif
endif
@@ -737,9 +733,7 @@ character(len=256) :: message
do i=1,size(filedata)
write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i))
if(ios.ne.0)then
- write(stderr,'(*(a:,1x))')&
- & '<ERROR> *filewrite*:',filename,trim(message)
- stop 4
+ call fpm_stop(5,'*filewrite*:'//filename//':'//trim(message))
endif
enddo
endif
@@ -748,16 +742,6 @@ character(len=256) :: message
end subroutine filewrite
-!> Returns string with special characters replaced with an underscore.
-!! For now, only a hyphen is treated as a special character, but this can be
-!! expanded to other characters if needed.
-pure function to_fortran_name(string) result(res)
- character(*), intent(in) :: string
- character(len(string)) :: res
- character, parameter :: SPECIAL_CHARACTERS(*) = ['-']
- res = replace(string, SPECIAL_CHARACTERS, '_')
-end function to_fortran_name
-
function which(command) result(pathname)
!>
!!##NAME
diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90
index 6fa00d5..41137fb 100644
--- a/src/fpm_source_parsing.f90
+++ b/src/fpm_source_parsing.f90
@@ -16,7 +16,7 @@
!>
module fpm_source_parsing
use fpm_error, only: error_t, file_parse_error, fatal_error
-use fpm_strings, only: string_t, string_cat, len_trim, split, lower, str_ends_with, fnv_1a
+use fpm_strings, only: string_t, string_cat, len_trim, split, lower, str_ends_with, fnv_1a, is_fortran_name
use fpm_model, only: srcfile_t, &
FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, &
FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, &
@@ -78,7 +78,7 @@ function parse_f_source(f_filename,error) result(f_source)
integer :: stat
integer :: fh, n_use, n_include, n_mod, i, j, ic, pass
- type(string_t), allocatable :: file_lines(:)
+ type(string_t), allocatable :: file_lines(:), file_lines_lower(:)
character(:), allocatable :: temp_string, mod_name, string_parts(:)
f_source%file_name = f_filename
@@ -87,8 +87,15 @@ function parse_f_source(f_filename,error) result(f_source)
file_lines = read_lines(fh)
close(fh)
- ! Ignore empty files, returned as FPM_UNIT_UNKNOW
- if (len_trim(file_lines) < 1) return
+ ! for efficiency in parsing make a lowercase left-adjusted copy of the file
+ ! Need a copy because INCLUDE (and #include) file arguments are case-sensitive
+ file_lines_lower=file_lines
+ do i=1,size(file_lines_lower)
+ file_lines_lower(i)%s=adjustl(lower(file_lines_lower(i)%s))
+ enddo
+
+ ! Ignore empty files, returned as FPM_UNIT_UNKNOWN
+ if (len_trim(file_lines_lower) < 1) return
f_source%digest = fnv_1a(file_lines)
@@ -96,31 +103,31 @@ function parse_f_source(f_filename,error) result(f_source)
n_use = 0
n_include = 0
n_mod = 0
- file_loop: do i=1,size(file_lines)
+ file_loop: do i=1,size(file_lines_lower)
! Skip lines that are continued: not statements
if (i > 1) then
- ic = index(file_lines(i-1)%s,'!')
+ ic = index(file_lines_lower(i-1)%s,'!')
if (ic < 1) then
- ic = len(file_lines(i-1)%s)
+ ic = len(file_lines_lower(i-1)%s)
end if
- temp_string = trim(file_lines(i-1)%s(1:ic))
+ temp_string = trim(file_lines_lower(i-1)%s(1:ic))
if (len(temp_string) > 0 .and. index(temp_string,'&') == len(temp_string)) then
cycle
end if
end if
! Process 'USE' statements
- if (index(adjustl(lower(file_lines(i)%s)),'use ') == 1 .or. &
- index(adjustl(lower(file_lines(i)%s)),'use::') == 1) then
+ if (index(file_lines_lower(i)%s,'use ') == 1 .or. &
+ index(file_lines_lower(i)%s,'use::') == 1) then
- if (index(file_lines(i)%s,'::') > 0) then
+ if (index(file_lines_lower(i)%s,'::') > 0) then
- temp_string = split_n(file_lines(i)%s,delims=':',n=2,stat=stat)
+ temp_string = split_n(file_lines_lower(i)%s,delims=':',n=2,stat=stat)
if (stat /= 0) then
call file_parse_error(error,f_filename, &
'unable to find used module name',i, &
- file_lines(i)%s,index(file_lines(i)%s,'::'))
+ file_lines_lower(i)%s,index(file_lines_lower(i)%s,'::'))
return
end if
@@ -128,25 +135,23 @@ function parse_f_source(f_filename,error) result(f_source)
if (stat /= 0) then
call file_parse_error(error,f_filename, &
'unable to find used module name',i, &
- file_lines(i)%s)
+ file_lines_lower(i)%s)
return
end if
- mod_name = lower(mod_name)
else
- mod_name = split_n(file_lines(i)%s,n=2,delims=' ,',stat=stat)
+ mod_name = split_n(file_lines_lower(i)%s,n=2,delims=' ,',stat=stat)
if (stat /= 0) then
call file_parse_error(error,f_filename, &
'unable to find used module name',i, &
- file_lines(i)%s)
+ file_lines_lower(i)%s)
return
end if
- mod_name = lower(mod_name)
end if
- if (.not.validate_name(mod_name)) then
+ if (.not.is_fortran_name(mod_name)) then
cycle
end if
@@ -166,13 +171,12 @@ function parse_f_source(f_filename,error) result(f_source)
end if
! Process 'INCLUDE' statements
- ic = index(adjustl(lower(file_lines(i)%s)),'include')
+ ic = index(file_lines_lower(i)%s,'include')
if ( ic == 1 ) then
ic = index(lower(file_lines(i)%s),'include')
if (index(adjustl(file_lines(i)%s(ic+7:)),'"') == 1 .or. &
index(adjustl(file_lines(i)%s(ic+7:)),"'") == 1 ) then
-
n_include = n_include + 1
if (pass == 2) then
@@ -189,14 +193,14 @@ function parse_f_source(f_filename,error) result(f_source)
end if
! Extract name of module if is module
- if (index(adjustl(lower(file_lines(i)%s)),'module ') == 1) then
+ if (index(file_lines_lower(i)%s,'module ') == 1) then
! Remove any trailing comments
- ic = index(file_lines(i)%s,'!')-1
+ ic = index(file_lines_lower(i)%s,'!')-1
if (ic < 1) then
- ic = len(file_lines(i)%s)
+ ic = len(file_lines_lower(i)%s)
end if
- temp_string = trim(file_lines(i)%s(1:ic))
+ temp_string = trim(file_lines_lower(i)%s(1:ic))
! R1405 module-stmt := "MODULE" module-name
! module-stmt has two space-delimited parts only
@@ -206,7 +210,7 @@ function parse_f_source(f_filename,error) result(f_source)
cycle
end if
- mod_name = lower(trim(adjustl(string_parts(2))))
+ mod_name = trim(adjustl(string_parts(2)))
if (scan(mod_name,'=(&')>0 ) then
! Ignore these cases:
! module <something>&
@@ -215,10 +219,10 @@ function parse_f_source(f_filename,error) result(f_source)
cycle
end if
- if (.not.validate_name(mod_name)) then
+ if (.not.is_fortran_name(mod_name)) then
call file_parse_error(error,f_filename, &
'empty or invalid name for module',i, &
- file_lines(i)%s, index(file_lines(i)%s,mod_name))
+ file_lines_lower(i)%s, index(file_lines_lower(i)%s,mod_name))
return
end if
@@ -233,29 +237,29 @@ function parse_f_source(f_filename,error) result(f_source)
end if
! Extract name of submodule if is submodule
- if (index(adjustl(lower(file_lines(i)%s)),'submodule') == 1) then
+ if (index(file_lines_lower(i)%s,'submodule') == 1) then
- mod_name = split_n(file_lines(i)%s,n=3,delims='()',stat=stat)
+ mod_name = split_n(file_lines_lower(i)%s,n=3,delims='()',stat=stat)
if (stat /= 0) then
call file_parse_error(error,f_filename, &
'unable to get submodule name',i, &
- file_lines(i)%s)
+ file_lines_lower(i)%s)
return
end if
- if (.not.validate_name(mod_name)) then
+ if (.not.is_fortran_name(mod_name)) then
call file_parse_error(error,f_filename, &
'empty or invalid name for submodule',i, &
- file_lines(i)%s, index(file_lines(i)%s,mod_name))
+ file_lines_lower(i)%s, index(file_lines_lower(i)%s,mod_name))
return
end if
n_mod = n_mod + 1
- temp_string = split_n(file_lines(i)%s,n=2,delims='()',stat=stat)
+ temp_string = split_n(file_lines_lower(i)%s,n=2,delims='()',stat=stat)
if (stat /= 0) then
call file_parse_error(error,f_filename, &
'unable to get submodule ancestry',i, &
- file_lines(i)%s)
+ file_lines_lower(i)%s)
return
end if
@@ -271,16 +275,16 @@ function parse_f_source(f_filename,error) result(f_source)
end if
- if (.not.validate_name(temp_string)) then
+ if (.not.is_fortran_name(temp_string)) then
call file_parse_error(error,f_filename, &
'empty or invalid name for submodule parent',i, &
- file_lines(i)%s, index(file_lines(i)%s,temp_string))
+ file_lines_lower(i)%s, index(file_lines_lower(i)%s,temp_string))
return
end if
- f_source%modules_used(n_use)%s = lower(temp_string)
+ f_source%modules_used(n_use)%s = temp_string
- f_source%modules_provided(n_mod)%s = lower(mod_name)
+ f_source%modules_provided(n_mod)%s = mod_name
end if
@@ -288,9 +292,9 @@ function parse_f_source(f_filename,error) result(f_source)
! Detect if contains a program
! (no modules allowed after program def)
- if (index(adjustl(lower(file_lines(i)%s)),'program ') == 1) then
+ if (index(file_lines_lower(i)%s,'program ') == 1) then
- temp_string = lower(split_n(file_lines(i)%s,n=2,delims=' ',stat=stat))
+ temp_string = split_n(file_lines_lower(i)%s,n=2,delims=' ',stat=stat)
if (stat == 0) then
if (scan(temp_string,'=(')>0 ) then
@@ -321,44 +325,6 @@ function parse_f_source(f_filename,error) result(f_source)
end do
- contains
-
- function validate_name(name) result(valid)
- character(*), intent(in) :: name
- logical :: valid
-
- integer :: i
-
- if (len_trim(name) < 1) then
- valid = .false.
- return
- end if
-
- if (lower(name(1:1)) < 'a' .or. &
- lower(name(1:1)) > 'z') then
-
- valid = .false.
- return
- end if
-
- do i=1,len(name)
-
- if (.not.( &
- (name(i:i) >= '0' .and. name(i:i) <= '9').or. &
- (lower(name(i:i)) >= 'a' .and. lower(name(i:i)) <= 'z').or. &
- name(i:i) == '_') ) then
-
- valid = .false.
- return
- end if
-
- end do
-
- valid = .true.
- return
-
- end function validate_name
-
end function parse_f_source
@@ -395,7 +361,7 @@ function parse_c_source(c_filename,error) result(c_source)
file_lines = read_lines(fh)
close(fh)
- ! Ignore empty files, returned as FPM_UNIT_UNKNOW
+ ! Ignore empty files, returned as FPM_UNIT_UNKNOWN
if (len_trim(file_lines) < 1) then
c_source%unit_type = FPM_UNIT_UNKNOWN
return
diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90
index 5a47311..ba76d15 100644
--- a/src/fpm_strings.f90
+++ b/src/fpm_strings.f90
@@ -20,6 +20,8 @@
!! - [[STRING_ARRAY_CONTAINS]] Check if array of **TYPE(STRING_T)** matches a particular **CHARACTER** string
!! - **OPERATOR(.IN.)** Check if array of **TYPE(STRING_T)** matches a particular **CHARACTER** string
!! - [[GLOB]] function compares text strings, one of which can have wildcards ('*' or '?').
+!! - [[IS_FORTRAN_NAME]] determine whether a string is an acceptable Fortran entity name
+!! - [[TO_FORTRAN_NAME]] replace allowed special but unusuable characters in names with underscore
!!### Miscellaneous
!! - [[LEN_TRIM]] Determine total trimmed length of **STRING_T** array
!! - [[FNV_1A]] Hash a **CHARACTER(*)** string of default kind or a **TYPE(STRING_T)** array
@@ -34,6 +36,7 @@ implicit none
private
public :: f_string, lower, split, str_ends_with, string_t
+public :: to_fortran_name, is_fortran_name
public :: string_array_contains, string_cat, len_trim, operator(.in.), fnv_1a
public :: replace, resize, str, join, glob
@@ -953,4 +956,35 @@ else
end if
end function
+!> Returns string with special characters replaced with an underscore.
+!! For now, only a hyphen is treated as a special character, but this can be
+!! expanded to other characters if needed.
+pure function to_fortran_name(string) result(res)
+ character(*), intent(in) :: string
+ character(len(string)) :: res
+ character, parameter :: SPECIAL_CHARACTERS(*) = ['-']
+ res = replace(string, SPECIAL_CHARACTERS, '_')
+end function to_fortran_name
+
+function is_fortran_name(line) result (lout)
+! determine if a string is a valid Fortran name ignoring trailing spaces
+! (but not leading spaces)
+ character(len=*),parameter :: int='0123456789'
+ character(len=*),parameter :: lower='abcdefghijklmnopqrstuvwxyz'
+ character(len=*),parameter :: upper='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+ character(len=*),parameter :: allowed=upper//lower//int//'_'
+ character(len=*),intent(in) :: line
+ character(len=:),allocatable :: name
+ logical :: lout
+ name=trim(line)
+ if(len(name).ne.0)then
+ lout = .true. &
+ & .and. verify(name(1:1), lower//upper) == 0 &
+ & .and. verify(name,allowed) == 0 &
+ & .and. len(name) <= 63
+ else
+ lout = .false.
+ endif
+ end function is_fortran_name
+
end module fpm_strings
diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90
index c247232..66bbdd5 100644
--- a/src/fpm_targets.f90
+++ b/src/fpm_targets.f90
@@ -25,7 +25,7 @@
!>
module fpm_targets
use iso_fortran_env, only: int64
-use fpm_error, only: error_t, fatal_error
+use fpm_error, only: error_t, fatal_error, fpm_stop
use fpm_model
use fpm_environment, only: get_os_type, OS_WINDOWS
use fpm_filesystem, only: dirname, join_path, canon_path
@@ -298,7 +298,7 @@ subroutine add_target(targets,type,output_file,source,link_libraries)
write(*,*) 'Error while building target list: duplicate output object "',&
output_file,'"'
if (present(source)) write(*,*) ' Source file: "',source%file_name,'"'
- stop 1
+ call fpm_stop(1,' ')
end if
@@ -341,7 +341,7 @@ end subroutine add_dependency
!>
!> - Executable sources (`FPM_SCOPE_APP`,`FPM_SCOPE_TEST`) may use
!> library modules (including dependencies) as well as any modules
-!> corresponding to source files in the same directory or a
+!> corresponding to source files in the same directory or a
!> subdirectory of the executable source file.
!>
!> @warning If a module used by a source file cannot be resolved to
diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90
index 69c86fd..0f64aca 100644
--- a/test/fpm_test/test_manifest.f90
+++ b/test/fpm_test/test_manifest.f90
@@ -85,13 +85,13 @@ contains
& '[dependencies.fpm]', &
& 'git = "https://github.com/fortran-lang/fpm"', &
& '[[executable]]', &
- & 'name = "example-#1" # comment', &
+ & 'name = "example-1" # comment', &
& 'source-dir = "prog"', &
& '[dependencies]', &
& 'toml-f.git = "git@github.com:toml-f/toml-f.git"', &
& '"toml..f" = { path = ".." }', &
& '[["executable"]]', &
- & 'name = "example-#2"', &
+ & 'name = "example-2"', &
& 'source-dir = "prog"', &
& '[executable.dependencies]', &
& '[''library'']', &
diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90
index ba48307..1ffea1d 100644
--- a/test/fpm_test/test_toml.f90
+++ b/test/fpm_test/test_toml.f90
@@ -41,13 +41,13 @@ contains
& '[dependencies.fpm]', &
& 'git = "https://github.com/fortran-lang/fpm"', &
& '[[executable]]', &
- & 'name = "example-#1" # comment', &
+ & 'name = "example-1" # comment', &
& 'source-dir = "prog"', &
& '[dependencies]', &
& 'toml-f.git = "git@github.com:toml-f/toml-f.git"', &
& '"toml..f" = { path = ".." }', &
& '[["executable"]]', &
- & 'name = "example-#2"', &
+ & 'name = "example-2"', &
& 'source-dir = "prog"', &
& '[executable.dependencies]', &
& '[''library'']', &