Skip to content

Commit

Permalink
Merge pull request #701 from zoziha/package_by_package
Browse files Browse the repository at this point in the history
Some cleanups and minor fixes
  • Loading branch information
zoziha authored Jul 22, 2022
2 parents 97df4cf + c24ea66 commit 3045817
Show file tree
Hide file tree
Showing 12 changed files with 143 additions and 137 deletions.
12 changes: 6 additions & 6 deletions src/fpm.f90
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
module fpm
use fpm_strings, only: string_t, operator(.in.), glob, join, string_cat, fnv_1a, &
use fpm_strings, only: string_t, operator(.in.), glob, join, string_cat, &
lower, str_ends_with
use fpm_backend, only: build_package
use fpm_command_line, only: fpm_build_settings, fpm_new_settings, &
Expand Down Expand Up @@ -393,14 +393,14 @@ subroutine cmd_run(settings,test)

! Check all names are valid
! or no name and found more than one file
toomany= size(settings%name).eq.0 .and. size(executables).gt.1
toomany= size(settings%name)==0 .and. size(executables)>1
if ( any(.not.found) &
& .or. &
& ( (toomany .and. .not.test) .or. (toomany .and. settings%runner .ne. '') ) &
& ( (toomany .and. .not.test) .or. (toomany .and. settings%runner /= '') ) &
& .and. &
& .not.settings%list) then
line=join(settings%name)
if(line.ne.'.')then ! do not report these special strings
if(line/='.')then ! do not report these special strings
if(any(.not.found))then
write(stderr,'(A)',advance="no")'<ERROR>*cmd_run*:specified names '
do j=1,size(settings%name)
Expand All @@ -416,7 +416,7 @@ subroutine cmd_run(settings,test)

call compact_list_all()

