Merge pull request #701 from zoziha/package_by_package

Some cleanups and minor fixes

Author: zoziha

src/fpm.f90

@@ -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, &
@@ -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)
@@ -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,'')
@@ -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))

src/fpm/cmd/new.f90

@@ -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

src/fpm/error.f90

@@ -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)

src/fpm_backend_output.f90

@@ -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)
 
@@ -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
@@ -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
 
@@ -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
@@ -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
 

src/fpm_command_line.f90

@@ -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
@@ -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)) :: ]
@@ -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,&
@@ -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
@@ -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
@@ -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)) :: ]
@@ -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, &
@@ -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)) :: ]
@@ -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('&
@@ -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)
@@ -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
 
@@ -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'

src/fpm_environment.f90

@@ -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)
@@ -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)
@@ -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
@@ -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//' '
@@ -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
@@ -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
@@ -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