diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/fpm.f90 | 40 | ||||
| -rw-r--r-- | src/fpm/cmd/install.f90 | 5 | ||||
| -rw-r--r-- | src/fpm/cmd/new.f90 | 7 | ||||
| -rw-r--r-- | src/fpm/cmd/update.f90 | 5 | ||||
| -rw-r--r-- | src/fpm/error.f90 | 75 | ||||
| -rw-r--r-- | src/fpm/manifest/example.f90 | 5 | ||||
| -rw-r--r-- | src/fpm/manifest/executable.f90 | 7 | ||||
| -rw-r--r-- | src/fpm/manifest/package.f90 | 5 | ||||
| -rw-r--r-- | src/fpm/manifest/test.f90 | 5 | ||||
| -rw-r--r-- | src/fpm_backend.f90 | 9 | ||||
| -rw-r--r-- | src/fpm_command_line.f90 | 42 | ||||
| -rw-r--r-- | src/fpm_environment.f90 | 4 | ||||
| -rw-r--r-- | src/fpm_filesystem.f90 | 32 | ||||
| -rw-r--r-- | src/fpm_source_parsing.f90 | 126 | ||||
| -rw-r--r-- | src/fpm_sources.f90 | 13 | ||||
| -rw-r--r-- | src/fpm_strings.f90 | 34 | ||||
| -rw-r--r-- | src/fpm_targets.f90 | 6 |
17 files changed, 221 insertions, 199 deletions
diff --git a/src/fpm.f90 b/src/fpm.f90 index a80f1f6..89eca1a 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 @@ -439,18 +432,17 @@ subroutine cmd_run(settings,test) endif 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 e6226b4..2a32b54 100644 --- a/src/fpm_filesystem.f90 +++ b/src/fpm_filesystem.f90 @@ -1,16 +1,17 @@ !> 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 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 @@ -306,8 +307,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 @@ -344,8 +344,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') @@ -556,13 +555,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 @@ -577,11 +574,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 @@ -601,9 +597,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 @@ -612,16 +606,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_sources.f90 b/src/fpm_sources.f90 index c781535..f349a0e 100644 --- a/src/fpm_sources.f90 +++ b/src/fpm_sources.f90 @@ -1,7 +1,7 @@ !># Discovery of sources !> -!> This module implements subroutines for building a list of -!> `[[srcfile_t]]` objects by looking for source files in the filesystem. +!> This module implements subroutines for building a list of +!> `[[srcfile_t]]` objects by looking for source files in the filesystem. !> module fpm_sources use fpm_error, only: error_t @@ -158,7 +158,7 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error) if (basename(sources(j)%file_name,suffix=.true.) == executables(i)%main .and.& canon_path(dirname(sources(j)%file_name)) == & canon_path(executables(i)%source_dir) ) then - + sources(j)%exe_name = executables(i)%name if (allocated(executables(i)%link)) then sources(j)%link_libraries = executables(i)%link @@ -176,7 +176,7 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error) exe_source%link_libraries = executables(i)%link end if exe_source%unit_scope = scope - + if (allocated(error)) return if (.not.allocated(sources)) then @@ -200,6 +200,11 @@ subroutine get_executable_source_dirs(exe_dirs,executables) integer :: i, n n = 0 + + do i=1,size(executables) + dirs_temp(i)%s=' ' + enddo + do i=1,size(executables) if (.not.(executables(i)%source_dir .in. dirs_temp)) then 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 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 |