if(line.eq.'.' .or. line.eq.' ')then ! do not report these special strings
if(line=='.' .or. line==' ')then ! do not report these special strings
call fpm_stop(0,'')
else
call fpm_stop(1,'')
Expand All @@ -433,7 +433,7 @@ subroutine cmd_run(settings,test)
allocate(stat(size(executables)))
do i=1,size(executables)
if (exists(executables(i)%s)) then
if(settings%runner .ne. ' ')then
if(settings%runner /= ' ')then
if(.not.allocated(settings%args))then
call run(settings%runner//' '//executables(i)%s, &
echo=settings%verbose, exitstat=stat(i))
Expand Down
2 changes: 1 addition & 1 deletion src/fpm/cmd/new.f90
Original file line number Diff line number Diff line change
Expand Up @@ -573,7 +573,7 @@ subroutine cmd_new(settings)
call create_verified_basic_manifest(join_path(settings%name, 'fpm.toml'))
endif
! assumes git(1) is installed and in path
if(which('git').ne.'')then
if(which('git')/='')then
call run('git init ' // settings%name)
endif
contains
Expand Down
4 changes: 2 additions & 2 deletions src/fpm/error.f90
Original file line number Diff line number Diff line change
Expand Up @@ -166,8 +166,8 @@ subroutine fpm_stop(value,message)
integer, intent(in) :: value
!> Error message
character(len=*), intent(in) :: message
if(message.ne.'')then
if(value.gt.0)then
if(message/='')then
if(value>0)then
write(stderr,'("<ERROR>",a)')trim(message)
else
write(stderr,'("<INFO> ",a)')trim(message)
Expand Down
16 changes: 8 additions & 8 deletions src/fpm_backend_output.f90
Original file line number Diff line number Diff line change
Expand Up @@ -76,7 +76,7 @@ subroutine output_status_compiling(progress, queue_index)

character(:), allocatable :: target_name
character(100) :: output_string
character(100) :: overall_progress
character(7) :: overall_progress

associate(target=>progress%target_queue(queue_index)%ptr)

Expand All @@ -86,12 +86,12 @@ subroutine output_status_compiling(progress, queue_index)
target_name = basename(target%output_file)
end if

write(overall_progress,'(A,I4,A)') '[',100*progress%n_complete/progress%n_target,'%]'
write(overall_progress,'(A,I3,A)') '[',100*progress%n_complete/progress%n_target,'%] '

if (progress%plain_mode) then ! Plain output

!$omp critical
write(*,'(A8,A30)') trim(overall_progress),target_name
write(*,'(A7,A30)') overall_progress,target_name
!$omp end critical

else ! Pretty output
Expand All @@ -100,7 +100,7 @@ subroutine output_status_compiling(progress, queue_index)

call progress%console%write_line(trim(output_string),progress%output_lines(queue_index))

call progress%console%write_line(trim(overall_progress)//'Compiling...',advance=.false.)
call progress%console%write_line(overall_progress//'Compiling...',advance=.false.)

end if

Expand All @@ -119,7 +119,7 @@ subroutine output_status_complete(progress, queue_index, build_stat)

character(:), allocatable :: target_name
character(100) :: output_string
character(100) :: overall_progress
character(7) :: overall_progress

!$omp critical
progress%n_complete = progress%n_complete + 1
Expand All @@ -139,19 +139,19 @@ subroutine output_status_complete(progress, queue_index, build_stat)
write(output_string,'(A,T40,A,A)') target_name,COLOR_RED//'failed.'//COLOR_RESET
end if

write(overall_progress,'(A,I4,A)') '[',100*progress%n_complete/progress%n_target,'%] '
write(overall_progress,'(A,I3,A)') '[',100*progress%n_complete/progress%n_target,'%] '

if (progress%plain_mode) then ! Plain output

!$omp critical
write(*,'(A8,A30,A7)') trim(overall_progress),target_name, 'done.'
write(*,'(A7,A30,A7)') overall_progress,target_name, 'done.'
!$omp end critical

else ! Pretty output

call progress%console%update_line(progress%output_lines(queue_index),trim(output_string))

call progress%console%write_line(trim(overall_progress)//'Compiling...',advance=.false.)
call progress%console%write_line(overall_progress//'Compiling...',advance=.false.)

end if

Expand Down
31 changes: 15 additions & 16 deletions src/fpm_command_line.f90
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@ module fpm_command_line
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, to_fortran_name, is_fortran_name
use fpm_strings, only : lower, split, to_fortran_name, is_fortran_name
use fpm_filesystem, only : basename, canon_path, which, run
use fpm_environment, only : get_command_arguments_quoted
use fpm_error, only : fpm_stop, error_t
Expand Down Expand Up @@ -262,7 +262,7 @@ subroutine get_command_line_settings(cmd_settings)

call check_build_vals()

if( size(unnamed) .gt. 1 )then
if( size(unnamed) > 1 )then
names=unnamed(2:)
else
names=[character(len=len(names)) :: ]
Expand All @@ -282,14 +282,14 @@ subroutine get_command_line_settings(cmd_settings)
! convert special string '..' to equivalent (shorter) '*'
! to allow for a string that does not require shift-key and quoting
do i=1,size(names)
if(names(i).eq.'..')names(i)='*'
if(names(i)=='..')names(i)='*'
enddo

c_compiler = sget('c-compiler')
archiver = sget('archiver')
allocate(fpm_run_settings :: cmd_settings)
val_runner=sget('runner')
if(specified('runner') .and. val_runner.eq.'')val_runner='echo'
if(specified('runner') .and. val_runner=='')val_runner='echo'
cmd_settings=fpm_run_settings(&
& args=remaining,&
& profile=val_profile,&
Expand Down Expand Up @@ -361,7 +361,7 @@ subroutine get_command_line_settings(cmd_settings)
call fpm_stop(2,'only one directory name allowed')
end select
!*! canon_path is not converting ".", etc.
if(name.eq.'.')then
if(name=='.')then
call get_current_directory(name, error)
if (allocated(error)) then
write(stderr, '("[Error]", 1x, a)') error%message
Expand Down Expand Up @@ -414,13 +414,13 @@ subroutine get_command_line_settings(cmd_settings)

case('help','manual')
call set_args(common_args, help_help,version_text)
if(size(unnamed).lt.2)then
if(unnamed(1).eq.'help')then
if(size(unnamed)<2)then
if(unnamed(1)=='help')then
unnamed=[' ', 'fpm']
else
unnamed=manual
endif
elseif(unnamed(2).eq.'manual')then
elseif(unnamed(2)=='manual')then
unnamed=manual
endif
widest=256
Expand Down Expand Up @@ -505,7 +505,7 @@ subroutine get_command_line_settings(cmd_settings)

call check_build_vals()

if( size(unnamed) .gt. 1 )then
if( size(unnamed) > 1 )then
names=unnamed(2:)
else
names=[character(len=len(names)) :: ]
Expand All @@ -519,14 +519,14 @@ subroutine get_command_line_settings(cmd_settings)
! convert special string '..' to equivalent (shorter) '*'
! to allow for a string that does not require shift-key and quoting
do i=1,size(names)
if(names(i).eq.'..')names(i)='*'
if(names(i)=='..')names(i)='*'
enddo

c_compiler = sget('c-compiler')
archiver = sget('archiver')
allocate(fpm_test_settings :: cmd_settings)
val_runner=sget('runner')
if(specified('runner') .and. val_runner.eq.'')val_runner='echo'
if(specified('runner') .and. val_runner=='')val_runner='echo'
cmd_settings=fpm_test_settings(&
& args=remaining, &
& profile=val_profile, &
Expand All @@ -548,7 +548,7 @@ subroutine get_command_line_settings(cmd_settings)
call set_args(common_args // ' --fetch-only F --clean F', &
help_update, version_text)

if( size(unnamed) .gt. 1 )then
if( size(unnamed) > 1 )then
names=unnamed(2:)
else
names=[character(len=len(names)) :: ]
Expand All @@ -575,7 +575,6 @@ subroutine get_command_line_settings(cmd_settings)
case default

if(cmdarg.ne.''.and.which('fpm-'//cmdarg).ne.'')then

call run('fpm-'//trim(cmdarg)//' '// get_command_arguments_quoted(),.false.)
else
call set_args('&
Expand All @@ -586,7 +585,7 @@ subroutine get_command_line_settings(cmd_settings)
help_text=help_usage
if(lget('list'))then
help_text=help_list_dash
elseif(len_trim(cmdarg).eq.0)then
elseif(len_trim(cmdarg)==0)then
write(stdout,'(*(a))')'Fortran Package Manager:'
write(stdout,'(*(a))')' '
call printhelp(help_list_nodash)
Expand All @@ -611,7 +610,7 @@ subroutine check_build_vals()
character(len=:), allocatable :: flags

val_compiler=sget('compiler')
if(val_compiler.eq.'') then
if(val_compiler=='') then
val_compiler='gfortran'
endif

Expand All @@ -627,7 +626,7 @@ subroutine printhelp(lines)
integer :: iii,ii
if(allocated(lines))then
ii=size(lines)
if(ii .gt. 0 .and. len(lines).gt. 0) then
if(ii > 0 .and. len(lines)> 0) then
write(stdout,'(g0)')(trim(lines(iii)), iii=1, ii)
else
write(stdout,'(a)')'<WARNING> *printhelp* output requested is empty'
Expand Down
26 changes: 13 additions & 13 deletions src/fpm_environment.f90
Original file line number Diff line number Diff line change
Expand Up @@ -171,7 +171,7 @@ function get_env(NAME,DEFAULT) result(VALUE)
integer :: length
! get length required to hold value
length=0
if(NAME.ne.'')then
if(NAME/='')then
call get_environment_variable(NAME, length=howbig,status=stat,trim_name=.true.)
select case (stat)
case (1)
Expand All @@ -185,12 +185,12 @@ function get_env(NAME,DEFAULT) result(VALUE)
allocate(character(len=max(howbig,1)) :: VALUE)
! get value
call get_environment_variable(NAME,VALUE,status=stat,trim_name=.true.)
if(stat.ne.0)VALUE=''
if(stat/=0)VALUE=''
end select
else
VALUE=''
endif
if(VALUE.eq.''.and.present(DEFAULT))VALUE=DEFAULT
if(VALUE==''.and.present(DEFAULT))VALUE=DEFAULT
end function get_env

function get_command_arguments_quoted() result(args)
Expand All @@ -200,7 +200,7 @@ function get_command_arguments_quoted() result(args)
integer :: ilength, istatus, i
ilength=0
args=''
quote=merge('"',"'",separator().eq.'\')
quote=merge('"',"'",separator()=='\')
do i=2,command_argument_count() ! look at all arguments after subcommand
call get_command_argument(number=i,length=ilength,status=istatus)
if(istatus /= 0) then
Expand All @@ -213,10 +213,10 @@ function get_command_arguments_quoted() result(args)
if(istatus /= 0) then
write(stderr,'(*(g0,1x))')'<ERROR>*get_command_arguments_stack* error obtaining argument ',i
exit
elseif(ilength.gt.0)then
if(index(arg//' ','-').ne.1)then
elseif(ilength>0)then
if(index(arg//' ','-')/=1)then
args=args//quote//arg//quote//' '
elseif(index(arg,' ').ne.0)then
elseif(index(arg,' ')/=0)then
args=args//quote//arg//quote//' '
else
args=args//arg//' '
Expand Down Expand Up @@ -273,7 +273,7 @@ function separator() result(sep)
character(len=4096) :: name
character(len=:),allocatable :: fname

!*ifort_bug*! if(sep_cache.ne.' ')then ! use cached value. NOTE: A parallel code might theoretically use multiple OS
!*ifort_bug*! if(sep_cache/=' ')then ! use cached value. NOTE: A parallel code might theoretically use multiple OS
!*ifort_bug*! sep=sep_cache
!*ifort_bug*! return
!*ifort_bug*! endif
Expand All @@ -285,18 +285,18 @@ function separator() result(sep)
allocate(character(len=arg0_length) :: arg0)
call get_command_argument(0,arg0,status=istat)
! check argument name
if(index(arg0,'\').ne.0)then
if(index(arg0,'\')/=0)then
sep='\'
elseif(index(arg0,'/').ne.0)then
elseif(index(arg0,'/')/=0)then
sep='/'
else
! try name returned by INQUIRE(3f)
existing=.false.
name=' '
inquire(file=arg0,iostat=istat,exist=existing,name=name)
if(index(name,'\').ne.0)then
if(index(name,'\')/=0)then
sep='\'
elseif(index(name,'/').ne.0)then
elseif(index(name,'/')/=0)then
sep='/'
else
! well, try some common syntax and assume in current directory
Expand All @@ -310,7 +310,7 @@ function separator() result(sep)
if(existing)then
sep='/'
else ! check environment variable PATH
sep=merge('\','/',index(get_env('PATH'),'\').ne.0)
sep=merge('\','/',index(get_env('PATH'),'\')/=0)
!*!write(*,*)'<WARNING>unknown system directory path separator'
endif
endif
Expand Down
Loading

0 comments on commit 3045817

Please sign in to comment.