From e128df54be3c737e56f7fabe03eef24ad68c56d5 Mon Sep 17 00:00:00 2001 From: zoziha Date: Sat, 28 May 2022 01:39:02 +0800 Subject: [PATCH 01/10] Remove unused `fnv_1a` --- src/fpm.f90 | 2 +- src/fpm_command_line.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 932eae2fc7..418f5479f4 100644 --- a/src/fpm.f90 +++ b/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, & diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index f9eb61c376..cbe664ee8f 100644 --- a/src/fpm_command_line.f90 +++ b/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 From 4dbff27993d3f292aa6bb05840e5b36e7dff8846 Mon Sep 17 00:00:00 2001 From: zoziha Date: Sat, 28 May 2022 01:39:07 +0800 Subject: [PATCH 02/10] Update `number_of_rows` --- src/fpm_filesystem.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 66e7d66230..d8da5c3ba2 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -314,11 +314,10 @@ end function join_path integer function number_of_rows(s) result(nrows) integer,intent(in)::s integer :: ios - character(len=100) :: r rewind(s) nrows = 0 do - read(s, '(A)', iostat=ios) r + read(s, *, iostat=ios) if (ios /= 0) exit nrows = nrows + 1 end do From b8439d429ac8b8aca59634dd1d38cb23a0aecc62 Mon Sep 17 00:00:00 2001 From: zoziha Date: Sat, 28 May 2022 01:59:21 +0800 Subject: [PATCH 03/10] Minor update in `mkdir` and `os_delete_dir` --- src/fpm_filesystem.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index d8da5c3ba2..7a0f62af58 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -379,14 +379,14 @@ subroutine mkdir(dir, echo) call execute_command_line('mkdir -p ' // dir, exitstat=stat) if (echo_local) then - write (*, '(" + ",2a)') 'mkdir -p ' // dir + write (*, *) '+ mkdir -p ' // dir end if case (OS_WINDOWS) call execute_command_line("mkdir " // windows_path(dir), exitstat=stat) if (echo_local) then - write (*, '(" + ",2a)') 'mkdir ' // windows_path(dir) + write (*, *) '+ mkdir ' // windows_path(dir) end if end select @@ -946,14 +946,14 @@ subroutine os_delete_dir(unix, dir, echo) call run('rm -rf ' // dir, .false.) if (echo_local) then - write (*, '(" + ",2a)') 'rm -rf ' // dir + write (*, *) '+ rm -rf ' // dir end if else call run('rmdir /s/q ' // dir, .false.) if (echo_local) then - write (*, '(" + ",2a)') 'rmdir /s/q ' // dir + write (*, *) '+ rmdir /s/q ' // dir end if end if From 2d196202328b3d2026631e95d83864a227b827ba Mon Sep 17 00:00:00 2001 From: zoziha Date: Sat, 28 May 2022 02:03:35 +0800 Subject: [PATCH 04/10] `.eq.` -> `==` --- src/fpm.f90 | 4 ++-- src/fpm_command_line.f90 | 18 ++++++++-------- src/fpm_environment.f90 | 4 ++-- src/fpm_filesystem.F90 | 6 +++--- src/fpm_strings.f90 | 16 +++++++-------- test/cli_test/cli_test.f90 | 14 ++++++------- test/fpm_test/test_versioning.f90 | 4 ++-- test/help_test/help_test.f90 | 34 +++++++++++++++---------------- 8 files changed, 50 insertions(+), 50 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 418f5479f4..5ac8274302 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -390,7 +390,7 @@ 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).gt.1 if ( any(.not.found) & & .or. & & ( (toomany .and. .not.test) .or. (toomany .and. settings%runner .ne. '') ) & @@ -413,7 +413,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,'') diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index cbe664ee8f..9933837e97 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -271,14 +271,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,& @@ -348,7 +348,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 @@ -402,12 +402,12 @@ 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(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,14 +505,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, & @@ -570,7 +570,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) @@ -595,7 +595,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 diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index 7926703256..4f46ecec67 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -190,7 +190,7 @@ function get_env(NAME,DEFAULT) result(VALUE) 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 diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 7a0f62af58..65b2994464 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -419,7 +419,7 @@ recursive subroutine list_files(dir, files, recurse) type(string_t) :: files_tmp(N_MAX) integer(kind=c_int) :: r - if (c_is_dir(dir(1:len_trim(dir))//c_null_char) .eq. 0) then + if (c_is_dir(dir(1:len_trim(dir))//c_null_char) == 0) then allocate (files(0)) return end if @@ -440,7 +440,7 @@ recursive subroutine list_files(dir, files, recurse) else string_fortran = f_string(c_get_d_name(dir_entry_c)) - if ((string_fortran .eq. '.' .or. string_fortran .eq. '..')) then + if ((string_fortran == '.' .or. string_fortran == '..')) then cycle end if @@ -827,7 +827,7 @@ function which(command) result(pathname) character(len=:),allocatable :: pathname, checkon, paths(:), exts(:) integer :: i, j pathname='' - call split(get_env('PATH'),paths,delimiters=merge(';',':',separator().eq.'\')) + call split(get_env('PATH'),paths,delimiters=merge(';',':',separator()=='\')) SEARCH: do i=1,size(paths) checkon=trim(join_path(trim(paths(i)),command)) select case(separator()) diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index aceb01a72a..a21d5d441c 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -380,7 +380,7 @@ subroutine split(input_line,array,delimiters,order,nulls) icol=1 ! initialize pointer into input line INFINITE: do i30=1,ilen,1 ! store into each array element ibegin(i30)=icol ! assume start new token on the character - if(index(dlim(1:idlim),input_line(icol:icol)).eq.0)then ! if current character is not a delimiter + if(index(dlim(1:idlim),input_line(icol:icol))==0)then ! if current character is not a delimiter iterm(i30)=ilen ! initially assume no more tokens do i10=1,idlim ! search for next delimiter ifound=index(input_line(ibegin(i30):ilen),dlim(i10:i10)) @@ -574,7 +574,7 @@ pure function join(str,sep,trm,left,right,start,end) result (string) if(present(left))then ; left_local=left ; else ; left_local='' ; endif if(present(right))then ; right_local=right ; else ; right_local='' ; endif string='' - if(size(str).eq.0)then + if(size(str)==0)then string=string//left_local//right_local else do i = 1,size(str)-1 @@ -851,13 +851,13 @@ function glob(tame,wild) do ! Walk the text strings one character at a time. if(wildtext(wi:wi) == '*')then ! How do you match a unique text string? do i=wi,wlen ! Easy: unique up on it! - if(wildtext(wi:wi).eq.'*')then + if(wildtext(wi:wi)=='*')then wi=wi+1 else exit endif enddo - if(wildtext(wi:wi).eq.NULL) then ! "x" matches "*" + if(wildtext(wi:wi)==NULL) then ! "x" matches "*" glob=.true. return endif @@ -865,7 +865,7 @@ function glob(tame,wild) ! Fast-forward to next possible match. do while (tametext(ti:ti) .ne. wildtext(wi:wi)) ti=ti+1 - if (tametext(ti:ti).eq.NULL)then + if (tametext(ti:ti)==NULL)then glob=.false. return ! "x" doesn't match "*y*" endif @@ -900,14 +900,14 @@ function glob(tame,wild) endif ti=ti+1 wi=wi+1 - if (tametext(ti:ti).eq.NULL) then ! How do you match a tame text string? + if (tametext(ti:ti)==NULL) then ! How do you match a tame text string? if(wildtext(wi:wi).ne.NULL)then do while (wildtext(wi:wi) == '*') ! The tame way: unique up on it! wi=wi+1 ! "x" matches "x*" - if(wildtext(wi:wi).eq.NULL)exit + if(wildtext(wi:wi)==NULL)exit enddo endif - if (wildtext(wi:wi).eq.NULL)then + if (wildtext(wi:wi)==NULL)then glob=.true. return ! "x" matches "x" endif diff --git a/test/cli_test/cli_test.f90 b/test/cli_test/cli_test.f90 index 855c7503c7..5195f20384 100644 --- a/test/cli_test/cli_test.f90 +++ b/test/cli_test/cli_test.f90 @@ -78,7 +78,7 @@ program main readme(3)=' /' tally=[logical ::] ! an array that tabulates the command test results as pass or fail. -if(command_argument_count().eq.0)then ! assume if called with no arguments to do the tests. This means you cannot +if(command_argument_count()==0)then ! assume if called with no arguments to do the tests. This means you cannot ! have a test of no parameters. Could improve on this. ! if called with parameters assume this is a test and call the routine to ! parse the resulting values after calling the CLI command line parser @@ -91,7 +91,7 @@ program main write(*,*)'command=',command do i=1,size(tests) - if(tests(i).eq.' ')then + if(tests(i)==' ')then open(file='_test_cli',newunit=lun,delim='quote') close(unit=lun,status='delete') exit @@ -113,8 +113,8 @@ program main write(*,'(*(g0))')'START: TEST ',i,' CMD=',trim(cmd) ! call this program which will crack command line and write results to scratch file _test_cli call execute_command_line(command//' '//trim(cmd),cmdstat=act_cstat,exitstat=act_estat) - if(cstat.eq.act_cstat.and.estat.eq.act_estat)then - if(estat.eq.0)then + if(cstat==act_cstat.and.estat==act_estat)then + if(estat==0)then open(file='_test_cli',newunit=lun,delim='quote') act_name=[(repeat(' ',len(act_name)),i=1,max_names)] act_profile='' @@ -130,12 +130,12 @@ program main close(unit=lun) ! compare results to expected values subtally=[logical ::] - call test_test('NAME',all(act_name.eq.name)) - call test_test('PROFILE',act_profile.eq.profile) + call test_test('NAME',all(act_name==name)) + call test_test('PROFILE',act_profile==profile) call test_test('WITH_EXPECTED',act_w_e.eqv.w_e) call test_test('WITH_TESTED',act_w_t.eqv.w_t) call test_test('WITH_TEST',act_w_t.eqv.w_t) - call test_test('ARGS',act_args.eq.args) + call test_test('ARGS',act_args==args) if(all(subtally))then write(*,'(*(g0))')'PASSED: TEST ',i,' STATUS: expected ',cstat,' ',estat,' actual ',act_cstat,' ',act_estat,& & ' for [',trim(cmd),']' diff --git a/test/fpm_test/test_versioning.f90 b/test/fpm_test/test_versioning.f90 index 6a77d106b4..e87ed7e527 100644 --- a/test/fpm_test/test_versioning.f90 +++ b/test/fpm_test/test_versioning.f90 @@ -74,12 +74,12 @@ subroutine test_valid_equals(error) call new_version(v1, [0, 9, 0]) call new_version(v2, [0, 9]) - if (.not. v1.eq.v2) then + if (.not. v1==v2) then call test_failed(error, "Version comparison failed") return end if - if (.not. v2.eq.v1) then + if (.not. v2==v1) then call test_failed(error, "Version comparison failed") return end if diff --git a/test/help_test/help_test.f90 b/test/help_test/help_test.f90 index 1a032e3fcb..732ad3de50 100644 --- a/test/help_test/help_test.f90 +++ b/test/help_test/help_test.f90 @@ -77,25 +77,25 @@ program help_test message='' call execute_command_line(path,exitstat=estat,cmdstat=cstat,cmdmsg=message) write(*,'(*(g0))')'CMD=',path,' EXITSTAT=',estat,' CMDSTAT=',cstat,' MESSAGE=',trim(message) - tally=[tally,all([estat.eq.0,cstat.eq.0])] + tally=[tally,all([estat==0,cstat==0])] call swallow('fpm_scratch_help.txt',page1) if(size(page1).lt.3)then write(*,*)'help for '//names(i)//' ridiculiously small' tally=[tally,.false.] exit endif - !!write(*,*)findloc(page1,'NAME').eq.1 + !!write(*,*)findloc(page1,'NAME')==1 be=count(.not.tally) - tally=[tally,count(page1.eq.'NAME').eq.1] - tally=[tally,count(page1.eq.'SYNOPSIS').eq.1] - tally=[tally,count(page1.eq.'DESCRIPTION').eq.1] + tally=[tally,count(page1=='NAME')==1] + tally=[tally,count(page1=='SYNOPSIS')==1] + tally=[tally,count(page1=='DESCRIPTION')==1] af=count(.not.tally) if(be.ne.af)then write(*,*)'missing expected sections in ',names(i) write(*,*)page1(1) ! assuming at least size 1 for debugging mingw - write(*,*)count(page1.eq.'NAME') - write(*,*)count(page1.eq.'SYNOPSIS') - write(*,*)count(page1.eq.'DESCRIPTION') + write(*,*)count(page1=='NAME') + write(*,*)count(page1=='SYNOPSIS') + write(*,*)count(page1=='DESCRIPTION') write(*,'(a)')page1 endif write(*,*)'have completed ',count(tally),' tests' @@ -109,15 +109,15 @@ program help_test path= prog // cmds(i) call execute_command_line(path,exitstat=estat,cmdstat=cstat,cmdmsg=message) write(*,'(*(g0))')'CMD=',path,' EXITSTAT=',estat,' CMDSTAT=',cstat,' MESSAGE=',trim(message) - tally=[tally,all([estat.eq.0,cstat.eq.0])] + tally=[tally,all([estat==0,cstat==0])] enddo ! compare book written in fragments with manual call swallow('fpm_scratch_help.txt',book1) call swallow('fpm_scratch_manual.txt',book2) ! get rid of lines from run() which is not on stderr at the moment - book1=pack(book1,index(book1,' + build/').eq.0) - book2=pack(book1,index(book2,' + build/').eq.0) + book1=pack(book1,index(book1,' + build/')==0) + book2=pack(book1,index(book2,' + build/')==0) write(*,*)'book1 ',size(book1), len(book1) write(*,*)'book2 ',size(book2), len(book2) if(size(book1).ne.size(book2))then @@ -135,7 +135,7 @@ program help_test ! overall size of manual !chars=size(book2) - !lines=max(count(char(10).eq.book2),count(char(13).eq.book2)) + !lines=max(count(char(10)==book2),count(char(13)==book2)) chars=sum(len_trim(book2)) ! SUM TRIMMED LENGTH lines=size(book2) if( (chars.lt.12000) .or. (lines.lt.350) )then @@ -164,7 +164,7 @@ subroutine wipe(filename) integer :: lun character(len=k1) :: message open(file=filename,newunit=lun,iostat=ios,iomsg=message) -if(ios.eq.0)then +if(ios==0)then close(unit=lun,iostat=ios,status='delete',iomsg=message) if(ios.ne.0)then write(*,*)''//trim(message) @@ -188,7 +188,7 @@ subroutine slurp(filename,text) open(newunit=igetunit, file=trim(filename), action="read", iomsg=message,& &form="unformatted", access="stream",status='old',iostat=ios) local_filename=filename - if(ios.eq.0)then ! if file was successfully opened + if(ios==0)then ! if file was successfully opened inquire(unit=igetunit, size=nchars) if(nchars.le.0)then call stderr_local( '*slurp* empty file '//trim(local_filename) ) @@ -252,7 +252,7 @@ function page(array) result (table) length=0 sz=size(array) do i=1,sz - if(array(i).eq.nl)then + if(array(i)==nl)then linelength=max(linelength,length) lines=lines+1 length=0 @@ -273,10 +273,10 @@ function page(array) result (table) linecount=1 position=1 do i=1,sz - if(array(i).eq.nl)then + if(array(i)==nl)then linecount=linecount+1 position=1 - elseif(array(i).eq.cr)then + elseif(array(i)==cr)then elseif(linelength.ne.0)then if(position.gt.len(table))then write(*,*)' adding character past edge of text',table(linecount),array(i) From 358a66accb153ad20486c18c30f96a0495400a0d Mon Sep 17 00:00:00 2001 From: zoziha Date: Sat, 28 May 2022 02:04:18 +0800 Subject: [PATCH 05/10] `.ne.` -> `/=` --- src/fpm.f90 | 6 +++--- src/fpm/cmd/new.f90 | 2 +- src/fpm/error.f90 | 2 +- src/fpm_command_line.f90 | 2 +- src/fpm_environment.f90 | 20 ++++++++++---------- src/fpm_filesystem.F90 | 16 ++++++++-------- src/fpm_strings.f90 | 20 ++++++++++---------- test/cli_test/cli_test.f90 | 2 +- test/fpm_test/test_versioning.f90 | 4 ++-- test/help_test/help_test.f90 | 14 +++++++------- test/new_test/new_test.f90 | 2 +- 11 files changed, 45 insertions(+), 45 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 5ac8274302..ac35188057 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -393,11 +393,11 @@ subroutine cmd_run(settings,test) toomany= size(settings%name)==0 .and. size(executables).gt.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")'*cmd_run*:specified names ' do j=1,size(settings%name) @@ -430,7 +430,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)) diff --git a/src/fpm/cmd/new.f90 b/src/fpm/cmd/new.f90 index 739f4e0144..440970edc0 100644 --- a/src/fpm/cmd/new.f90 +++ b/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 diff --git a/src/fpm/error.f90 b/src/fpm/error.f90 index f966996bbd..1772f7cddc 100644 --- a/src/fpm/error.f90 +++ b/src/fpm/error.f90 @@ -166,7 +166,7 @@ subroutine fpm_stop(value,message) integer, intent(in) :: value !> Error message character(len=*), intent(in) :: message - if(message.ne.'')then + if(message/='')then if(value.gt.0)then write(stderr,'("",a)')trim(message) else diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 9933837e97..b2d54d6b38 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -559,7 +559,7 @@ subroutine get_command_line_settings(cmd_settings) case default - if(which('fpm-'//cmdarg).ne.'')then + if(which('fpm-'//cmdarg)/='')then call run('fpm-'//trim(cmdarg)//' '// get_command_arguments_quoted(),.false.) else call set_args('& diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index 4f46ecec67..fb36861bcb 100644 --- a/src/fpm_environment.f90 +++ b/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,7 +185,7 @@ 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='' @@ -214,9 +214,9 @@ function get_command_arguments_quoted() result(args) write(stderr,'(*(g0,1x))')'*get_command_arguments_stack* error obtaining argument ',i exit elseif(ilength.gt.0)then - if(index(arg//' ','-').ne.1)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(*,*)'unknown system directory path separator' endif endif diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 65b2994464..ae19905279 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -457,7 +457,7 @@ recursive subroutine list_files(dir, files, recurse) r = c_closedir(dir_handle) - if (r .ne. 0) then + if (r /= 0) then print *, 'c_closedir() failed' error stop end if @@ -472,7 +472,7 @@ recursive subroutine list_files(dir, files, recurse) allocate(sub_dir_files(0)) do i=1,size(files) - if (c_is_dir(files(i)%s//c_null_char) .ne. 0) then + if (c_is_dir(files(i)%s//c_null_char) /= 0) then call list_files(files(i)%s, dir_files, recurse=.true.) sub_dir_files = [sub_dir_files, dir_files] end if @@ -714,7 +714,7 @@ subroutine fileopen(filename,lun,ier) message=' ' ios=0 - if(filename.ne.' ')then + if(filename/=' ')then open(file=filename, & & newunit=lun, & & form='formatted', & ! FORM = FORMATTED | UNFORMATTED @@ -728,7 +728,7 @@ subroutine fileopen(filename,lun,ier) lun=stdout ios=0 endif - if(ios.ne.0)then + if(ios/=0)then lun=-1 if(present(ier))then ier=ios @@ -745,9 +745,9 @@ subroutine fileclose(lun,ier) integer,intent(out),optional :: ier character(len=256) :: message integer :: ios - if(lun.ne.-1)then + if(lun/=-1)then close(unit=lun,iostat=ios,iomsg=message) - if(ios.ne.0)then + if(ios/=0)then if(present(ier))then ier=ios else @@ -765,12 +765,12 @@ subroutine filewrite(filename,filedata) integer :: lun, i, ios character(len=256) :: message call fileopen(filename,lun) - if(lun.ne.-1)then ! program currently stops on error on open, but might + if(lun/=-1)then ! program currently stops on error on open, but might ! want it to continue so -1 (unallowed LUN) indicates error ! write file do i=1,size(filedata) write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i)) - if(ios.ne.0)then + if(ios/=0)then call fpm_stop(5,'*filewrite*:'//filename//':'//trim(message)) endif enddo diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index a21d5d441c..b99fb98463 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -348,7 +348,7 @@ subroutine split(input_line,array,delimiters,order,nulls) ! decide on value for optional DELIMITERS parameter if (present(delimiters)) then ! optional delimiter list was present - if(delimiters.ne.'')then ! if DELIMITERS was specified and not null use it + if(delimiters/='')then ! if DELIMITERS was specified and not null use it dlim=delimiters else ! DELIMITERS was specified on call as empty string dlim=' '//char(9)//char(10)//char(11)//char(12)//char(13)//char(0) ! use default delimiter when not specified @@ -861,9 +861,9 @@ function glob(tame,wild) glob=.true. return endif - if(wildtext(wi:wi) .ne. '?') then + if(wildtext(wi:wi) /= '?') then ! Fast-forward to next possible match. - do while (tametext(ti:ti) .ne. wildtext(wi:wi)) + do while (tametext(ti:ti) /= wildtext(wi:wi)) ti=ti+1 if (tametext(ti:ti)==NULL)then glob=.false. @@ -873,15 +873,15 @@ function glob(tame,wild) endif wbookmark = wildtext(wi:) tbookmark = tametext(ti:) - elseif(tametext(ti:ti) .ne. wildtext(wi:wi) .and. wildtext(wi:wi) .ne. '?') then + elseif(tametext(ti:ti) /= wildtext(wi:wi) .and. wildtext(wi:wi) /= '?') then ! Got a non-match. If we've set our bookmarks, back up to one or both of them and retry. - if(wbookmark.ne.NULL) then - if(wildtext(wi:).ne. wbookmark) then + if(wbookmark/=NULL) then + if(wildtext(wi:)/= wbookmark) then wildtext = wbookmark; wlen=len_trim(wbookmark) wi=1 ! Don't go this far back again. - if (tametext(ti:ti) .ne. wildtext(wi:wi)) then + if (tametext(ti:ti) /= wildtext(wi:wi)) then tbookmark=tbookmark(2:) tametext = tbookmark ti=1 @@ -890,7 +890,7 @@ function glob(tame,wild) wi=wi+1 endif endif - if (tametext(ti:ti).ne.NULL) then + if (tametext(ti:ti)/=NULL) then ti=ti+1 cycle ! "mississippi" matches "*sip*" endif @@ -901,7 +901,7 @@ function glob(tame,wild) ti=ti+1 wi=wi+1 if (tametext(ti:ti)==NULL) then ! How do you match a tame text string? - if(wildtext(wi:wi).ne.NULL)then + if(wildtext(wi:wi)/=NULL)then do while (wildtext(wi:wi) == '*') ! The tame way: unique up on it! wi=wi+1 ! "x" matches "x*" if(wildtext(wi:wi)==NULL)exit @@ -995,7 +995,7 @@ function is_fortran_name(line) result (lout) character(len=:),allocatable :: name logical :: lout name=trim(line) - if(len(name).ne.0)then + if(len(name)/=0)then lout = .true. & & .and. verify(name(1:1), lower//upper) == 0 & & .and. verify(name,allowed) == 0 & diff --git a/test/cli_test/cli_test.f90 b/test/cli_test/cli_test.f90 index 5195f20384..4fa8e3acf2 100644 --- a/test/cli_test/cli_test.f90 +++ b/test/cli_test/cli_test.f90 @@ -124,7 +124,7 @@ program main act_c_a=.false. act_args=repeat(' ',132) read(lun,nml=act_cli,iostat=ios,iomsg=message) - if(ios.ne.0)then + if(ios/=0)then write(*,'(a)')'ERROR:',trim(message) endif close(unit=lun) diff --git a/test/fpm_test/test_versioning.f90 b/test/fpm_test/test_versioning.f90 index e87ed7e527..0884de73cd 100644 --- a/test/fpm_test/test_versioning.f90 +++ b/test/fpm_test/test_versioning.f90 @@ -136,12 +136,12 @@ subroutine test_valid_notequals(error) call new_version(v1, [0, 9, 1]) call new_version(v2, [0, 9]) - if (.not. v1.ne.v2) then + if (.not. v1/=v2) then call test_failed(error, "Version comparison failed") return end if - if (.not. v2.ne.v1) then + if (.not. v2/=v1) then call test_failed(error, "Version comparison failed") return end if diff --git a/test/help_test/help_test.f90 b/test/help_test/help_test.f90 index 732ad3de50..8ac1322250 100644 --- a/test/help_test/help_test.f90 +++ b/test/help_test/help_test.f90 @@ -90,7 +90,7 @@ program help_test tally=[tally,count(page1=='SYNOPSIS')==1] tally=[tally,count(page1=='DESCRIPTION')==1] af=count(.not.tally) - if(be.ne.af)then + if(be/=af)then write(*,*)'missing expected sections in ',names(i) write(*,*)page1(1) ! assuming at least size 1 for debugging mingw write(*,*)count(page1=='NAME') @@ -120,11 +120,11 @@ program help_test book2=pack(book1,index(book2,' + build/')==0) write(*,*)'book1 ',size(book1), len(book1) write(*,*)'book2 ',size(book2), len(book2) - if(size(book1).ne.size(book2))then + if(size(book1)/=size(book2))then write(*,*)'manual and "debug" appended pages are not the same size' tally=[tally,.false.] else - if(all(book1.ne.book2))then + if(all(book1/=book2))then tally=[tally,.false.] write(*,*)'manual and "debug" appended pages are not the same' else @@ -166,7 +166,7 @@ subroutine wipe(filename) open(file=filename,newunit=lun,iostat=ios,iomsg=message) if(ios==0)then close(unit=lun,iostat=ios,status='delete',iomsg=message) - if(ios.ne.0)then + if(ios/=0)then write(*,*)''//trim(message) endif else @@ -198,7 +198,7 @@ subroutine slurp(filename,text) if(allocated(text))deallocate(text) ! make sure text array not allocated allocate ( text(nchars) ) ! make enough storage to hold file read(igetunit,iostat=ios,iomsg=message) text ! load input file -> text array - if(ios.ne.0)then + if(ios/=0)then call stderr_local( '*slurp* bad read of '//trim(local_filename)//':'//trim(message) ) endif else @@ -261,7 +261,7 @@ function page(array) result (table) endif enddo if(sz.gt.0)then - if(array(sz).ne.nl)then + if(array(sz)/=nl)then lines=lines+1 endif endif @@ -277,7 +277,7 @@ function page(array) result (table) linecount=linecount+1 position=1 elseif(array(i)==cr)then - elseif(linelength.ne.0)then + elseif(linelength/=0)then if(position.gt.len(table))then write(*,*)' adding character past edge of text',table(linecount),array(i) elseif(linecount.gt.size(table))then diff --git a/test/new_test/new_test.f90 b/test/new_test/new_test.f90 index c234eecdd7..1dd0637a0c 100644 --- a/test/new_test/new_test.f90 +++ b/test/new_test/new_test.f90 @@ -123,7 +123,7 @@ program new_test !! Warning: This only looks for expected files. If there are more files than expected it does not fail call list_files(trim(directories(i)), file_names,recurse=.true.) - if(size(expected).ne.size(file_names))then + if(size(expected)/=size(file_names))then write(*,*)'WARNING: unexpected number of files in file list=',size(file_names),' expected ',size(expected) write(*,'("EXPECTED: ",*(g0:,","))')(scr//trim(expected(j)),j=1,size(expected)) write(*,'("FOUND: ",*(g0:,","))')(trim(file_names(j)%s),j=1,size(file_names)) From 72465f48bc516a9a0cf9f97b9845e45f7577d599 Mon Sep 17 00:00:00 2001 From: zoziha Date: Sat, 28 May 2022 02:05:03 +0800 Subject: [PATCH 06/10] `.gt.` -> `>` --- src/fpm.f90 | 2 +- src/fpm/error.f90 | 2 +- src/fpm_command_line.f90 | 8 ++++---- src/fpm_environment.f90 | 2 +- src/fpm_filesystem.F90 | 6 +++--- src/fpm_strings.f90 | 4 ++-- test/fpm_test/test_versioning.f90 | 2 +- test/help_test/help_test.f90 | 6 +++--- 8 files changed, 16 insertions(+), 16 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index ac35188057..2d6a18781e 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -390,7 +390,7 @@ subroutine cmd_run(settings,test) ! Check all names are valid ! or no name and found more than one file - toomany= size(settings%name)==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 /= '') ) & diff --git a/src/fpm/error.f90 b/src/fpm/error.f90 index 1772f7cddc..59cf5d4a99 100644 --- a/src/fpm/error.f90 +++ b/src/fpm/error.f90 @@ -167,7 +167,7 @@ subroutine fpm_stop(value,message) !> Error message character(len=*), intent(in) :: message if(message/='')then - if(value.gt.0)then + if(value>0)then write(stderr,'("",a)')trim(message) else write(stderr,'(" ",a)')trim(message) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index b2d54d6b38..965bf298e2 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -251,7 +251,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)) :: ] @@ -491,7 +491,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)) :: ] @@ -533,7 +533,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)) :: ] @@ -611,7 +611,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)')' *printhelp* output requested is empty' diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index fb36861bcb..714af6a6ad 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -213,7 +213,7 @@ function get_command_arguments_quoted() result(args) if(istatus /= 0) then write(stderr,'(*(g0,1x))')'*get_command_arguments_stack* error obtaining argument ',i exit - elseif(ilength.gt.0)then + elseif(ilength>0)then if(index(arg//' ','-')/=1)then args=args//quote//arg//quote//' ' elseif(index(arg,' ')/=0)then diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index ae19905279..e1fb9ff75d 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -97,7 +97,7 @@ function basename(path,suffix) result (base) end if call split(path,file_parts,delimiters='\/') - if(size(file_parts).gt.0)then + if(size(file_parts)>0)then base = trim(file_parts(size(file_parts))) else base = '' @@ -446,7 +446,7 @@ recursive subroutine list_files(dir, files, recurse) i = i + 1 - if (i .gt. N_MAX) then + if (i > N_MAX) then files = [files, files_tmp] i = 1 end if @@ -462,7 +462,7 @@ recursive subroutine list_files(dir, files, recurse) error stop end if - if (i .gt. 0) then + if (i > 0) then files = [files, files_tmp(1:i)] end if diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index b99fb98463..f3eb9dcb48 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -384,7 +384,7 @@ subroutine split(input_line,array,delimiters,order,nulls) iterm(i30)=ilen ! initially assume no more tokens do i10=1,idlim ! search for next delimiter ifound=index(input_line(ibegin(i30):ilen),dlim(i10:i10)) - IF(ifound.gt.0)then + IF(ifound>0)then iterm(i30)=min(iterm(i30),ifound+ibegin(i30)-2) endif enddo @@ -396,7 +396,7 @@ subroutine split(input_line,array,delimiters,order,nulls) endif imax=max(imax,iterm(i30)-ibegin(i30)+1) icount=i30 ! increment count of number of tokens found - if(icol.gt.ilen)then ! no text left + if(icol>ilen)then ! no text left exit INFINITE endif enddo INFINITE diff --git a/test/fpm_test/test_versioning.f90 b/test/fpm_test/test_versioning.f90 index 0884de73cd..3cc0b269b7 100644 --- a/test/fpm_test/test_versioning.f90 +++ b/test/fpm_test/test_versioning.f90 @@ -208,7 +208,7 @@ subroutine test_valid_compare(error) call new_version(v1, [1, 0, 8]) call new_version(v2, [1, 0]) - if (.not. v1 .gt. v2) then + if (.not. v1 > v2) then call test_failed(error, "Version comparison failed (gt)") return end if diff --git a/test/help_test/help_test.f90 b/test/help_test/help_test.f90 index 8ac1322250..9bed192efc 100644 --- a/test/help_test/help_test.f90 +++ b/test/help_test/help_test.f90 @@ -260,7 +260,7 @@ function page(array) result (table) length=length+1 endif enddo - if(sz.gt.0)then + if(sz>0)then if(array(sz)/=nl)then lines=lines+1 endif @@ -278,9 +278,9 @@ function page(array) result (table) position=1 elseif(array(i)==cr)then elseif(linelength/=0)then - if(position.gt.len(table))then + if(position>len(table))then write(*,*)' adding character past edge of text',table(linecount),array(i) - elseif(linecount.gt.size(table))then + elseif(linecount>size(table))then write(*,*)' adding line past end of text',linecount,size(table) else table(linecount)(position:position)=array(i) From 6c51ebb5d844b9e7ff070b4b629ed2d5d973d8b2 Mon Sep 17 00:00:00 2001 From: zoziha Date: Sat, 28 May 2022 02:05:45 +0800 Subject: [PATCH 07/10] `.lt.` -> `<` --- src/fpm_command_line.f90 | 2 +- src/fpm_strings.f90 | 2 +- test/fpm_test/test_versioning.f90 | 2 +- test/help_test/help_test.f90 | 4 ++-- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 965bf298e2..06e0bc1f6b 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -401,7 +401,7 @@ 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(size(unnamed)<2)then if(unnamed(1)=='help')then unnamed=[' ', 'fpm'] else diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index f3eb9dcb48..0bb764f019 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -418,7 +418,7 @@ subroutine split(input_line,array,delimiters,order,nulls) end select do i20=1,icount ! fill the array with the tokens that were found - if(iterm(i20).lt.ibegin(i20))then + if(iterm(i20)CMD=',path,' EXITSTAT=',estat,' CMDSTAT=',cstat,' MESSAGE=',trim(message) tally=[tally,all([estat==0,cstat==0])] call swallow('fpm_scratch_help.txt',page1) - if(size(page1).lt.3)then + if(size(page1)<3)then write(*,*)'help for '//names(i)//' ridiculiously small' tally=[tally,.false.] exit @@ -138,7 +138,7 @@ program help_test !lines=max(count(char(10)==book2),count(char(13)==book2)) chars=sum(len_trim(book2)) ! SUM TRIMMED LENGTH lines=size(book2) - if( (chars.lt.12000) .or. (lines.lt.350) )then + if( (chars<12000) .or. (lines<350) )then write(*,*)'"debug" manual is suspiciously small, bytes=',chars,' lines=',lines tally=[tally,.false.] else From eacc1683a5eda9e98c0fc51d18db75bc80596717 Mon Sep 17 00:00:00 2001 From: zoziha Date: Sat, 28 May 2022 02:06:50 +0800 Subject: [PATCH 08/10] `.le.` -> `<=`; `.ge.` -> `>=` --- src/fpm_filesystem.F90 | 2 +- test/fpm_test/test_versioning.f90 | 4 ++-- test/help_test/help_test.f90 | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index e1fb9ff75d..885ae98de6 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -104,7 +104,7 @@ function basename(path,suffix) result (base) endif if(.not.with_suffix)then call split(base,file_parts,delimiters='.') - if(size(file_parts).ge.2)then + if(size(file_parts)>=2)then base = trim(file_parts(size(file_parts)-1)) endif endif diff --git a/test/fpm_test/test_versioning.f90 b/test/fpm_test/test_versioning.f90 index 66be74ca9d..b309d1382c 100644 --- a/test/fpm_test/test_versioning.f90 +++ b/test/fpm_test/test_versioning.f90 @@ -213,7 +213,7 @@ subroutine test_valid_compare(error) return end if - if (.not. v1 .ge. v2) then + if (.not. v1 >= v2) then call test_failed(error, "Version comparison failed (ge)") return end if @@ -223,7 +223,7 @@ subroutine test_valid_compare(error) return end if - if (.not. v2 .le. v1) then + if (.not. v2 <= v1) then call test_failed(error, "Version comparison failed (le)") return end if diff --git a/test/help_test/help_test.f90 b/test/help_test/help_test.f90 index 5e9cd55866..8e23e7c06b 100644 --- a/test/help_test/help_test.f90 +++ b/test/help_test/help_test.f90 @@ -190,7 +190,7 @@ subroutine slurp(filename,text) local_filename=filename if(ios==0)then ! if file was successfully opened inquire(unit=igetunit, size=nchars) - if(nchars.le.0)then + if(nchars<=0)then call stderr_local( '*slurp* empty file '//trim(local_filename) ) return endif From e4bdc04fa74fa153a15cba622085c95e45b50b1f Mon Sep 17 00:00:00 2001 From: zoziha Date: Sat, 28 May 2022 19:48:44 +0800 Subject: [PATCH 09/10] Fix `overall_progress` in `fpm_backend_output` --- src/fpm_backend_output.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/fpm_backend_output.f90 b/src/fpm_backend_output.f90 index 3f297f71f5..9b4e6bdd46 100644 --- a/src/fpm_backend_output.f90 +++ b/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 From 5253412d360ff9edb6fe2fb0d37444bf178ee886 Mon Sep 17 00:00:00 2001 From: zoziha Date: Sat, 28 May 2022 20:15:25 +0800 Subject: [PATCH 10/10] Fix new_test: The wildcard command line usage on Windows to delete folders does not take effect in the actual test. --- test/new_test/new_test.f90 | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/test/new_test/new_test.f90 b/test/new_test/new_test.f90 index 1dd0637a0c..edf2975613 100644 --- a/test/new_test/new_test.f90 +++ b/test/new_test/new_test.f90 @@ -57,7 +57,10 @@ program new_test case (OS_WINDOWS) path=windows_path(cmdpath) is_os_windows=.true. - call execute_command_line('rmdir fpm_scratch_* /s /q',exitstat=estat,cmdstat=cstat,cmdmsg=message) + do i=1,size(directories) + call execute_command_line('rmdir /s /q fpm_scratch_'//trim(shortdirs(i)),exitstat=estat,& + cmdstat=cstat,cmdmsg=message) + end do case default write(*,*)'ERROR: unknown OS. Stopping test' stop 2 @@ -150,7 +153,12 @@ program new_test case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD) rm_command = 'rm -rf ' // dirs_to_be_removed case (OS_WINDOWS) - rm_command = 'rmdir ' // dirs_to_be_removed // ' /s /q' + do i=1,size(directories) + rm_command = 'rmdir /s /q fpm_scratch_'//trim(shortdirs(i)) + call execute_command_line('rmdir /s /q fpm_scratch_'//trim(shortdirs(i)),exitstat=estat,& + cmdstat=cstat,cmdmsg=message) + end do + rm_command = 'rmdir /s /q name-with-hyphens' end select call execute_command_line(rm_command, exitstat=estat,cmdstat=cstat,cmdmsg=message)