diff options
| -rw-r--r-- | fpm/src/fpm_command_line.f90 | 2 | ||||
| -rw-r--r-- | fpm/test/help_test/help_test.f90 | 235 |
2 files changed, 236 insertions, 1 deletions
diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index a17f699..b3a232f 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -145,7 +145,7 @@ contains & --list F & & --compiler "'//get_env('FPM_COMPILER','gfortran')//'" & & --verbose F& - & --',help_test,version_text) + & --',help_build,version_text) call check_build_vals() diff --git a/fpm/test/help_test/help_test.f90 b/fpm/test/help_test/help_test.f90 new file mode 100644 index 0000000..13cdb4c --- /dev/null +++ b/fpm/test/help_test/help_test.f90 @@ -0,0 +1,235 @@ +program help_test +use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit +implicit none +integer :: i, j, k +integer :: be, af +character(len=:),allocatable :: path +integer :: estat, cstat +character(len=256) :: message +logical,allocatable :: tally(:) +character(len=1),allocatable :: book1(:), book2(:) +character(len=:),allocatable :: page1(:) +integer :: lines +integer :: chars +! run a variety of "fpm help" variations and verify expected files are generated +character(len=*),parameter :: cmds(*) = [character(len=80) :: & +! build manual as pieces using various help commands +'ffpm --help > fpm_scratch_help.txt',& +'ffpm help new >> fpm_scratch_help.txt',& +'ffpm build --help >> fpm_scratch_help.txt',& +'ffpm help run >> fpm_scratch_help.txt',& +'ffpm help test >> fpm_scratch_help.txt',& +'ffpm help runner >> fpm_scratch_help.txt',& +'ffpm help list >> fpm_scratch_help.txt',& +'ffpm help help >> fpm_scratch_help.txt',& +'ffpm --version >> fpm_scratch_help.txt',& +! generate manual +'ffpm help manual > fpm_scratch_manual.txt'] + +!'ffpm >> fpm_scratch_help.txt',& +!'ffpm --list >> fpm_scratch_help.txt',& +!'ffpm list --list >> fpm_scratch_help.txt',& +character(len=*),parameter :: names(*)=[character(len=10) :: 'fpm','new','build','run','test','runner','list','help'] + + write(*,'(g0:,1x)')'TEST help SUBCOMMAND STARTED' + if(allocated(tally))deallocate(tally) + allocate(tally(0)) + call wipe('fpm_scratch_help.txt') + call wipe('fpm_scratch_manual.txt') + + ! check that output has NAME SYNOPSIS DESCRIPTION + do i=1,size(names) + write(*,*)'check '//names(i)//' for NAME SYNOPSIS DESCRIPTION' + path= 'ffpm help '//names(i)//' >fpm_scratch_help.txt' + 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])] + call swallow('fpm_scratch_help.txt',page1) + if(size(page1).lt.3)then + write(*,*)'<ERROR>help for '//names(i)//' ridiculiously small' + tally=[tally,.false.] + exit + endif + !!write(*,*)findloc(page1,'NAME').eq.1 + be=count(.not.tally) + tally=[tally,merge(.true.,.false.,count(page1.eq.'NAME').eq.1)] + tally=[tally,merge(.true.,.false.,count(page1.eq.'SYNOPSIS').eq.1)] + tally=[tally,merge(.true.,.false.,count(page1.eq.'DESCRIPTION').eq.1)] + af=count(.not.tally) + if(be.ne.af)then + write(*,*)'<ERROR>missing expected sections in ',names(i) + write(*,'(a)')page1 + endif + write(*,*)'have completed ',count(tally),' tests' + call wipe('fpm_scratch_help.txt') + call wipe('fpm_scratch_manual.txt') + enddo + + + ! execute the fpm(1) commands + do i=1,size(cmds) + message='' + path= 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])] + enddo + + ! compare book written in fragments with manual + call slurp('fpm_scratch_help.txt',book1) + call slurp('fpm_scratch_manual.txt',book2) + if(all(book1.ne.book2))then + tally=[tally,.false.] + write(*,*)'manual and appended pages are not the same' + else + write(*,*)'manual and appended pages are the same' + tally=[tally,.true.] + endif + + ! overall size of manual + chars=size(book2) + lines=max(count(char(10).eq.book2),count(char(13).eq.book2)) + if( (chars.lt.13000) .or. (lines.lt.350) )then + write(*,*)'manual is suspiciously small, bytes=',chars,' lines=',lines + tally=[tally,.false.] + else + write(*,*)'manual size is bytes=',chars,' lines=',lines + tally=[tally,.true.] + endif + + write(*,'("HELP TEST TALLY=",*(g0))')tally + if(all(tally))then + write(*,'(*(g0))')'PASSED: all ',count(tally),' tests passed ' + else + write(*,*)'FAILED: PASSED=',count(tally),' FAILED=',count(.not.tally) + stop 5 + endif + call wipe('fpm_scratch_help.txt') + call wipe('fpm_scratch_manual.txt') + write(*,'(g0:,1x)')'TEST help SUBCOMMAND COMPLETE' +contains + +subroutine wipe(filename) +character(len=*),intent(in) :: filename +integer :: ios +integer :: lun +character(len=256) :: message +open(file=filename,newunit=lun,iostat=ios,iomsg=message) +if(ios.eq.0)then + close(unit=lun,iostat=ios,status='delete',iomsg=message) + if(ios.ne.0)then + write(*,*)'<ERROR>'//trim(message) + endif +else + write(*,*)'<ERROR>'//trim(message) +endif +end subroutine wipe + +subroutine slurp(filename,text) +implicit none +!$@(#) M_io::slurp(3f): allocate text array and read file filename into it +character(*),intent(in) :: filename ! filename to shlep +character(len=1),allocatable,intent(out) :: text(:) ! array to hold file +integer :: nchars, igetunit, ios, i, icount +character(len=256) :: message +character(len=4096) :: local_filename + ios=0 + nchars=0 + message='' + 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 + inquire(unit=igetunit, size=nchars) + if(nchars.le.0)then + call stderr_local( '*slurp* empty file '//trim(local_filename) ) + return + endif + ! read file into text array + 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 + call stderr_local( '*slurp* bad read of '//trim(local_filename)//':'//trim(message) ) + endif + else + call stderr_local('*slurp* '//message) + allocate ( text(0) ) ! make enough storage to hold file + endif + close(iostat=ios,unit=igetunit) ! close if opened successfully or not +end subroutine slurp + +subroutine stderr_local(message) +character(len=*) :: message + write(*,'(a)')trim(message) ! write message to standard error +end subroutine stderr_local + +subroutine swallow(FILENAME,pageout) +implicit none +character(len=*),intent(in) :: FILENAME ! file to read +character(len=:),allocatable,intent(out) :: pageout(:) ! page to hold file in memory +character(len=1),allocatable :: text(:) ! array to hold file in memory + + call slurp(FILENAME,text) ! allocate character array and copy file into it + + if(.not.allocated(text))then + write(*,*)'*swallow* failed to load file '//FILENAME + else ! convert array of characters to array of lines + pageout=page(text) + deallocate(text) ! release memory + endif +end subroutine swallow + +function page(array) result (table) + +!$@(#) M_strings::page(3fp): function to copy char array to page of text + +character(len=1),intent(in) :: array(:) +character(len=:),allocatable :: table(:) +integer :: i +integer :: linelength +integer :: length +integer :: lines +integer :: linecount +integer :: position +integer :: sz +!!character(len=1),parameter :: nl=new_line('A') +character(len=1),parameter :: nl=char(10) + lines=0 + linelength=0 + length=0 + sz=size(array) + do i=1,sz + if(array(i).eq.nl)then + linelength=max(linelength,length) + lines=lines+1 + length=0 + else + length=length+1 + endif + enddo + if(sz.gt.0)then + if(array(sz).ne.nl)then + lines=lines+1 + endif + endif + + if(allocated(table))deallocate(table) + allocate(character(len=linelength) :: table(lines)) + table=' ' + + linecount=1 + position=1 + do i=1,sz + if(array(i).eq.nl)then + linecount=linecount+1 + position=1 + elseif(linelength.ne.0)then + table(linecount)(position:position)=array(i) + position=position+1 + endif + enddo +end function page + +end program help_test |