diff options
author | John S. Urban <urbanjost@comcast.net> | 2021-07-11 16:11:39 -0400 |
---|---|---|
committer | John S. Urban <urbanjost@comcast.net> | 2021-07-11 16:11:39 -0400 |
commit | cca5f83be11f40dd2be86671f8ec14a429540cc9 (patch) | |
tree | ebffeeddffd608f82db70d8683ca68ef22688d67 /src | |
parent | f452d20faec8827347f5e6783cb8dfa325c1c301 (diff) | |
download | fpm-cca5f83be11f40dd2be86671f8ec14a429540cc9.tar.gz fpm-cca5f83be11f40dd2be86671f8ec14a429540cc9.zip |
all stops via fpm_stop(1)
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 | 3 | ||||
-rw-r--r-- | src/fpm/cmd/update.f90 | 5 | ||||
-rw-r--r-- | src/fpm/error.f90 | 20 | ||||
-rw-r--r-- | src/fpm_backend.f90 | 9 | ||||
-rw-r--r-- | src/fpm_command_line.f90 | 3 | ||||
-rw-r--r-- | src/fpm_filesystem.f90 | 18 | ||||
-rw-r--r-- | src/fpm_targets.f90 | 2 |
9 files changed, 57 insertions, 48 deletions
diff --git a/src/fpm.f90 b/src/fpm.f90 index bc6741d..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 - 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 - 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 - 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 - 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 - 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 - 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 a33ff27..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 - 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 59306d9..81cf62f 100644 --- a/src/fpm/cmd/new.f90 +++ b/src/fpm/cmd/new.f90 @@ -58,6 +58,7 @@ use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS use fpm_filesystem, only : join_path, exists, basename, mkdir, is_dir use fpm_filesystem, only : fileopen, fileclose, filewrite, warnwrite 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 8a47592..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 - 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 89d1383..f966996 100644 --- a/src/fpm/error.f90 +++ b/src/fpm/error.f90 @@ -1,5 +1,6 @@ !> 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 @@ -8,6 +9,7 @@ module fpm_error 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 @@ -155,5 +157,23 @@ contains 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_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 d119443..3146c56 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -138,7 +138,8 @@ 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', & + & 'PR: 511', & & 'Program: fpm(1)', & & 'Description: A Fortran package manager and build system', & & 'Home Page: https://github.com/fortran-lang/fpm', & diff --git a/src/fpm_filesystem.f90 b/src/fpm_filesystem.f90 index 8f61f96..2a32b54 100644 --- a/src/fpm_filesystem.f90 +++ b/src/fpm_filesystem.f90 @@ -1,12 +1,13 @@ !> 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, & @@ -306,7 +307,7 @@ subroutine mkdir(dir) end select if (stat /= 0) then - stop 'execute_command_line() failed' + call fpm_stop(1, '*mkdir*:directory creation failed') end if end subroutine mkdir @@ -343,7 +344,7 @@ recursive subroutine list_files(dir, files, recurse) end select if (stat /= 0) then - stop 'execute_command_line() failed' + call fpm_stop(2,'*list_files*:directory listing failed') end if open (newunit=fh, file=temp_file, status='old') @@ -554,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 @@ -575,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 @@ -599,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 diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index c247232..cf368ab 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -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 |