diff options
| -rw-r--r-- | src/fpm.f90 | 12 | ||||
| -rw-r--r-- | src/fpm/cmd/install.f90 | 2 | ||||
| -rw-r--r-- | src/fpm/cmd/new.f90 | 4 | ||||
| -rw-r--r-- | src/fpm/cmd/update.f90 | 2 | ||||
| -rw-r--r-- | src/fpm/error.f90 | 21 | ||||
| -rw-r--r-- | src/fpm/manifest/example.f90 | 6 | ||||
| -rw-r--r-- | src/fpm/manifest/executable.f90 | 7 | ||||
| -rw-r--r-- | src/fpm/manifest/package.f90 | 6 | ||||
| -rw-r--r-- | src/fpm/manifest/test.f90 | 6 | ||||
| -rw-r--r-- | src/fpm_command_line.f90 | 25 | ||||
| -rw-r--r-- | src/fpm_environment.f90 | 2 | ||||
| -rw-r--r-- | src/fpm_filesystem.f90 | 18 | ||||
| -rw-r--r-- | src/fpm_source_parsing.f90 | 48 | ||||
| -rw-r--r-- | src/fpm_strings.f90 | 34 |
14 files changed, 92 insertions, 101 deletions
diff --git a/src/fpm.f90 b/src/fpm.f90 index c670378..bc6741d 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -256,19 +256,19 @@ integer :: i call get_package_data(package, "fpm.toml", error, apply_defaults=.true.) if (allocated(error)) then print '(a)', error%message - error stop 1 + stop 1 end if call build_model(model, settings, package, error) if (allocated(error)) then print '(a)', error%message - error stop 1 + stop 1 end if call targets_from_sources(targets,model,error) if (allocated(error)) then print '(a)', error%message - error stop 1 + stop 1 end if if(settings%list)then @@ -305,19 +305,19 @@ 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 + stop 1 end if call build_model(model, settings%fpm_build_settings, package, error) if (allocated(error)) then print '(a)', error%message - error stop 1 + stop 1 end if call targets_from_sources(targets,model,error) if (allocated(error)) then print '(a)', error%message - error stop 1 + stop 1 end if if (test) then diff --git a/src/fpm/cmd/install.f90 b/src/fpm/cmd/install.f90 index db7a9f8..a33ff27 100644 --- a/src/fpm/cmd/install.f90 +++ b/src/fpm/cmd/install.f90 @@ -169,7 +169,7 @@ contains type(error_t), intent(in), optional :: error if (present(error)) then print '("[Error]", 1x, a)', error%message - error stop 1 + stop 1 end if end subroutine handle_error diff --git a/src/fpm/cmd/new.f90 b/src/fpm/cmd/new.f90 index 1e92678..59306d9 100644 --- a/src/fpm/cmd/new.f90 +++ b/src/fpm/cmd/new.f90 @@ -55,9 +55,9 @@ 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,intrinsic :: iso_fortran_env, only : stderr=>error_unit implicit none private diff --git a/src/fpm/cmd/update.f90 b/src/fpm/cmd/update.f90 index d7cc549..8a47592 100644 --- a/src/fpm/cmd/update.f90 +++ b/src/fpm/cmd/update.f90 @@ -61,7 +61,7 @@ contains type(error_t), intent(in), optional :: error if (present(error)) then print '(a)', error%message - error stop 1 + stop 1 end if end subroutine handle_error diff --git a/src/fpm/error.f90 b/src/fpm/error.f90 index e69ff1e..0a5e9b1 100644 --- a/src/fpm/error.f90 +++ b/src/fpm/error.f90 @@ -16,16 +16,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 +32,19 @@ 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 + !> Error created when a file is missing or not found subroutine file_not_found_error(error, file_name) diff --git a/src/fpm/manifest/example.f90 b/src/fpm/manifest/example.f90 index fc2a0af..caf1e1e 100644 --- a/src/fpm/manifest/example.f90 +++ b/src/fpm/manifest/example.f90 @@ -19,6 +19,7 @@ module fpm_manifest_example use fpm_manifest_executable, only : executable_config_t use fpm_error, only : error_t, syntax_error use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + use fpm_strings, only : to_fortran_name, is_fortran_name implicit none private @@ -61,6 +62,11 @@ contains call syntax_error(error, "Could not retrieve example name") return end if + if(.not.is_fortran_name(to_fortran_name(self%name)))then + call syntax_error(error, 'manifest file syntax error: example name must be composed only of & + &alphanumerics, "-" and "_" and start with a letter') + 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..d376263 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 - use fpm_strings, only : string_t + use fpm_strings, only : string_t, is_fortran_name, to_fortran_name use fpm_toml, only : toml_table, toml_key, toml_stat, get_value implicit none private @@ -72,6 +72,11 @@ contains call syntax_error(error, "Could not retrieve executable name") return end if + if(.not.is_fortran_name(to_fortran_name(self%name)))then + call syntax_error(error, 'manifest file syntax error: executable name must be composed only of & + &alphanumerics, "-" and "_" and start with a letter') + 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..0150553 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -42,6 +42,7 @@ module fpm_manifest_package use fpm_error, only : error_t, fatal_error, syntax_error use fpm_toml, only : toml_table, toml_array, toml_key, toml_stat, get_value, & & len + use fpm_strings, only : is_fortran_name, to_fortran_name use fpm_versioning, only : version_t, new_version implicit none private @@ -131,6 +132,11 @@ contains call syntax_error(error, "Could not retrieve package name") return end if + if(.not.is_fortran_name(to_fortran_name(self%name)))then + call syntax_error(error, 'manifest file syntax error: package name must be composed only of & + &alphanumerics, "-" and "_" and start with a letter') + 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..9912414 100644 --- a/src/fpm/manifest/test.f90 +++ b/src/fpm/manifest/test.f90 @@ -19,6 +19,7 @@ module fpm_manifest_test use fpm_manifest_executable, only : executable_config_t use fpm_error, only : error_t, syntax_error use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + use fpm_strings, only : to_fortran_name, is_fortran_name implicit none private @@ -61,6 +62,11 @@ contains call syntax_error(error, "Could not retrieve test name") return end if + if(.not.is_fortran_name(to_fortran_name(self%name)))then + call syntax_error(error, 'manifest file syntax error: test name must be composed only of & + &alphanumerics, "-" and "_" and start with a letter') + 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_command_line.f90 b/src/fpm_command_line.f90 index b130f89..d119443 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -28,8 +28,8 @@ 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,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & @@ -517,27 +517,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..8f6a284 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -158,7 +158,7 @@ contains else if (stat /= 0) then print *, 'Command failed' - error stop + stop end if end if diff --git a/src/fpm_filesystem.f90 b/src/fpm_filesystem.f90 index e6226b4..8f61f96 100644 --- a/src/fpm_filesystem.f90 +++ b/src/fpm_filesystem.f90 @@ -10,7 +10,7 @@ use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, 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 @@ -306,8 +306,7 @@ subroutine mkdir(dir) end select if (stat /= 0) then - print *, 'execute_command_line() failed' - error stop + stop 'execute_command_line() failed' end if end subroutine mkdir @@ -344,8 +343,7 @@ recursive subroutine list_files(dir, files, recurse) end select if (stat /= 0) then - print *, 'execute_command_line() failed' - error stop + stop 'execute_command_line() failed' end if open (newunit=fh, file=temp_file, status='old') @@ -612,16 +610,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..d2c9b7d 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, & @@ -146,7 +146,7 @@ function parse_f_source(f_filename,error) result(f_source) end if - if (.not.validate_name(mod_name)) then + if (.not.is_fortran_name(mod_name)) then cycle end if @@ -215,7 +215,7 @@ 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)) @@ -242,7 +242,7 @@ function parse_f_source(f_filename,error) result(f_source) file_lines(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)) @@ -271,7 +271,7 @@ 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)) @@ -321,44 +321,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 diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index 3d7d7b1..ee5c20a 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 @@ -33,6 +35,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 @@ -921,4 +924,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 |