From 6de6ed2c8e1056dee33ee562dd69f3a965ffe215 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Fri, 27 Nov 2020 08:21:38 -0500 Subject: The `run`, `test`, and `build` Fortran fpm(1) command has a new switch added called *--fc* that sets the Fortran compiler name. + The default compiler name to use is taken from the value of the environment variable FPM_FC. + If not set, the environment variable FC is used. + If it is not set the name _gfortran_ is used. + The value specified on the command line overrides any default. FC is apparently a commonly used environment variable for the compiler, is short, and allows for specifying compilers for other languages like C (ie. `-cc gcc`) That is part of the reasons to use `--fc` instead of `--compiler`. Since there is a chance the currently set value of FC may be used by other applications being used, and to allow for a temporary change of the default the fpm-specific variable FPM_FC is supported in addition to FC and has higher precedence. However, since the Haskell version has a similar switch called **--compiler** that name is an alias for **-fc**. A skeleton was started for standard debug and release builds that allows for compilers other than **gfortran**. I now have access to **ifort** and **nvfortran** and it works with at least simple cases for those compilers. Looking for someone with access to other compilers to help flesh that out. The list of executables to run with the `run` and `test` subcommands can now be prefixed with **--target**, as with the Haskell version of ffpm(1). So default usage is unchanged from the previous version. By simply setting FC or FPM_FC you can use it like the previous version with other compilers for default debug and release builds. How does that sound? wget http://www.urbanjost.altervista.org/REMOVE/ffpm.f90 gfortran ffpm.f90 -o $HOME/.local/bin/ffpm ``` # get a test package or use your own if [ ! -d M_CLI2 ] then git clone https://github.com/urbanjost/M_CLI2 fi cd M_CLI2 # default build using ifort ffpm build --fc ifort export FPM_FC=ifort ffpm run ffpm test --- fpm/fpm.toml | 2 +- fpm/src/fpm.f90 | 228 +++++++++++++++++++++++++++++++++---- fpm/src/fpm/error.f90 | 8 +- fpm/src/fpm/git.f90 | 4 +- fpm/src/fpm/manifest/package.f90 | 4 +- fpm/src/fpm_backend.f90 | 18 +-- fpm/src/fpm_command_line.f90 | 240 +++++++++++++++++++++++++++++++-------- fpm/src/fpm_environment.f90 | 34 ++++++ fpm/src/fpm_filesystem.f90 | 44 ++++--- fpm/src/fpm_model.f90 | 2 +- fpm/src/fpm_sources.f90 | 24 ++-- fpm/src/fpm_strings.f90 | 8 +- fpm/src/fpm_targets.f90 | 32 +++--- fpm/test/cli_test/cli_test.f90 | 30 ++--- 14 files changed, 524 insertions(+), 154 deletions(-) diff --git a/fpm/fpm.toml b/fpm/fpm.toml index 7afc0a0..fa91f2f 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -12,7 +12,7 @@ tag = "v0.2.1" [dependencies.M_CLI2] git = "https://github.com/urbanjost/M_CLI2.git" -rev = "893cac0ce374bf07a70ffb9556439c7390e58131" +rev = "598e44164eee383b8a0775aa75b7d1bb100481c3" [[test]] name = "cli-test" diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 5e190c8..07bf483 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -25,7 +25,6 @@ public :: cmd_build, cmd_install, cmd_run contains - recursive subroutine add_libsources_from_package(sources,link_libraries,package_list,package, & package_root,dev_depends,error) ! Discover library sources in a package, recursively including dependencies @@ -152,9 +151,15 @@ subroutine build_model(model, settings, package, error) type(fpm_build_settings), intent(in) :: settings type(package_config_t), intent(in) :: package type(error_t), allocatable, intent(out) :: error + type(string_t), allocatable :: package_list(:) integer :: i - type(string_t), allocatable :: package_list(:) + character(len=:),allocatable :: module_path_switch + + if(settings%verbose)then + write(*,*)'BUILD_NAME:',settings%build_name + write(*,*)'COMPILER: ',settings%compiler + endif model%package_name = package%name if (allocated(package%build%link)) then @@ -166,25 +171,206 @@ subroutine build_model(model, settings, package, error) allocate(package_list(1)) package_list(1)%s = package%name - ! #TODO: Choose flags and output directory based on cli settings & manifest inputs - model%fortran_compiler = 'gfortran' - - if(settings%release)then - model%output_directory = 'build/gfortran_release' - model%fortran_compile_flags=' & - & -O3 & - & -Wimplicit-interface & - & -fPIC & - & -fmax-errors=1 & - & -ffast-math & - & -funroll-loops ' // & - & '-J'//join_path(model%output_directory,model%package_name) - else - model%output_directory = 'build/gfortran_debug' - model%fortran_compile_flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g '// & - '-fbounds-check -fcheck-array-temporaries -fbacktrace '// & - '-J'//join_path(model%output_directory,model%package_name) - endif + model%fortran_compiler=settings%compiler + + model%output_directory = join_path('build',model%fortran_compiler//'_'//settings%build_name) + + if(settings%compiler.eq.'')then + model%fortran_compiler = 'gfortran' + else + model%fortran_compiler = settings%compiler + endif + +! #TODO: Choose flags and output directory based on cli settings & manifest inputs +! special reserved names "debug" and "release" are for supported compilers with no user-specified compile or load flags + +! vendor Fortran C Module output Module include OpenMP Free for OSS +! compiler compiler directory directory +! Gnu gfortran gcc -J -I -fopenmp X +! Intel ifort icc -module -I -qopenmp X +! Intel(Windows) ifort icc /module:path /I /Qopenmp X +! Intel oneAPI ifx icx -module -I -qopenmp X +! PGI pgfortran pgcc -module -I -mp X +! NVIDIA nvfortran nvc -module -I -mp X +! LLVM flang flang clang -module -I -mp X +! LFortran lfortran --- ? ? ? X +! Lahey/Futjitsu lfc ? -M -I -openmp ? +! NAG nagfor ? -mdir -I -openmp x +! Cray crayftn craycc -J -I -homp ? +! IBM xlf90 ? -qmoddir -I -qsmp X +! Oracle/Sun ? ? -moddir= -M -xopenmp ? +! Silverfrost FTN95 ftn95 ? ? /MOD_PATH ? ? +! Elbrus ? lcc -J -I -fopenmp ? +! Hewlett Packard ? ? ? ? ? discontinued +! Watcom ? ? ? ? ? discontinued +! PathScale ? ? -module -I -mp discontinued +! G95 ? ? -fmod= -I -fopenmp discontinued +! Open64 ? ? -module -I -mp discontinued +! Unisys ? ? ? ? ? discontinued + + select case(settings%build_name//'_'//settings%compiler) + + case('release_gfortran') ! -J + model%fortran_compile_flags=' & + & -O3& + & -Wimplicit-interface& + & -fPIC& + & -fmax-errors=1& + & -ffast-math& + & -funroll-loops& + & ' + case('debug_gfortran') + model%fortran_compile_flags = '& + & -Wall & + & -Wextra & + &-Wimplicit-interface & + &-fPIC -fmax-errors=1 & + &-g & + &-fbounds-check & + &-fcheck-array-temporaries & + &-fbacktrace ' + + case('release_f95') ! -J + model%fortran_compile_flags=' & + & -O3& + & -Wimplicit-interface& + & -fPIC& + & -std=f95 & + & -fmax-errors=1& + & -ffast-math& + & -funroll-loops& + & ' + case('debug_f95') + model%fortran_compile_flags = '& + & -Wall & + & -Wextra & + &-Wimplicit-interface & + &-fPIC -fmax-errors=1 & + &-g & + &-std=f95 & + &-fbounds-check & + &-fcheck-array-temporaries & + &-fbacktrace ' + + case('release_gnu') ! -J + model%fortran_compile_flags=' & + & -O3& + & -Wimplicit-interface& + & -fPIC& + & -fmax-errors=1& + & -ffast-math& + & -funroll-loops& + & -std=f2018 & + & -Wno-maybe-uninitialized -Wno-uninitialized & + & ' + model%fortran_compiler = 'gfortran' + case('debug_gnu') + model%fortran_compile_flags = '& + & -Wall & + & -Wextra & + & -Wimplicit-interface & + & -fPIC -fmax-errors=1 & + & -g & + & -fbounds-check & + & -fcheck-array-temporaries & + & -std=f2018 & + & -Wno-maybe-uninitialized -Wno-uninitialized & + & -fbacktrace ' + model%fortran_compiler = 'gfortran' + + case('release_nvfortran') + model%fortran_compile_flags = ' & + & -Mbackslash& + & ' + case('debug_nvfortran') + model%fortran_compile_flags = '& + & -Minform=inform & + & -Mbackslash & + & -traceback& + & ' + + case('release_ifort') + model%fortran_compile_flags = ' & + & -fp-model precise & + & -pc 64 & + & -align all & + & -error-limit 1 & + & -reentrancy threaded & + & -nogen-interfaces & + & -assume byterecl & + & -assume nounderscore' + case('debug_ifort') + model%fortran_compile_flags = '& + & -warn all & + & -check all & + & -error-limit 1 & + & -O0 & + & -g & + & -assume byterecl & + & -traceback ' + case('release_ifx') + model%fortran_compile_flags = ' ' + case('debug_ifx') + model%fortran_compile_flags = ' ' + + case('release_pgfortran','release_pgf90','release_pgf95') ! Portland Group F90/F95 compilers + model%fortran_compile_flags = ' ' + case('debug_pgfortran','debug_pgf90','debug_pgf95') ! Portland Group F90/F95 compilers + model%fortran_compile_flags = ' ' + + case('release_flang') + model%fortran_compile_flags = ' ' + case('debug_flang') + model%fortran_compile_flags = ' ' + + case('release_lfc') + model%fortran_compile_flags = ' ' + case('debug_lfc') + model%fortran_compile_flags = ' ' + + case('release_nagfor') + model%fortran_compile_flags = ' ' + case('debug_nagfor') + model%fortran_compile_flags = ' ' + + case('release_crayftn') + model%fortran_compile_flags = ' ' + case('debug_crayftn') + model%fortran_compile_flags = ' ' + + case('release_xlf90') + model%fortran_compile_flags = ' ' + case('debug_xlf90') + model%fortran_compile_flags = ' ' + + case default + model%fortran_compile_flags = ' ' + write(*,*)' unknown compiler (',settings%compiler,')' + write(*,*)' and build name (',settings%build_name,')' + write(*,*)' combination.' + write(*,*)' known compilers are gfortran, nvfortran, ifort' + end select + + select case(settings%compiler) + case('gfortran') ; module_path_switch=' -J ' + case('gnu') ; module_path_switch=' -J ' + case('nvfortran') ; module_path_switch=' -module ' + case('ifort') ; module_path_switch=' -module ' + case('ifx') ; module_path_switch=' -module ' + case('pgfortran') ; module_path_switch=' -module ' + case('flang') ; module_path_switch=' -module ' + case('lfc') ; module_path_switch=' -M ' + case('crayftn') ; module_path_switch=' -J ' + case('nagfor') ; module_path_switch=' -mdir ' + case('xlf90') ; module_path_switch=' -qmoddir ' + case default + module_path_switch=' -module ' + write(*,*)'UNKNOWN COMPILER NAME ',settings%compiler + end select + + model%fortran_compile_flags = model%fortran_compile_flags//' '//& + & module_path_switch//join_path(model%output_directory,model%package_name) + model%link_flags = '' ! Add sources from executable directories diff --git a/fpm/src/fpm/error.f90 b/fpm/src/fpm/error.f90 index e69ff1e..2cfd964 100644 --- a/fpm/src/fpm/error.f90 +++ b/fpm/src/fpm/error.f90 @@ -82,9 +82,9 @@ contains allocate(error) error%message = 'Parse error: '//message//new_line('a') - + error%message = error%message//file_name - + if (present(line_num)) then write(temp_string,'(I0)') line_num @@ -115,9 +115,9 @@ contains error%message = error%message//new_line('a') error%message = error%message//' | '//repeat(' ',line_col-1)//'^' - + end if - + end if end if diff --git a/fpm/src/fpm/git.f90 b/fpm/src/fpm/git.f90 index 187b551..af4ae22 100644 --- a/fpm/src/fpm/git.f90 +++ b/fpm/src/fpm/git.f90 @@ -138,7 +138,7 @@ contains !> Error type(error_t), allocatable, intent(out) :: error - + !> git object ref character(:), allocatable :: object @@ -173,7 +173,7 @@ contains return end if - end subroutine checkout + end subroutine checkout !> Show information on git target diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90 index 64b0f82..7f2f91e 100644 --- a/fpm/src/fpm/manifest/package.f90 +++ b/fpm/src/fpm/manifest/package.f90 @@ -115,10 +115,10 @@ contains call new_build_config(self%build, child, error) if (allocated(error)) return - + call get_value(table, "version", version, "0") call new_version(self%version, version, error) - + if (allocated(error)) return call get_value(table, "dependencies", child, requested=.false.) diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 3cb95d7..632da64 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -8,7 +8,7 @@ use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM, & FPM_SCOPE_TEST, FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE - + use fpm_strings, only: split implicit none @@ -41,9 +41,9 @@ subroutine build_package(model) linking = linking//" "//model%link_flags do i=1,size(model%targets) - + call build_target(model,model%targets(i)%ptr,linking) - + end do end subroutine build_package @@ -52,7 +52,7 @@ end subroutine build_package recursive subroutine build_target(model,target,linking) ! Compile Fortran source, called recursively on it dependents - ! + ! type(fpm_model_t), intent(in) :: model type(build_target_t), intent(inout) :: target character(:), allocatable, intent(in) :: linking @@ -89,10 +89,10 @@ recursive subroutine build_target(model,target,linking) target%dependencies(i)%ptr%target_type == FPM_TARGET_OBJECT) then exe_obj => target%dependencies(i)%ptr - + ! Construct object list for executable objs = " "//exe_obj%output_file - + ! Include non-library object dependencies do j=1,size(exe_obj%dependencies) @@ -107,7 +107,7 @@ recursive subroutine build_target(model,target,linking) end if end do - + if (.not.exists(dirname(target%output_file))) then call mkdir(dirname(target%output_file)) end if @@ -115,7 +115,7 @@ recursive subroutine build_target(model,target,linking) select case(target%target_type) case (FPM_TARGET_OBJECT) - call run("gfortran -c " // target%source%file_name // model%fortran_compile_flags & + call run(model%fortran_compiler//" -c " // target%source%file_name // model%fortran_compile_flags & // " -o " // target%output_file) case (FPM_TARGET_EXECUTABLE) @@ -126,7 +126,7 @@ recursive subroutine build_target(model,target,linking) end do end if - call run("gfortran " // objs // model%fortran_compile_flags & + call run(model%fortran_compiler // objs // model%fortran_compile_flags & //link_flags// " -o " // target%output_file) case (FPM_TARGET_ARCHIVE) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 50a7d25..656fe5e 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -1,9 +1,9 @@ module fpm_command_line -use fpm_environment, only : get_os_type, & +use fpm_environment, only : get_os_type, get_env, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified -use fpm_strings, only : lower +use fpm_strings, only : lower, split use fpm_filesystem, only : basename, canon_path use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & @@ -29,11 +29,14 @@ type, extends(fpm_cmd_settings) :: fpm_new_settings logical :: with_test=.false. logical :: with_lib=.true. logical :: backfill=.true. + logical :: verbose=.true. end type type, extends(fpm_cmd_settings) :: fpm_build_settings - logical :: release=.false. logical :: list=.false. + character(len=:),allocatable :: compiler + character(len=:),allocatable :: build_name + logical :: verbose=.true. end type type, extends(fpm_build_settings) :: fpm_run_settings @@ -43,14 +46,17 @@ type, extends(fpm_build_settings) :: fpm_run_settings end type type, extends(fpm_run_settings) :: fpm_test_settings +integer :: gfortran_bug=0 end type type, extends(fpm_cmd_settings) :: fpm_install_settings + logical :: verbose=.true. end type character(len=:),allocatable :: name character(len=:),allocatable :: os_type -character(len=ibug),allocatable :: names(:) +character(len=ibug),allocatable :: names(:) +character(len=:),allocatable :: tnames(:) character(len=:), allocatable :: version_text(:) character(len=:), allocatable :: help_new(:), help_fpm(:), help_run(:), & @@ -61,7 +67,8 @@ character(len=20),parameter :: manual(*)=[ character(len=20) ::& & ' ', 'fpm', 'new', 'build', 'run', & & 'test', 'runner', 'list', 'help', 'version' ] -character(len=:), allocatable :: charbug +character(len=:), allocatable :: val_runner, val_build, val_compiler + contains subroutine get_command_line_settings(cmd_settings) class(fpm_cmd_settings), allocatable, intent(out) :: cmd_settings @@ -102,7 +109,17 @@ contains select case(trim(cmdarg)) case('run') - call set_args('--list F --release F --runner " " --',help_run,version_text) + call set_args('& + & --target " " & + & --list F & + & --release F& + & --verbose F& + & --runner " " & + & --fc "'//basename(get_env('FPM_FC',get_env('FC','gfortran')))//'" & + & --compiler "'//basename(get_env('FPM_FC',get_env('FC','gfortran')))//'" & + & --',help_test,version_text) + + call check_build_vals() if( size(unnamed) .gt. 1 )then names=unnamed(2:) @@ -110,19 +127,48 @@ contains names=[character(len=len(names)) :: ] endif + if(specified('target') )then + call split(sget('target'),tnames,delimiters=' ,:') + names=[character(len=max(len(names),len(tnames))) :: names,tnames] + endif + allocate(fpm_run_settings :: cmd_settings) - cmd_settings=fpm_run_settings( name=names, list=lget('list'), & - & release=lget('release'), args=remaining ,runner=sget('runner') ) + val_runner=sget('runner') + cmd_settings=fpm_run_settings(& + & args=remaining,& + & build_name=val_build,& + & compiler=val_compiler, & + & list=lget('list'),& + & name=names,& + & runner=val_runner,& + & verbose=lget('verbose') ) case('build') - call set_args( '--release F --list F --',help_build,version_text ) + call set_args( '& + & --release F & + & --list F & + & --verbose F& + & --fc "'//basename(get_env('FPM_FC',get_env('FC','gfortran')))//'" & + & --compiler "'//basename(get_env('FPM_FC',get_env('FC','gfortran')))//'" & + & --',help_test,version_text) + + call check_build_vals() allocate( fpm_build_settings :: cmd_settings ) - cmd_settings=fpm_build_settings( release=lget('release'), & - & list=lget('list') ) + cmd_settings=fpm_build_settings( & + & build_name=val_build,& + & compiler=val_compiler, & + & list=lget('list'),& + & verbose=lget('verbose') ) case('new') - call set_args(' --src F --lib F --app F --test F --backfill F', & + call set_args('& + & --src F & + & --lib F & + & --app F & + & --test F & + & --backfill F& + & --verbose F',& & help_new, version_text) select case(size(unnamed)) case(1) @@ -153,17 +199,21 @@ contains allocate(fpm_new_settings :: cmd_settings) if (any( specified(['src ','lib ','app ','test']) ) )then - cmd_settings=fpm_new_settings(name=name, & + cmd_settings=fpm_new_settings(& + & backfill=lget('backfill'), & + & name=name, & & with_executable=lget('app'), & - & with_test=lget('test'), & & with_lib=any([lget('lib'),lget('src')]), & - & backfill=lget('backfill') ) + & with_test=lget('test'), & + & verbose=lget('verbose') ) else - cmd_settings=fpm_new_settings(name=name, & + cmd_settings=fpm_new_settings(& + & backfill=lget('backfill') , & + & name=name, & & with_executable=.true., & - & with_test=.true., & & with_lib=.true., & - & backfill=lget('backfill') ) + & with_test=.true., & + & verbose=lget('verbose') ) endif case('help','manual') @@ -209,17 +259,32 @@ contains call printhelp(help_text) case('install') - call set_args('--release F ', help_install, version_text) + call set_args('& + & --release F& + & --verbose F& + &', help_install, version_text) allocate(fpm_install_settings :: cmd_settings) case('list') - call set_args(' --list F', help_list, version_text) + call set_args('& + & --list F& + &', help_list, version_text) call printhelp(help_list_nodash) if(lget('list'))then call printhelp(help_list_dash) endif case('test') - call set_args('--list F --release F --runner " " --',help_test,version_text) + call set_args('& + & --target " " & + & --list F& + & --release F& + & --runner " " & + & --fc "'//basename(get_env('FPM_FC',get_env('FC','gfortran')))//'" & + & --compiler "'//basename(get_env('FPM_FC',get_env('FC','gfortran')))//'" & + & --verbose F& + & --',help_test,version_text) + + call check_build_vals() if( size(unnamed) .gt. 1 )then names=unnamed(2:) @@ -227,10 +292,21 @@ contains names=[character(len=len(names)) :: ] endif + if(specified('target') )then + call split(sget('target'),tnames,delimiters=' ,:') + names=[character(len=max(len(names),len(tnames))) :: names,tnames] + endif + allocate(fpm_test_settings :: cmd_settings) - charbug=sget('runner') - cmd_settings=fpm_test_settings( name=names, list=lget('list'), & - & release=lget('release'), args=remaining ,runner=charbug ) + val_runner=sget('runner') + cmd_settings=fpm_test_settings(& + & args=remaining, & + & build_name=val_build, & + & compiler=val_compiler, & + & list=lget('list'), & + & name=names, & + & runner=val_runner, & + & verbose=lget('verbose') ) case default @@ -253,10 +329,49 @@ contains end select contains + + subroutine check_build_vals() + integer :: oneword + ! take basename of first word on FC; as other products + ! such as CMake allow FC to include optional compiler options + ! and others allow full pathnames to the decoder + val_compiler='' + val_compiler=sget('fc') + if(specified('compiler') )val_compiler=sget('compiler') + oneword=index(adjustl(val_compiler)//' ',' ')-1 + val_compiler=val_compiler(:oneword) + if(val_compiler.eq.'') then + val_compiler='gfortran' + else + val_compiler=basename(val_compiler) + endif + if( specified('fc').and.specified('compiler') )then + write(stdout,'(a)')& + &' --fc and --compiler are aliases and should not both ', & + &' be specified. Using '//val_compiler + endif + + if(.not.is_fortran_name(val_compiler))then + stop ' compiler names must be simple names' + endif + + val_build=trim(merge('release','debug ',lget('release'))) + + end subroutine check_build_vals + subroutine printhelp(lines) character(len=:),intent(in),allocatable :: lines(:) - write(stdout,'(g0)')(trim(lines(i)), i=1, size(lines) ) + integer :: iii,ii + if(allocated(lines))then + ii=size(lines) + if(ii .gt. 0 .and. len(lines).gt. 0) then + write(stdout,'(g0)')(trim(lines(iii)), iii=1, ii) + else + write(stdout,'(a)')' 0) then temp_string = temp_string(index(temp_string,':')+1:) - + end if if (.not.validate_name(temp_string)) then @@ -467,7 +467,7 @@ function parse_f_source(f_filename,error) result(f_source) (name(i:i) >= '0' .and. name(i:i) <= '9').or. & (lower(name(i:i)) >= 'a' .and. lower(name(i:i)) <= 'z').or. & name(i:i) == '_') ) then - + valid = .false. return end if @@ -483,7 +483,7 @@ end function parse_f_source function parse_c_source(c_filename,error) result(c_source) - ! Rudimentary scan of c source file and + ! Rudimentary scan of c source file and ! extract include dependencies ! character(*), intent(in) :: c_filename @@ -519,7 +519,7 @@ function parse_c_source(c_filename,error) result(c_source) ! Process 'INCLUDE' statements if (index(adjustl(lower(file_lines(i)%s)),'#include') == 1 .and. & index(file_lines(i)%s,'"') > 0) then - + n_include = n_include + 1 if (pass == 2) then @@ -555,7 +555,7 @@ function split_n(string,delims,n,stat) result(substring) ! n=0 will return the last item ! n=-1 will return the penultimate item etc. ! - ! stat = 1 on return if the index + ! stat = 1 on return if the index ! is not found ! character(*), intent(in) :: string diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index a6511c9..b94e80b 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -44,7 +44,7 @@ function f_string(c_string) do i=1,n f_string(i:i) = c_string(i) end do - + end function f_string @@ -100,7 +100,7 @@ subroutine split(input_line,array,delimiters,order,nulls) ! Author: John S. Urban ! License: Public Domain - + ! given a line of structure " par1 par2 par3 ... parn " store each par(n) into a separate variable in array. ! o by default adjacent delimiters in the input string do not create an empty string in the output array ! o no quoting of delimiters is supported @@ -109,7 +109,7 @@ subroutine split(input_line,array,delimiters,order,nulls) character(len=*),optional,intent(in) :: order ! order of output array sequential|[reverse|right] character(len=*),optional,intent(in) :: nulls ! return strings composed of delimiters or not ignore|return|ignoreend character(len=:),allocatable,intent(out) :: array(:) ! output array of tokens - + integer :: n ! max number of strings INPUT_LINE could split into if all delimiter integer,allocatable :: ibegin(:) ! positions in input string where tokens start integer,allocatable :: iterm(:) ! positions in input string where tokens end @@ -126,7 +126,7 @@ subroutine split(input_line,array,delimiters,order,nulls) integer :: inotnull ! count strings not composed of delimiters integer :: ireturn ! number of tokens returned integer :: imax ! length of longest token - + ! 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 diff --git a/fpm/src/fpm_targets.f90 b/fpm/src/fpm_targets.f90 index c3a59fd..9a29431 100644 --- a/fpm/src/fpm_targets.f90 +++ b/fpm/src/fpm_targets.f90 @@ -23,14 +23,14 @@ subroutine targets_from_sources(model,sources) model%package_name,'lib'//model%package_name//'.a')) do i=1,size(sources) - + select case (sources(i)%unit_type) case (FPM_UNIT_MODULE,FPM_UNIT_SUBMODULE,FPM_UNIT_SUBPROGRAM,FPM_UNIT_CSOURCE) call add_target(model%targets,source = sources(i), & type = FPM_TARGET_OBJECT,& output_file = get_object_name(sources(i))) - + if (with_lib .and. sources(i)%unit_scope == FPM_SCOPE_LIB) then ! Archive depends on object call add_dependency(model%targets(1)%ptr, model%targets(size(model%targets))%ptr) @@ -42,7 +42,7 @@ subroutine targets_from_sources(model,sources) output_file = get_object_name(sources(i)), & source = sources(i) & ) - + if (sources(i)%unit_scope == FPM_SCOPE_APP) then call add_target(model%targets,type = FPM_TARGET_EXECUTABLE,& link_libraries = sources(i)%link_libraries, & @@ -51,7 +51,7 @@ subroutine targets_from_sources(model,sources) call add_target(model%targets,type = FPM_TARGET_EXECUTABLE,& link_libraries = sources(i)%link_libraries, & output_file = join_path(model%output_directory,'test',sources(i)%exe_name)) - + end if ! Executable depends on object @@ -61,7 +61,7 @@ subroutine targets_from_sources(model,sources) ! Executable depends on library call add_dependency(model%targets(size(model%targets))%ptr, model%targets(1)%ptr) end if - + end select end do @@ -70,20 +70,20 @@ subroutine targets_from_sources(model,sources) function get_object_name(source) result(object_file) ! Generate object target path from source name and model params - ! + ! ! type(srcfile_t), intent(in) :: source character(:), allocatable :: object_file - + integer :: i character(1), parameter :: filesep = '/' character(:), allocatable :: dir - + object_file = canon_path(source%file_name) ! Ignore first directory level object_file = object_file(index(object_file,filesep)+1:) - + ! Convert any remaining directory separators to underscores i = index(object_file,filesep) do while(i > 0) @@ -101,9 +101,9 @@ subroutine targets_from_sources(model,sources) case default object_file = join_path(model%output_directory,model%package_name,object_file)//'.o' - + end select - + end function get_object_name end subroutine targets_from_sources @@ -143,7 +143,7 @@ subroutine add_target(targets,type,output_file,source,link_libraries) if (present(source)) new_target%source = source if (present(link_libraries)) new_target%link_libraries = link_libraries allocate(new_target%dependencies(0)) - + targets = [targets, build_target_ptr(new_target)] end subroutine add_target @@ -171,7 +171,7 @@ subroutine resolve_module_dependencies(targets,error) integer :: i, j do i=1,size(targets) - + if (.not.allocated(targets(i)%ptr%source)) cycle do j=1,size(targets(i)%ptr%source%modules_used) @@ -180,7 +180,7 @@ subroutine resolve_module_dependencies(targets,error) ! Dependency satisfied in same file, skip cycle end if - + if (targets(i)%ptr%source%unit_scope == FPM_SCOPE_APP .OR. & targets(i)%ptr%source%unit_scope == FPM_SCOPE_TEST ) then dep%ptr => & @@ -203,7 +203,7 @@ subroutine resolve_module_dependencies(targets,error) end do - end do + end do end subroutine resolve_module_dependencies @@ -244,7 +244,7 @@ function find_module_dependency(targets,module_name,include_dir) result(target_p end if end do - + end do end function find_module_dependency diff --git a/fpm/test/cli_test/cli_test.f90 b/fpm/test/cli_test/cli_test.f90 index 915d9da..fdb7979 100644 --- a/fpm/test/cli_test/cli_test.f90 +++ b/fpm/test/cli_test/cli_test.f90 @@ -28,9 +28,9 @@ integer :: i, ios logical :: w_e,act_w_e ; namelist/act_cli/act_w_e logical :: w_t,act_w_t ; namelist/act_cli/act_w_t -logical :: release,act_release ; namelist/act_cli/act_release +character(len=63) :: build_name,act_build_name ; namelist/act_cli/act_build_name character(len=:),allocatable :: args,act_args ; namelist/act_cli/act_args -namelist/expected/cmd,cstat,estat,w_e,w_t,name,release,args +namelist/expected/cmd,cstat,estat,w_e,w_t,name,build_name,args integer :: lun logical,allocatable :: tally(:) logical,allocatable :: subtally(:) @@ -50,19 +50,19 @@ character(len=*),parameter :: tests(*)= [ character(len=256) :: & 'CMD="run", ', & 'CMD="run my_project", NAME="my_project", ', & 'CMD="run proj1 p2 project3", NAME="proj1","p2","project3", ', & -'CMD="run proj1 p2 project3 --release", NAME="proj1","p2","project3",RELEASE=T,', & +'CMD="run proj1 p2 project3 --release", NAME="proj1","p2","project3",build_name="release",', & 'CMD="run proj1 p2 project3 --release -- arg1 -x ""and a long one""", & - &NAME="proj1","p2","project3",RELEASE=T ARGS="""arg1"" -x ""and a long one""", ', & + &NAME="proj1","p2","project3",build_name="release",ARGS="""arg1"" -x ""and a long one""", ', & 'CMD="test", ', & 'CMD="test my_project", NAME="my_project", ', & 'CMD="test proj1 p2 project3", NAME="proj1","p2","project3", ', & -'CMD="test proj1 p2 project3 --release", NAME="proj1","p2","project3",RELEASE=T,', & +'CMD="test proj1 p2 project3 --release", NAME="proj1","p2","project3",build_name="release",', & 'CMD="test proj1 p2 project3 --release -- arg1 -x ""and a long one""", & - &NAME="proj1","p2","project3",RELEASE=T ARGS="""arg1"" -x ""and a long one""", ', & + &NAME="proj1","p2","project3",build_name="release" ARGS="""arg1"" -x ""and a long one""", ', & -'CMD="build", NAME= RELEASE=F,ARGS="",', & -'CMD="build --release", NAME= RELEASE=T,ARGS="",', & +'CMD="build", NAME= build_name="debug",ARGS="",', & +'CMD="build --release", NAME= build_name="release",ARGS="",', & ' ' ] character(len=256) :: readme(3) @@ -90,7 +90,7 @@ if(command_argument_count().eq.0)then ! assume if called with no arguments to d endif ! blank out name group EXPECTED name=[(repeat(' ',len(name)),i=1,max_names)] ! the words on the command line sans the subcommand name - release=.false. ! --release + build_name="debug" ! --release w_e=.false. ! --app w_t=.false. ! --test args=repeat(' ',132) ! -- ARGS @@ -107,7 +107,7 @@ if(command_argument_count().eq.0)then ! assume if called with no arguments to d if(estat.eq.0)then open(file='_test_cli',newunit=lun,delim='quote') act_name=[(repeat(' ',len(act_name)),i=1,max_names)] - act_release=.false. + act_build_name='debug' act_w_e=.false. act_w_t=.false. act_args=repeat(' ',132) @@ -119,7 +119,7 @@ if(command_argument_count().eq.0)then ! assume if called with no arguments to d ! compare results to expected values subtally=[logical ::] call test_test('NAME',all(act_name.eq.name)) - call test_test('RELEASE',act_release.eqv.release) + call test_test('RELEASE',act_build_name.eq.build_name) 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) @@ -203,7 +203,7 @@ allocate (character(len=len(name)) :: act_name(0) ) act_args='' act_w_e=.false. act_w_t=.false. -act_release=.false. +act_build_name='debug' select type(settings=>cmd_settings) type is (fpm_new_settings) @@ -211,13 +211,13 @@ type is (fpm_new_settings) act_w_t=settings%with_test act_name=[trim(settings%name)] type is (fpm_build_settings) - act_release=settings%release + act_build_name=settings%build_name type is (fpm_run_settings) - act_release=settings%release + act_build_name=settings%build_name act_name=settings%name act_args=settings%args type is (fpm_test_settings) - act_release=settings%release + act_build_name=settings%build_name act_name=settings%name act_args=settings%args type is (fpm_install_settings) -- cgit v1.2.3 From 86711be44779cdd473f7dfdae09a81355027799a Mon Sep 17 00:00:00 2001 From: LKedward Date: Fri, 27 Nov 2020 15:10:01 +0000 Subject: Remove white-space changes from compiler branch for PR --- fpm/src/fpm.f90 | 1 + fpm/src/fpm/error.f90 | 8 ++++---- fpm/src/fpm/git.f90 | 4 ++-- fpm/src/fpm/manifest/package.f90 | 4 ++-- fpm/src/fpm_backend.f90 | 14 +++++++------- fpm/src/fpm_filesystem.f90 | 32 ++++++++++++++++---------------- fpm/src/fpm_model.f90 | 2 +- fpm/src/fpm_sources.f90 | 24 ++++++++++++------------ fpm/src/fpm_strings.f90 | 8 ++++---- fpm/src/fpm_targets.f90 | 32 ++++++++++++++++---------------- 10 files changed, 65 insertions(+), 64 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 07bf483..aa9a4e6 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -25,6 +25,7 @@ public :: cmd_build, cmd_install, cmd_run contains + recursive subroutine add_libsources_from_package(sources,link_libraries,package_list,package, & package_root,dev_depends,error) ! Discover library sources in a package, recursively including dependencies diff --git a/fpm/src/fpm/error.f90 b/fpm/src/fpm/error.f90 index 2cfd964..e69ff1e 100644 --- a/fpm/src/fpm/error.f90 +++ b/fpm/src/fpm/error.f90 @@ -82,9 +82,9 @@ contains allocate(error) error%message = 'Parse error: '//message//new_line('a') - + error%message = error%message//file_name - + if (present(line_num)) then write(temp_string,'(I0)') line_num @@ -115,9 +115,9 @@ contains error%message = error%message//new_line('a') error%message = error%message//' | '//repeat(' ',line_col-1)//'^' - + end if - + end if end if diff --git a/fpm/src/fpm/git.f90 b/fpm/src/fpm/git.f90 index af4ae22..187b551 100644 --- a/fpm/src/fpm/git.f90 +++ b/fpm/src/fpm/git.f90 @@ -138,7 +138,7 @@ contains !> Error type(error_t), allocatable, intent(out) :: error - + !> git object ref character(:), allocatable :: object @@ -173,7 +173,7 @@ contains return end if - end subroutine checkout + end subroutine checkout !> Show information on git target diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90 index 7f2f91e..64b0f82 100644 --- a/fpm/src/fpm/manifest/package.f90 +++ b/fpm/src/fpm/manifest/package.f90 @@ -115,10 +115,10 @@ contains call new_build_config(self%build, child, error) if (allocated(error)) return - + call get_value(table, "version", version, "0") call new_version(self%version, version, error) - + if (allocated(error)) return call get_value(table, "dependencies", child, requested=.false.) diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 632da64..b455398 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -8,7 +8,7 @@ use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM, & FPM_SCOPE_TEST, FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE - + use fpm_strings, only: split implicit none @@ -41,9 +41,9 @@ subroutine build_package(model) linking = linking//" "//model%link_flags do i=1,size(model%targets) - + call build_target(model,model%targets(i)%ptr,linking) - + end do end subroutine build_package @@ -52,7 +52,7 @@ end subroutine build_package recursive subroutine build_target(model,target,linking) ! Compile Fortran source, called recursively on it dependents - ! + ! type(fpm_model_t), intent(in) :: model type(build_target_t), intent(inout) :: target character(:), allocatable, intent(in) :: linking @@ -89,10 +89,10 @@ recursive subroutine build_target(model,target,linking) target%dependencies(i)%ptr%target_type == FPM_TARGET_OBJECT) then exe_obj => target%dependencies(i)%ptr - + ! Construct object list for executable objs = " "//exe_obj%output_file - + ! Include non-library object dependencies do j=1,size(exe_obj%dependencies) @@ -107,7 +107,7 @@ recursive subroutine build_target(model,target,linking) end if end do - + if (.not.exists(dirname(target%output_file))) then call mkdir(dirname(target%output_file)) end if diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index 52c9b58..77b22d1 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -52,7 +52,7 @@ function canon_path(path) result(canon) ! Canonicalize path for comparison ! Handles path string redundancies ! Does not test existence of path - ! + ! ! To be replaced by realpath/_fullname in stdlib_os ! character(*), intent(in) :: path @@ -106,7 +106,7 @@ function canon_path(path) result(canon) end if end if - + temp(j:j) = nixpath(i:i) j = j + 1 @@ -131,23 +131,23 @@ function dirname(path) result (dir) end function dirname -logical function is_dir(dir) - character(*), intent(in) :: dir - integer :: stat +logical function is_dir(dir) + character(*), intent(in) :: dir + integer :: stat - select case (get_os_type()) + select case (get_os_type()) case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD) - call execute_command_line("test -d " // dir , exitstat=stat) + call execute_command_line("test -d " // dir , exitstat=stat) - case (OS_WINDOWS) - call execute_command_line('cmd /c "if not exist ' // windows_path(dir) // '\ exit /B 1"', exitstat=stat) + case (OS_WINDOWS) + call execute_command_line('cmd /c "if not exist ' // windows_path(dir) // '\ exit /B 1"', exitstat=stat) - end select + end select - is_dir = (stat == 0) + is_dir = (stat == 0) -end function is_dir +end function is_dir function join_path(a1,a2,a3,a4,a5) result(path) @@ -294,7 +294,7 @@ recursive subroutine list_files(dir, files, recurse) do i=1,size(files) if (is_dir(files(i)%s)) then - call list_files(files(i)%s, dir_files, recurse=.true.) + call list_files(files(i)%s, dir_files, recurse=.true.) sub_dir_files = [sub_dir_files, dir_files] end if @@ -326,7 +326,7 @@ function get_temp_filename() result(tempfile) type(c_ptr) :: c_tempfile_ptr character(len=1), pointer :: c_tempfile(:) - + interface function c_tempnam(dir,pfx) result(tmp) bind(c,name="tempnam") @@ -368,7 +368,7 @@ function windows_path(path) result(winpath) winpath(idx:idx) = '\' idx = index(winpath,'/') end do - + end function windows_path @@ -387,7 +387,7 @@ function unix_path(path) result(nixpath) nixpath(idx:idx) = '/' idx = index(nixpath,'\') end do - + end function unix_path end module fpm_filesystem diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 3f14125..20f174b 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -33,7 +33,7 @@ integer, parameter :: FPM_TARGET_ARCHIVE = 2 integer, parameter :: FPM_TARGET_OBJECT = 3 type srcfile_t - ! Type for encapsulating a source file + ! Type for encapsulating a source file ! and it's metadata character(:), allocatable :: file_name ! File path relative to cwd diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index 46d439c..5e42430 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -5,7 +5,7 @@ use fpm_model, only: srcfile_t, fpm_model_t, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & FPM_UNIT_CSOURCE, FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, & FPM_SCOPE_LIB, FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST - + use fpm_filesystem, only: basename, canon_path, dirname, join_path, read_lines, list_files use fpm_strings, only: lower, split, str_ends_with, string_t, operator(.in.) use fpm_manifest_executable, only: executable_config_t @@ -119,9 +119,9 @@ end subroutine add_sources_from_dir subroutine add_executable_sources(sources,executables,scope,auto_discover,error) - ! Include sources from any directories specified + ! Include sources from any directories specified ! in [[executable]] entries and apply any customisations - ! + ! type(srcfile_t), allocatable, intent(inout), target :: sources(:) class(executable_config_t), intent(in) :: executables(:) integer, intent(in) :: scope @@ -153,7 +153,7 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error) if (basename(sources(j)%file_name,suffix=.true.) == executables(i)%main .and.& canon_path(dirname(sources(j)%file_name)) == & canon_path(executables(i)%source_dir) ) then - + sources(j)%exe_name = executables(i)%name if (allocated(executables(i)%link)) then exe_source%link_libraries = executables(i)%link @@ -171,7 +171,7 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error) exe_source%link_libraries = executables(i)%link end if exe_source%unit_scope = scope - + if (allocated(error)) return if (.not.allocated(sources)) then @@ -215,7 +215,7 @@ end subroutine get_executable_source_dirs function parse_f_source(f_filename,error) result(f_source) - ! Rudimentary scan of Fortran source file and + ! Rudimentary scan of Fortran source file and ! extract program unit name and use/include dependencies ! character(*), intent(in) :: f_filename @@ -313,7 +313,7 @@ function parse_f_source(f_filename,error) result(f_source) if (index(adjustl(file_lines(i)%s(ic+7:)),'"') == 1 .or. & index(adjustl(file_lines(i)%s(ic+7:)),"'") == 1 ) then - + n_include = n_include + 1 if (pass == 2) then @@ -400,7 +400,7 @@ function parse_f_source(f_filename,error) result(f_source) if (index(temp_string,':') > 0) then temp_string = temp_string(index(temp_string,':')+1:) - + end if if (.not.validate_name(temp_string)) then @@ -467,7 +467,7 @@ function parse_f_source(f_filename,error) result(f_source) (name(i:i) >= '0' .and. name(i:i) <= '9').or. & (lower(name(i:i)) >= 'a' .and. lower(name(i:i)) <= 'z').or. & name(i:i) == '_') ) then - + valid = .false. return end if @@ -483,7 +483,7 @@ end function parse_f_source function parse_c_source(c_filename,error) result(c_source) - ! Rudimentary scan of c source file and + ! Rudimentary scan of c source file and ! extract include dependencies ! character(*), intent(in) :: c_filename @@ -519,7 +519,7 @@ function parse_c_source(c_filename,error) result(c_source) ! Process 'INCLUDE' statements if (index(adjustl(lower(file_lines(i)%s)),'#include') == 1 .and. & index(file_lines(i)%s,'"') > 0) then - + n_include = n_include + 1 if (pass == 2) then @@ -555,7 +555,7 @@ function split_n(string,delims,n,stat) result(substring) ! n=0 will return the last item ! n=-1 will return the penultimate item etc. ! - ! stat = 1 on return if the index + ! stat = 1 on return if the index ! is not found ! character(*), intent(in) :: string diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index b94e80b..a6511c9 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -44,7 +44,7 @@ function f_string(c_string) do i=1,n f_string(i:i) = c_string(i) end do - + end function f_string @@ -100,7 +100,7 @@ subroutine split(input_line,array,delimiters,order,nulls) ! Author: John S. Urban ! License: Public Domain - + ! given a line of structure " par1 par2 par3 ... parn " store each par(n) into a separate variable in array. ! o by default adjacent delimiters in the input string do not create an empty string in the output array ! o no quoting of delimiters is supported @@ -109,7 +109,7 @@ subroutine split(input_line,array,delimiters,order,nulls) character(len=*),optional,intent(in) :: order ! order of output array sequential|[reverse|right] character(len=*),optional,intent(in) :: nulls ! return strings composed of delimiters or not ignore|return|ignoreend character(len=:),allocatable,intent(out) :: array(:) ! output array of tokens - + integer :: n ! max number of strings INPUT_LINE could split into if all delimiter integer,allocatable :: ibegin(:) ! positions in input string where tokens start integer,allocatable :: iterm(:) ! positions in input string where tokens end @@ -126,7 +126,7 @@ subroutine split(input_line,array,delimiters,order,nulls) integer :: inotnull ! count strings not composed of delimiters integer :: ireturn ! number of tokens returned integer :: imax ! length of longest token - + ! 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 diff --git a/fpm/src/fpm_targets.f90 b/fpm/src/fpm_targets.f90 index 9a29431..c3a59fd 100644 --- a/fpm/src/fpm_targets.f90 +++ b/fpm/src/fpm_targets.f90 @@ -23,14 +23,14 @@ subroutine targets_from_sources(model,sources) model%package_name,'lib'//model%package_name//'.a')) do i=1,size(sources) - + select case (sources(i)%unit_type) case (FPM_UNIT_MODULE,FPM_UNIT_SUBMODULE,FPM_UNIT_SUBPROGRAM,FPM_UNIT_CSOURCE) call add_target(model%targets,source = sources(i), & type = FPM_TARGET_OBJECT,& output_file = get_object_name(sources(i))) - + if (with_lib .and. sources(i)%unit_scope == FPM_SCOPE_LIB) then ! Archive depends on object call add_dependency(model%targets(1)%ptr, model%targets(size(model%targets))%ptr) @@ -42,7 +42,7 @@ subroutine targets_from_sources(model,sources) output_file = get_object_name(sources(i)), & source = sources(i) & ) - + if (sources(i)%unit_scope == FPM_SCOPE_APP) then call add_target(model%targets,type = FPM_TARGET_EXECUTABLE,& link_libraries = sources(i)%link_libraries, & @@ -51,7 +51,7 @@ subroutine targets_from_sources(model,sources) call add_target(model%targets,type = FPM_TARGET_EXECUTABLE,& link_libraries = sources(i)%link_libraries, & output_file = join_path(model%output_directory,'test',sources(i)%exe_name)) - + end if ! Executable depends on object @@ -61,7 +61,7 @@ subroutine targets_from_sources(model,sources) ! Executable depends on library call add_dependency(model%targets(size(model%targets))%ptr, model%targets(1)%ptr) end if - + end select end do @@ -70,20 +70,20 @@ subroutine targets_from_sources(model,sources) function get_object_name(source) result(object_file) ! Generate object target path from source name and model params - ! + ! ! type(srcfile_t), intent(in) :: source character(:), allocatable :: object_file - + integer :: i character(1), parameter :: filesep = '/' character(:), allocatable :: dir - + object_file = canon_path(source%file_name) ! Ignore first directory level object_file = object_file(index(object_file,filesep)+1:) - + ! Convert any remaining directory separators to underscores i = index(object_file,filesep) do while(i > 0) @@ -101,9 +101,9 @@ subroutine targets_from_sources(model,sources) case default object_file = join_path(model%output_directory,model%package_name,object_file)//'.o' - + end select - + end function get_object_name end subroutine targets_from_sources @@ -143,7 +143,7 @@ subroutine add_target(targets,type,output_file,source,link_libraries) if (present(source)) new_target%source = source if (present(link_libraries)) new_target%link_libraries = link_libraries allocate(new_target%dependencies(0)) - + targets = [targets, build_target_ptr(new_target)] end subroutine add_target @@ -171,7 +171,7 @@ subroutine resolve_module_dependencies(targets,error) integer :: i, j do i=1,size(targets) - + if (.not.allocated(targets(i)%ptr%source)) cycle do j=1,size(targets(i)%ptr%source%modules_used) @@ -180,7 +180,7 @@ subroutine resolve_module_dependencies(targets,error) ! Dependency satisfied in same file, skip cycle end if - + if (targets(i)%ptr%source%unit_scope == FPM_SCOPE_APP .OR. & targets(i)%ptr%source%unit_scope == FPM_SCOPE_TEST ) then dep%ptr => & @@ -203,7 +203,7 @@ subroutine resolve_module_dependencies(targets,error) end do - end do + end do end subroutine resolve_module_dependencies @@ -244,7 +244,7 @@ function find_module_dependency(targets,module_name,include_dir) result(target_p end if end do - + end do end function find_module_dependency -- cgit v1.2.3 From 15083ad7f5a84d28817b334f5401230a96571b82 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Sun, 29 Nov 2020 19:08:42 -0500 Subject: suggested changes --- fpm/fpm.toml | 4 +- fpm/src/fpm.f90 | 211 +++---------------------------------------- fpm/src/fpm_command_line.f90 | 155 ++++++++++++++----------------- fpm/src/fpm_compiler.f90 | 198 ++++++++++++++++++++++++++++++++++++++++ fpm/src/fpm_filesystem.f90 | 2 +- 5 files changed, 280 insertions(+), 290 deletions(-) create mode 100644 fpm/src/fpm_compiler.f90 diff --git a/fpm/fpm.toml b/fpm/fpm.toml index fa91f2f..5c61402 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -12,7 +12,7 @@ tag = "v0.2.1" [dependencies.M_CLI2] git = "https://github.com/urbanjost/M_CLI2.git" -rev = "598e44164eee383b8a0775aa75b7d1bb100481c3" +rev = "a77fabf52a781613609f6a8c80ca5d5f8f30f97c" [[test]] name = "cli-test" @@ -28,5 +28,3 @@ main = "new_test.f90" name = "fpm-test" source-dir = "test/fpm_test" main = "main.f90" - - diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index aa9a4e6..fbd91d9 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -9,6 +9,7 @@ use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, & FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST, & FPM_TARGET_EXECUTABLE +use fpm_compiler, only: add_compile_flag_defaults use fpm_sources, only: add_executable_sources, add_sources_from_dir use fpm_targets, only: targets_from_sources, resolve_module_dependencies @@ -155,7 +156,6 @@ subroutine build_model(model, settings, package, error) type(string_t), allocatable :: package_list(:) integer :: i - character(len=:),allocatable :: module_path_switch if(settings%verbose)then write(*,*)'BUILD_NAME:',settings%build_name @@ -163,6 +163,7 @@ subroutine build_model(model, settings, package, error) endif model%package_name = package%name + if (allocated(package%build%link)) then model%link_libraries = package%build%link else @@ -172,205 +173,15 @@ subroutine build_model(model, settings, package, error) allocate(package_list(1)) package_list(1)%s = package%name - model%fortran_compiler=settings%compiler - - model%output_directory = join_path('build',model%fortran_compiler//'_'//settings%build_name) - - if(settings%compiler.eq.'')then - model%fortran_compiler = 'gfortran' - else - model%fortran_compiler = settings%compiler - endif - -! #TODO: Choose flags and output directory based on cli settings & manifest inputs -! special reserved names "debug" and "release" are for supported compilers with no user-specified compile or load flags - -! vendor Fortran C Module output Module include OpenMP Free for OSS -! compiler compiler directory directory -! Gnu gfortran gcc -J -I -fopenmp X -! Intel ifort icc -module -I -qopenmp X -! Intel(Windows) ifort icc /module:path /I /Qopenmp X -! Intel oneAPI ifx icx -module -I -qopenmp X -! PGI pgfortran pgcc -module -I -mp X -! NVIDIA nvfortran nvc -module -I -mp X -! LLVM flang flang clang -module -I -mp X -! LFortran lfortran --- ? ? ? X -! Lahey/Futjitsu lfc ? -M -I -openmp ? -! NAG nagfor ? -mdir -I -openmp x -! Cray crayftn craycc -J -I -homp ? -! IBM xlf90 ? -qmoddir -I -qsmp X -! Oracle/Sun ? ? -moddir= -M -xopenmp ? -! Silverfrost FTN95 ftn95 ? ? /MOD_PATH ? ? -! Elbrus ? lcc -J -I -fopenmp ? -! Hewlett Packard ? ? ? ? ? discontinued -! Watcom ? ? ? ? ? discontinued -! PathScale ? ? -module -I -mp discontinued -! G95 ? ? -fmod= -I -fopenmp discontinued -! Open64 ? ? -module -I -mp discontinued -! Unisys ? ? ? ? ? discontinued - - select case(settings%build_name//'_'//settings%compiler) - - case('release_gfortran') ! -J - model%fortran_compile_flags=' & - & -O3& - & -Wimplicit-interface& - & -fPIC& - & -fmax-errors=1& - & -ffast-math& - & -funroll-loops& - & ' - case('debug_gfortran') - model%fortran_compile_flags = '& - & -Wall & - & -Wextra & - &-Wimplicit-interface & - &-fPIC -fmax-errors=1 & - &-g & - &-fbounds-check & - &-fcheck-array-temporaries & - &-fbacktrace ' - - case('release_f95') ! -J - model%fortran_compile_flags=' & - & -O3& - & -Wimplicit-interface& - & -fPIC& - & -std=f95 & - & -fmax-errors=1& - & -ffast-math& - & -funroll-loops& - & ' - case('debug_f95') - model%fortran_compile_flags = '& - & -Wall & - & -Wextra & - &-Wimplicit-interface & - &-fPIC -fmax-errors=1 & - &-g & - &-std=f95 & - &-fbounds-check & - &-fcheck-array-temporaries & - &-fbacktrace ' - - case('release_gnu') ! -J - model%fortran_compile_flags=' & - & -O3& - & -Wimplicit-interface& - & -fPIC& - & -fmax-errors=1& - & -ffast-math& - & -funroll-loops& - & -std=f2018 & - & -Wno-maybe-uninitialized -Wno-uninitialized & - & ' - model%fortran_compiler = 'gfortran' - case('debug_gnu') - model%fortran_compile_flags = '& - & -Wall & - & -Wextra & - & -Wimplicit-interface & - & -fPIC -fmax-errors=1 & - & -g & - & -fbounds-check & - & -fcheck-array-temporaries & - & -std=f2018 & - & -Wno-maybe-uninitialized -Wno-uninitialized & - & -fbacktrace ' - model%fortran_compiler = 'gfortran' - - case('release_nvfortran') - model%fortran_compile_flags = ' & - & -Mbackslash& - & ' - case('debug_nvfortran') - model%fortran_compile_flags = '& - & -Minform=inform & - & -Mbackslash & - & -traceback& - & ' - - case('release_ifort') - model%fortran_compile_flags = ' & - & -fp-model precise & - & -pc 64 & - & -align all & - & -error-limit 1 & - & -reentrancy threaded & - & -nogen-interfaces & - & -assume byterecl & - & -assume nounderscore' - case('debug_ifort') - model%fortran_compile_flags = '& - & -warn all & - & -check all & - & -error-limit 1 & - & -O0 & - & -g & - & -assume byterecl & - & -traceback ' - case('release_ifx') - model%fortran_compile_flags = ' ' - case('debug_ifx') - model%fortran_compile_flags = ' ' - - case('release_pgfortran','release_pgf90','release_pgf95') ! Portland Group F90/F95 compilers - model%fortran_compile_flags = ' ' - case('debug_pgfortran','debug_pgf90','debug_pgf95') ! Portland Group F90/F95 compilers - model%fortran_compile_flags = ' ' - - case('release_flang') - model%fortran_compile_flags = ' ' - case('debug_flang') - model%fortran_compile_flags = ' ' - - case('release_lfc') - model%fortran_compile_flags = ' ' - case('debug_lfc') - model%fortran_compile_flags = ' ' - - case('release_nagfor') - model%fortran_compile_flags = ' ' - case('debug_nagfor') - model%fortran_compile_flags = ' ' - - case('release_crayftn') - model%fortran_compile_flags = ' ' - case('debug_crayftn') - model%fortran_compile_flags = ' ' - - case('release_xlf90') - model%fortran_compile_flags = ' ' - case('debug_xlf90') - model%fortran_compile_flags = ' ' - - case default - model%fortran_compile_flags = ' ' - write(*,*)' unknown compiler (',settings%compiler,')' - write(*,*)' and build name (',settings%build_name,')' - write(*,*)' combination.' - write(*,*)' known compilers are gfortran, nvfortran, ifort' - end select - - select case(settings%compiler) - case('gfortran') ; module_path_switch=' -J ' - case('gnu') ; module_path_switch=' -J ' - case('nvfortran') ; module_path_switch=' -module ' - case('ifort') ; module_path_switch=' -module ' - case('ifx') ; module_path_switch=' -module ' - case('pgfortran') ; module_path_switch=' -module ' - case('flang') ; module_path_switch=' -module ' - case('lfc') ; module_path_switch=' -M ' - case('crayftn') ; module_path_switch=' -J ' - case('nagfor') ; module_path_switch=' -mdir ' - case('xlf90') ; module_path_switch=' -qmoddir ' - case default - module_path_switch=' -module ' - write(*,*)'UNKNOWN COMPILER NAME ',settings%compiler - end select - - model%fortran_compile_flags = model%fortran_compile_flags//' '//& - & module_path_switch//join_path(model%output_directory,model%package_name) + if(settings%compiler.eq.'')then + model%fortran_compiler = 'gfortran' + else + model%fortran_compiler = settings%compiler + endif + + model%output_directory = join_path('build',basename(model%fortran_compiler)//'_'//settings%build_name) + + call add_compile_flag_defaults(settings%build_name, basename(model%fortran_compiler), model) model%link_flags = '' diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 656fe5e..dd50200 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -20,6 +20,7 @@ public :: fpm_cmd_settings, & get_command_line_settings type, abstract :: fpm_cmd_settings + logical :: verbose=.true. end type integer,parameter :: ibug=4096 @@ -29,14 +30,12 @@ type, extends(fpm_cmd_settings) :: fpm_new_settings logical :: with_test=.false. logical :: with_lib=.true. logical :: backfill=.true. - logical :: verbose=.true. end type type, extends(fpm_cmd_settings) :: fpm_build_settings logical :: list=.false. character(len=:),allocatable :: compiler character(len=:),allocatable :: build_name - logical :: verbose=.true. end type type, extends(fpm_build_settings) :: fpm_run_settings @@ -46,11 +45,9 @@ type, extends(fpm_build_settings) :: fpm_run_settings end type type, extends(fpm_run_settings) :: fpm_test_settings -integer :: gfortran_bug=0 end type type, extends(fpm_cmd_settings) :: fpm_install_settings - logical :: verbose=.true. end type character(len=:),allocatable :: name @@ -113,10 +110,9 @@ contains & --target " " & & --list F & & --release F& - & --verbose F& & --runner " " & - & --fc "'//basename(get_env('FPM_FC',get_env('FC','gfortran')))//'" & - & --compiler "'//basename(get_env('FPM_FC',get_env('FC','gfortran')))//'" & + & --compiler "'//get_env('FPM_COMPILER','gfortran')//'" & + & --verbose F& & --',help_test,version_text) call check_build_vals() @@ -147,9 +143,8 @@ contains call set_args( '& & --release F & & --list F & + & --compiler "'//get_env('FPM_COMPILER','gfortran')//'" & & --verbose F& - & --fc "'//basename(get_env('FPM_FC',get_env('FC','gfortran')))//'" & - & --compiler "'//basename(get_env('FPM_FC',get_env('FC','gfortran')))//'" & & --',help_test,version_text) call check_build_vals() @@ -172,23 +167,23 @@ contains & help_new, version_text) select case(size(unnamed)) case(1) - write(stderr,'(*(g0,/))')'ERROR: directory name required' + write(stderr,'(*(g0,/))')' directory name required' write(stderr,'(*(7x,g0,/))') & - & 'USAGE: fpm new NAME [--lib|--src] [--app] [--test] [--backfill]' + & ' fpm new NAME [--lib|--src] [--app] [--test] [--backfill]' stop 1 case(2) name=trim(unnamed(2)) case default - write(stderr,'(g0)')'ERROR: only one directory name allowed' + write(stderr,'(g0)')' only one directory name allowed' write(stderr,'(7x,g0)') & - & 'USAGE: fpm new NAME [--lib|--src] [--app] [--test] [--backfill]' + & ' fpm new NAME [--lib|--src] [--app] [--test] [--backfill]' stop 2 end select !*! canon_path is not converting ".", etc. name=canon_path(name) if( .not.is_fortran_name(basename(name)) )then write(stderr,'(g0)') [ character(len=72) :: & - & 'ERROR: the new directory basename must be an allowed ', & + & 'the new directory basename must be an allowed ', & & ' Fortran name. It must be composed of 1 to 63 ASCII', & & ' characters and start with a letter and be composed', & & ' entirely of alphanumeric characters [a-zA-Z0-9]', & @@ -217,7 +212,9 @@ contains endif case('help','manual') - call set_args(' ',help_help,version_text) + call set_args('& + & --verbose F & + & ',help_help,version_text) if(size(unnamed).lt.2)then if(unnamed(1).eq.'help')then unnamed=[' ', 'fpm'] @@ -268,6 +265,7 @@ contains case('list') call set_args('& & --list F& + & --verbose F& &', help_list, version_text) call printhelp(help_list_nodash) if(lget('list'))then @@ -279,8 +277,7 @@ contains & --list F& & --release F& & --runner " " & - & --fc "'//basename(get_env('FPM_FC',get_env('FC','gfortran')))//'" & - & --compiler "'//basename(get_env('FPM_FC',get_env('FC','gfortran')))//'" & + & --compiler "'//get_env('FPM_COMPILER','gfortran')//'" & & --verbose F& & --',help_test,version_text) @@ -310,7 +307,10 @@ contains case default - call set_args(' --list F', help_fpm, version_text) + call set_args('& + & --list F& + & --verbose F& + ', help_fpm, version_text) ! Note: will not get here if --version or --usage or --help ! is present on commandline help_text=help_usage @@ -321,7 +321,7 @@ contains write(stdout,'(*(a))')' ' call printhelp(help_list_nodash) else - write(stderr,'(*(a))')'ERROR: unknown subcommand [', & + write(stderr,'(*(a))')' unknown subcommand [', & & trim(cmdarg), ']' call printhelp(help_list_dash) endif @@ -331,31 +331,13 @@ contains contains subroutine check_build_vals() - integer :: oneword - ! take basename of first word on FC; as other products - ! such as CMake allow FC to include optional compiler options - ! and others allow full pathnames to the decoder - val_compiler='' - val_compiler=sget('fc') - if(specified('compiler') )val_compiler=sget('compiler') - oneword=index(adjustl(val_compiler)//' ',' ')-1 - val_compiler=val_compiler(:oneword) - if(val_compiler.eq.'') then - val_compiler='gfortran' - else - val_compiler=basename(val_compiler) - endif - if( specified('fc').and.specified('compiler') )then - write(stdout,'(a)')& - &' --fc and --compiler are aliases and should not both ', & - &' be specified. Using '//val_compiler - endif - - if(.not.is_fortran_name(val_compiler))then - stop ' compiler names must be simple names' - endif - - val_build=trim(merge('release','debug ',lget('release'))) + + val_compiler=sget('compiler') + if(val_compiler.eq.'') then + val_compiler='gfortran' + endif + + val_build=trim(merge('release','debug ',lget('release'))) end subroutine check_build_vals @@ -414,12 +396,14 @@ contains ' '] help_list_dash = [character(len=80) :: & ' ', & - ' build [-fc compiler] [--release] [--list] ', & + ' build [--compiler COMPILER_NAME] [--release] [--list] ', & ' help [NAME(s)] ', & ' new NAME [--lib|--src] [--app] [--test] [--backfill] ', & ' list [--list] ', & - ' run [NAME(s)] [--release] [--runner "CMD"] [--list] [--fc compiler] [-- ARGS] ', & - ' test [NAME(s)] [--release] [--runner "CMD"] [--list][--fc compiler] [-- ARGS] ', & + ' run [NAME(s)] [--release] [--runner "CMD"] [--list] ', & + ' [--compiler COMPILER_NAME] [-- ARGS] ', & + ' test [NAME(s)] [--release] [--runner "CMD"] [--list] ', & + ' [--compiler COMPILER_NAME] [-- ARGS] ', & ' '] help_usage=[character(len=80) :: & '' ] @@ -515,20 +499,22 @@ contains 'SUBCOMMANDS ', & ' Valid fpm(1) subcommands are: ', & ' ', & - ' build [--release] [--list] [-fc COMPILER] ', & - ' Compile the packages into the "build/" directory. ', & + ' + build Compile the packages into the "build/" directory. ', & + ' + new Create a new Fortran package directory with sample files. ', & + ' + run Run the local package binaries. defaults to all binaries for ', & + ' that release. ', & + ' + test Run the tests. ', & + ' + help Alternate method for displaying subcommand help ', & + ' + list Display brief descriptions of all subcommands. ', & + ' ', & + ' Their syntax is ', & + ' ', & + ' build [--release] [--list] [-compiler COMPILER_NAME] ', & ' new NAME [--lib|--src] [--app] [--test] [--backfill] ', & - ' Create a new Fortran package directory ', & - ' with sample files ', & - ' run [NAME(s)] [--release] [--list] [--runner "CMD"] ', & - ' [--fc COMPILER] [-- ARGS] ', & - ' Run the local package binaries. defaults to all ', & - ' binaries for that release. ', & - ' test [NAME(s)] [--release] [--list] [--runner "CMD"] ', & - ' [--fc COMPILER] [-- ARGS] ', & - ' Run the tests ', & - ' help [NAME(s)] Alternate method for displaying subcommand help ', & - ' list [--list] Display brief descriptions of all subcommands. ', & + ' run|test [NAME(s)] [--release] [--list] [--runner "CMD"] ', & + ' [--compiler COMPILER_NAME] [-- ARGS] ', & + ' help [NAME(s)] ', & + ' list [--list] ', & ' ', & 'SUBCOMMAND OPTIONS ', & ' --release Builds or runs in release mode (versus debug mode). fpm(1)', & @@ -539,11 +525,14 @@ contains ' --list List candidates instead of building or running them. On ', & ' the fpm(1) command this shows a brief list of subcommands.', & ' --runner CMD Provides a command to prefix program execution paths. ', & - ' --fc COMPILER Compiler name. ', & + ' --compiler COMPILER_NAME Compiler name. The environment variable ', & + ' FPM_COMPILER sets the default. ', & ' -- ARGS Arguments to pass to executables. ', & - ' --help Show help text and exit. Valid for all subcommands. ', & - ' --version Show version information and exit. Valid for all ', & - ' subcommands. ', & + ' ', & + 'VALID FOR ALL SUBCOMMANDS ', & + ' --help Show help text and exit ', & + ' --verbose Display additional information when available ', & + ' --version Show version information and exit. ', & ' ', & 'EXAMPLES ', & ' sample commands: ', & @@ -559,7 +548,7 @@ contains ' + The fpm(1) home page is at https://github.com/fortran-lang/fpm ', & ' + Registered fpm(1) packages are at https://fortran-lang.org/packages ', & ' + The fpm(1) TOML file format is described at ', & - ' https://github.com/fortran-lang/fpm/blob/master/manifest-reference.md ', & + ' https://github.com/fortran-lang/fpm/blob/master/manifest-reference.md ', & ''] help_list=[character(len=80) :: & 'NAME ', & @@ -588,7 +577,7 @@ contains ' run(1) - the fpm(1) subcommand to run project applications ', & ' ', & 'SYNOPSIS ', & - ' fpm run [[--target] NAME(s)][--release][-fc compiler ] ', & + ' fpm run [[--target] NAME(s)][--release][--compiler COMPILER_NAME] ', & ' [--runner "CMD"] [--list][-- ARGS] ', & ' ', & ' fpm run --help|--version ', & @@ -602,11 +591,9 @@ contains ' or the programs listed in the "fpm.toml" file. ', & ' --release selects the optimized build instead of the debug ', & ' build. ', & - ' --fc COMPILER Specify a compiler name. The default can be set by the ', & - ' environment variable FPM_FC. If not set, the ', & - ' environment variable FC is used to set the default. ', & - ' If that is not set the name "gfortran" becomes the ', & - ' default. "--compiler" is an alias for "--fc". ', & + ' --compiler COMPILER_NAME Specify a compiler name. The default is ', & + ' "gfortran" unless set by the environment ', & + ' variable FPM_COMPILER. ', & ' --runner CMD A command to prefix the program execution paths with. ', & ' see "fpm help runner" for further details. ', & ' --list list candidates instead of building or running them ', & @@ -622,7 +609,7 @@ contains ' # run default programs in /app or as specified in "fpm.toml" ', & ' # using the compiler command "f90". ', & - ' fpm run -fc f90 ', & + ' fpm run -compiler f90 ', & ' ', & ' # run a specific program and pass arguments to the command ', & ' fpm run mytest -- -x 10 -y 20 --title "my title line" ', & @@ -638,7 +625,7 @@ contains ' build(1) - the fpm(1) subcommand to build a project ', & ' ', & 'SYNOPSIS ', & - ' fpm build [--release][-fc COMPILER] [-list] ', & + ' fpm build [--release][-compiler COMPILER_NAME] [-list] ', & ' ', & ' fpm build --help|--version ', & ' ', & @@ -661,11 +648,9 @@ contains 'OPTIONS ', & ' --release build in build/*_release instead of build/*_debug with ', & ' high optimization instead of full debug options. ', & - ' --fc COMPILER Specify a compiler name. The default can be set by the ', & - ' environment variable FPM_FC. If not set, the ', & - ' environment variable FC is used to set the default. ', & - ' If that is not set the name "gfortran" becomes the ', & - ' default. "--compiler" is an alias for "--fc". ', & + ' --compiler COMPILER_NAME Specify a compiler name. The default is ', & + ' "gfortran" unless set by the environment ', & + ' variable FPM_COMPILER. ', & ' --list list candidates instead of building or running them ', & ' --help print this help and exit ', & ' --version print program version information and exit ', & @@ -787,7 +772,7 @@ contains ' test(1) - the fpm(1) subcommand to run project tests ', & ' ', & 'SYNOPSIS ', & - ' fpm test [[--target] NAME(s)][--release][-fc compiler ] ', & + ' fpm test [[--target] NAME(s)][--release][-compiler COMPILER_NAME ] ', & ' [--runner "CMD"] [--list][-- ARGS] ', & ' ', & ' fpm test --help|--version ', & @@ -801,11 +786,9 @@ contains ' or the tests listed in the "fpm.toml" file. ', & ' --release selects the optimized build instead of the debug ', & ' build. ', & - ' --fc COMPILER Specify a compiler name. The default can be set by the ', & - ' environment variable FPM_FC. If not set, the ', & - ' environment variable FC is used to set the default. ', & - ' If that is not set the name "gfortran" becomes the ', & - ' default. "--compiler" is an alias for "--fc". ', & + ' --compiler COMPILER_NAME Specify a compiler name. The default is ', & + ' "gfortran" unless set by the environment ', & + ' variable FPM_COMPILER. ', & ' --runner CMD A command to prefix the program execution paths with. ', & ' see "fpm help runner" for further details. ', & ' --list list candidates instead of building or running them ', & @@ -820,7 +803,7 @@ contains ' fpm test ', & ' ', & ' # run using compiler command "f90" ', & - ' fpm test -fc f90 ', & + ' fpm test -compiler f90 ', & ' ', & ' # run a specific test and pass arguments to the command ', & ' fpm test mytest -- -x 10 -y 20 --title "my title line" ', & @@ -830,7 +813,7 @@ contains help_install=[character(len=80) :: & ' fpm(1) subcommand "install" ', & ' ', & - ' USAGE: fpm install NAME ', & + ' fpm install NAME ', & '' ] end subroutine set_help diff --git a/fpm/src/fpm_compiler.f90 b/fpm/src/fpm_compiler.f90 new file mode 100644 index 0000000..a16baa3 --- /dev/null +++ b/fpm/src/fpm_compiler.f90 @@ -0,0 +1,198 @@ +module fpm_compiler +use fpm_model, only: fpm_model_t +use fpm_filesystem, only: join_path +public add_compile_flag_defaults + +contains +subroutine add_compile_flag_defaults(build_name,compiler,model) +! Choose compile flags based on cli settings & manifest inputs +character(len=*),intent(in) :: build_name, compiler + +type(fpm_model_t) :: model +! could just be a function to return a string instead of passing model +! but likely to change other components like matching C compiler + +character(len=:),allocatable :: fflags +character(len=:),allocatable :: module_path_switch + +! special reserved names "debug" and "release" are for supported compilers with no user-specified compile or load flags + +! vendor Fortran C Module output Module include OpenMP Free for OSS +! compiler compiler directory directory +! Gnu gfortran gcc -J -I -fopenmp X +! Intel ifort icc -module -I -qopenmp X +! Intel(Windows) ifort icc /module:path /I /Qopenmp X +! Intel oneAPI ifx icx -module -I -qopenmp X +! PGI pgfortran pgcc -module -I -mp X +! NVIDIA nvfortran nvc -module -I -mp X +! LLVM flang flang clang -module -I -mp X +! LFortran lfortran --- ? ? ? X +! Lahey/Futjitsu lfc ? -M -I -openmp ? +! NAG nagfor ? -mdir -I -openmp x +! Cray crayftn craycc -J -I -homp ? +! IBM xlf90 ? -qmoddir -I -qsmp X +! Oracle/Sun ? ? -moddir= -M -xopenmp ? +! Silverfrost FTN95 ftn95 ? ? /MOD_PATH ? ? +! Elbrus ? lcc -J -I -fopenmp ? +! Hewlett Packard ? ? ? ? ? discontinued +! Watcom ? ? ? ? ? discontinued +! PathScale ? ? -module -I -mp discontinued +! G95 ? ? -fmod= -I -fopenmp discontinued +! Open64 ? ? -module -I -mp discontinued +! Unisys ? ? ? ? ? discontinued + + select case(build_name//'_'//compiler) + + case('release_gfortran') + module_path_switch='-J ' + fflags='& + & -O3& + & -Wimplicit-interface& + & -fPIC& + & -fmax-errors=1& + & -ffast-math& + & -funroll-loops& + &' + case('debug_gfortran') + module_path_switch='-J ' + fflags = '& + & -Wall& + & -Wextra& + & -Wimplicit-interface& + & -fPIC -fmax-errors=1& + & -g& + & -fbounds-check& + & -fcheck-array-temporaries& + & -fbacktrace& + &' + + case('release_f95') + module_path_switch='-J ' + fflags='& + & -O3& + & -Wimplicit-interface& + & -fPIC& + & -fmax-errors=1& + & -ffast-math& + & -funroll-loops& + &' + case('debug_f95') + module_path_switch='-J ' + fflags = '& + & -Wall& + & -Wextra& + & -Wimplicit-interface& + & -fPIC -fmax-errors=1& + & -g& + & -fbounds-check& + & -fcheck-array-temporaries& + & -Wno-maybe-uninitialized -Wno-uninitialized& + & -fbacktrace& + &' + + case('release_nvfortran') + module_path_switch='-module ' + fflags = '& + & -Mbackslash& + &' + case('debug_nvfortran') + module_path_switch='-module ' + fflags = '& + & -Minform=inform& + & -Mbackslash& + & -g& + & -Mbounds& + & -Mchkptr& + & -Mchkstk& + & -traceback& + &' + + case('release_ifort') + module_path_switch='-module ' + fflags = '& + & -fp-model precise& + & -pc 64& + & -align all& + & -error-limit 1& + & -reentrancy threaded& + & -nogen-interfaces& + & -assume byterecl& + & -assume nounderscore& + &' + case('debug_ifort') + module_path_switch='-module ' + fflags = '& + & -warn all& + & -check all& + & -error-limit 1& + & -O0& + & -g& + & -assume byterecl& + & -traceback& + &' + case('release_ifx') + module_path_switch='-module ' + fflags = ' ' + case('debug_ifx') + module_path_switch='-module ' + fflags = ' ' + + case('release_pgfortran','release_pgf90','release_pgf95') ! Portland Group F90/F95 compilers + module_path_switch='-module ' + fflags = ' ' + case('debug_pgfortran','debug_pgf90','debug_pgf95') ! Portland Group F90/F95 compilers + module_path_switch='-module ' + fflags = ' ' + + case('release_flang') + module_path_switch='-module ' + fflags = ' ' + case('debug_flang') + module_path_switch='-module ' + fflags = ' ' + + case('release_lfc') + module_path_switch='-M ' + fflags = ' ' + case('debug_lfc') + module_path_switch='-M ' + fflags = ' ' + + case('release_nagfor') + module_path_switch='-mdir ' + fflags = ' ' + case('debug_nagfor') + module_path_switch='-mdir ' + fflags = ' ' + + case('release_crayftn') + module_path_switch='-J ' + fflags = ' ' + case('debug_crayftn') + module_path_switch='-J ' + fflags = ' ' + + case('release_xlf90') + module_path_switch='-qmoddir ' + fflags = ' ' + case('debug_xlf90') + module_path_switch='-qmoddir ' + fflags = ' ' + + case default + module_path_switch='-module ' + fflags = ' ' + write(*,*)' unknown compiler (',compiler,')' + write(*,*)' and build name (',build_name,')' + write(*,*)' combination.' + write(*,*)' known compilers are gfortran, nvfortran, ifort' + end select + +! NOTE THAT MODULE_PATH_SWITCH IS ASSUMED TO CONTAIN REQUIRED TRAILING SPACE IF NEEDED +! so that values that do not require a space such as -moddir= will work + model%fortran_compile_flags = fflags//' '//& + & module_path_switch//join_path(model%output_directory,model%package_name) + +end subroutine add_compile_flag_defaults + +end module fpm_compiler diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index 77b22d1..ce0867e 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -38,7 +38,7 @@ function basename(path,suffix) result (base) endif else call split(path,file_parts,delimiters='\/.') - if(size(file_parts).gt.0)then + if(size(file_parts).ge.2)then base = trim(file_parts(size(file_parts)-1)) else base = '' -- cgit v1.2.3 From 51b0eda808b34403a61431d40b4966fe7f8b31cf Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Sun, 29 Nov 2020 22:51:30 -0500 Subject: new M_CLI2 --- fpm/fpm.toml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/fpm.toml b/fpm/fpm.toml index 5c61402..5768ff4 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -12,7 +12,7 @@ tag = "v0.2.1" [dependencies.M_CLI2] git = "https://github.com/urbanjost/M_CLI2.git" -rev = "a77fabf52a781613609f6a8c80ca5d5f8f30f97c" +rev = "e59fb2bfcf36199f1af506f937b3849180454a0f" [[test]] name = "cli-test" -- cgit v1.2.3 From 95cab05240361963b0e5f6ae588f1875de4d2015 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Wed, 2 Dec 2020 18:03:05 -0500 Subject: errata --- fpm/src/fpm_command_line.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index dd50200..2e93366 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -504,7 +504,7 @@ contains ' + run Run the local package binaries. defaults to all binaries for ', & ' that release. ', & ' + test Run the tests. ', & - ' + help Alternate method for displaying subcommand help ', & + ' + help Alternate method for displaying subcommand help. ', & ' + list Display brief descriptions of all subcommands. ', & ' ', & ' Their syntax is ', & -- cgit v1.2.3 From 9ec84e35b7bb32a55774370d928cf3f13913900f Mon Sep 17 00:00:00 2001 From: urbanjost Date: Thu, 3 Dec 2020 18:42:19 -0500 Subject: Update fpm/src/fpm_command_line.f90 Co-authored-by: Laurence Kedward --- fpm/src/fpm_command_line.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index dd50200..b25d477 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -509,7 +509,7 @@ contains ' ', & ' Their syntax is ', & ' ', & - ' build [--release] [--list] [-compiler COMPILER_NAME] ', & + ' build [--release] [--list] [--compiler COMPILER_NAME] ', & ' new NAME [--lib|--src] [--app] [--test] [--backfill] ', & ' run|test [NAME(s)] [--release] [--list] [--runner "CMD"] ', & ' [--compiler COMPILER_NAME] [-- ARGS] ', & -- cgit v1.2.3 From d4aadcf14421420742d59bb05a6ce15e64ab56a3 Mon Sep 17 00:00:00 2001 From: urbanjost Date: Thu, 3 Dec 2020 18:42:59 -0500 Subject: Update fpm/src/fpm_command_line.f90 Co-authored-by: Laurence Kedward --- fpm/src/fpm_command_line.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index b25d477..5632f82 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -402,7 +402,7 @@ contains ' list [--list] ', & ' run [NAME(s)] [--release] [--runner "CMD"] [--list] ', & ' [--compiler COMPILER_NAME] [-- ARGS] ', & - ' test [NAME(s)] [--release] [--runner "CMD"] [--list] ', & + ' test [[--target] NAME(s)] [--release] [--runner "CMD"] [--list] ', & ' [--compiler COMPILER_NAME] [-- ARGS] ', & ' '] help_usage=[character(len=80) :: & -- cgit v1.2.3 From 8b9438e426567c276c224fde2a58417b29b79aa3 Mon Sep 17 00:00:00 2001 From: urbanjost Date: Thu, 3 Dec 2020 18:43:53 -0500 Subject: Update fpm/src/fpm_command_line.f90 Co-authored-by: Laurence Kedward --- fpm/src/fpm_command_line.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 5632f82..1143a25 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -772,7 +772,7 @@ contains ' test(1) - the fpm(1) subcommand to run project tests ', & ' ', & 'SYNOPSIS ', & - ' fpm test [[--target] NAME(s)][--release][-compiler COMPILER_NAME ] ', & + ' fpm test [[--target] NAME(s)][--release][--compiler COMPILER_NAME ] ', & ' [--runner "CMD"] [--list][-- ARGS] ', & ' ', & ' fpm test --help|--version ', & -- cgit v1.2.3 From 09872623ca1303dfe85a18b2fd2e9a18a08b7b13 Mon Sep 17 00:00:00 2001 From: urbanjost Date: Thu, 3 Dec 2020 18:44:21 -0500 Subject: Update fpm/src/fpm_command_line.f90 Co-authored-by: Laurence Kedward --- fpm/src/fpm_command_line.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 1143a25..d50b6d5 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -609,7 +609,7 @@ contains ' # run default programs in /app or as specified in "fpm.toml" ', & ' # using the compiler command "f90". ', & - ' fpm run -compiler f90 ', & + ' fpm run --compiler f90 ', & ' ', & ' # run a specific program and pass arguments to the command ', & ' fpm run mytest -- -x 10 -y 20 --title "my title line" ', & -- cgit v1.2.3 From 49e41483795b3582f101bda55905c595a7de3db4 Mon Sep 17 00:00:00 2001 From: urbanjost Date: Thu, 3 Dec 2020 18:44:47 -0500 Subject: Update fpm/src/fpm_compiler.f90 Co-authored-by: Laurence Kedward --- fpm/src/fpm_compiler.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm_compiler.f90 b/fpm/src/fpm_compiler.f90 index a16baa3..2dd520f 100644 --- a/fpm/src/fpm_compiler.f90 +++ b/fpm/src/fpm_compiler.f90 @@ -8,7 +8,7 @@ subroutine add_compile_flag_defaults(build_name,compiler,model) ! Choose compile flags based on cli settings & manifest inputs character(len=*),intent(in) :: build_name, compiler -type(fpm_model_t) :: model +type(fpm_model_t), intent(inout) :: model ! could just be a function to return a string instead of passing model ! but likely to change other components like matching C compiler -- cgit v1.2.3 From 717d648723d40b53035fbd8bcf775e91135d3f56 Mon Sep 17 00:00:00 2001 From: urbanjost Date: Thu, 3 Dec 2020 18:45:19 -0500 Subject: Update fpm/src/fpm_command_line.f90 Co-authored-by: Laurence Kedward --- fpm/src/fpm_command_line.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index d50b6d5..7a27787 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -511,8 +511,8 @@ contains ' ', & ' build [--release] [--list] [--compiler COMPILER_NAME] ', & ' new NAME [--lib|--src] [--app] [--test] [--backfill] ', & - ' run|test [NAME(s)] [--release] [--list] [--runner "CMD"] ', & - ' [--compiler COMPILER_NAME] [-- ARGS] ', & + ' run|test [[--target] NAME(s)] [--release] [--list] ', & + ' [--runner "CMD"] [--compiler COMPILER_NAME] [-- ARGS] ', & ' help [NAME(s)] ', & ' list [--list] ', & ' ', & -- cgit v1.2.3 From 1f785c58ba0e8859657c0b55cfa9e9de5ae4416d Mon Sep 17 00:00:00 2001 From: urbanjost Date: Thu, 3 Dec 2020 18:45:39 -0500 Subject: Update fpm/src/fpm_command_line.f90 Co-authored-by: Laurence Kedward --- fpm/src/fpm_command_line.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 7a27787..0ee167a 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -803,7 +803,7 @@ contains ' fpm test ', & ' ', & ' # run using compiler command "f90" ', & - ' fpm test -compiler f90 ', & + ' fpm test --compiler f90 ', & ' ', & ' # run a specific test and pass arguments to the command ', & ' fpm test mytest -- -x 10 -y 20 --title "my title line" ', & -- cgit v1.2.3 From 87b9dfff20745706aae40043bfee45c167477c04 Mon Sep 17 00:00:00 2001 From: urbanjost Date: Thu, 3 Dec 2020 18:46:11 -0500 Subject: Update fpm/src/fpm_command_line.f90 Co-authored-by: Laurence Kedward --- fpm/src/fpm_command_line.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 0ee167a..f8d69e8 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -625,7 +625,7 @@ contains ' build(1) - the fpm(1) subcommand to build a project ', & ' ', & 'SYNOPSIS ', & - ' fpm build [--release][-compiler COMPILER_NAME] [-list] ', & + ' fpm build [--release][--compiler COMPILER_NAME] [-list] ', & ' ', & ' fpm build --help|--version ', & ' ', & -- cgit v1.2.3 From 022a587ac64c7e78c89885e7a09050208cc98296 Mon Sep 17 00:00:00 2001 From: urbanjost Date: Thu, 3 Dec 2020 18:46:32 -0500 Subject: Update fpm/src/fpm_command_line.f90 Co-authored-by: Laurence Kedward --- fpm/src/fpm_command_line.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index f8d69e8..e15181c 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -400,7 +400,7 @@ contains ' help [NAME(s)] ', & ' new NAME [--lib|--src] [--app] [--test] [--backfill] ', & ' list [--list] ', & - ' run [NAME(s)] [--release] [--runner "CMD"] [--list] ', & + ' run [[--target] NAME(s)] [--release] [--runner "CMD"] [--list] ', & ' [--compiler COMPILER_NAME] [-- ARGS] ', & ' test [[--target] NAME(s)] [--release] [--runner "CMD"] [--list] ', & ' [--compiler COMPILER_NAME] [-- ARGS] ', & -- cgit v1.2.3 From 6371552a374c1afb274efaf3e7e73d118a460764 Mon Sep 17 00:00:00 2001 From: urbanjost Date: Thu, 3 Dec 2020 18:47:04 -0500 Subject: Update fpm/src/fpm_command_line.f90 Co-authored-by: Laurence Kedward --- fpm/src/fpm_command_line.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index e15181c..fa34d0a 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -349,7 +349,7 @@ contains if(ii .gt. 0 .and. len(lines).gt. 0) then write(stdout,'(g0)')(trim(lines(iii)), iii=1, ii) else - write(stdout,'(a)')' *printhelp* output requested is empty' endif endif end subroutine printhelp -- cgit v1.2.3 From d1b0d4c2dd1fb2078faf0abd7a7eddd791996b75 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Thu, 3 Dec 2020 22:12:23 -0500 Subject: Add test program for help subcommand and correct 'fpm help build' --- fpm/src/fpm_command_line.f90 | 2 +- fpm/test/help_test/help_test.f90 | 235 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 236 insertions(+), 1 deletion(-) create mode 100644 fpm/test/help_test/help_test.f90 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(*,*)'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(*,*)'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(*,*)''//trim(message) + endif +else + write(*,*)''//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 -- cgit v1.2.3 From add0d607aea2e7ce2e04dd3161b549f4210224fc Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Thu, 3 Dec 2020 22:44:47 -0500 Subject: add help test to fpm.toml --- fpm/fpm.toml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/fpm/fpm.toml b/fpm/fpm.toml index 5768ff4..3952514 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -28,3 +28,8 @@ main = "new_test.f90" name = "fpm-test" source-dir = "test/fpm_test" main = "main.f90" + +[[test]] +name = "help-test" +source-dir = "test/help_test" +main = "help_test.f90" -- cgit v1.2.3 From c86c34f76a1bcfecafb1f4f629d4202e368aa07e Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Thu, 3 Dec 2020 23:10:39 -0500 Subject: local ffpm changed to fpm --- fpm/test/help_test/help_test.f90 | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/fpm/test/help_test/help_test.f90 b/fpm/test/help_test/help_test.f90 index 13cdb4c..5c72080 100644 --- a/fpm/test/help_test/help_test.f90 +++ b/fpm/test/help_test/help_test.f90 @@ -14,21 +14,21 @@ 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',& +'fpm --help > fpm_scratch_help.txt',& +'fpm help new >> fpm_scratch_help.txt',& +'fpm build --help >> fpm_scratch_help.txt',& +'fpm help run >> fpm_scratch_help.txt',& +'fpm help test >> fpm_scratch_help.txt',& +'fpm help runner >> fpm_scratch_help.txt',& +'fpm help list >> fpm_scratch_help.txt',& +'fpm help help >> fpm_scratch_help.txt',& +'fpm --version >> fpm_scratch_help.txt',& ! generate manual -'ffpm help manual > fpm_scratch_manual.txt'] +'fpm help manual > fpm_scratch_manual.txt'] -!'ffpm >> fpm_scratch_help.txt',& -!'ffpm --list >> fpm_scratch_help.txt',& -!'ffpm list --list >> fpm_scratch_help.txt',& +!'fpm >> fpm_scratch_help.txt',& +!'fpm --list >> fpm_scratch_help.txt',& +!'fpm 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' @@ -40,7 +40,7 @@ character(len=*),parameter :: names(*)=[character(len=10) :: 'fpm','new','build' ! 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' + path= 'fpm 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) -- cgit v1.2.3 From e21401169ec8df08c748b5b4e29530a2df454f29 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Thu, 3 Dec 2020 23:19:40 -0500 Subject: errata in help --- fpm/src/fpm_command_line.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index d65296d..da885f9 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -467,8 +467,8 @@ contains ' # generates commands of the form "cp $FILENAME /usr/local/bin/" ', & ' ', & ' # bash(1) alias example: ', & - ' alias fpm-install="ffpm run --release --runner \ ', & - ' ''install -vbp -m 0711 -t ~/.local/bin''" ', & + ' alias fpm-install=\ ', & + ' "fpm run --release --runner ''install -vbp -m 0711 -t ~/.local/bin''" ', & ' fpm-install ', & '' ] help_fpm=[character(len=80) :: & -- cgit v1.2.3 From 71b2a2aa644772a9ceae551cde0e6f1f7040c3af Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Fri, 4 Dec 2020 00:23:43 -0500 Subject: new fpm not in path. use "fpm run" --- fpm/test/help_test/help_test.f90 | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/fpm/test/help_test/help_test.f90 b/fpm/test/help_test/help_test.f90 index 5c72080..f73a4f5 100644 --- a/fpm/test/help_test/help_test.f90 +++ b/fpm/test/help_test/help_test.f90 @@ -14,21 +14,21 @@ 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 -'fpm --help > fpm_scratch_help.txt',& -'fpm help new >> fpm_scratch_help.txt',& -'fpm build --help >> fpm_scratch_help.txt',& -'fpm help run >> fpm_scratch_help.txt',& -'fpm help test >> fpm_scratch_help.txt',& -'fpm help runner >> fpm_scratch_help.txt',& -'fpm help list >> fpm_scratch_help.txt',& -'fpm help help >> fpm_scratch_help.txt',& -'fpm --version >> fpm_scratch_help.txt',& +'fpm run -- --help > fpm_scratch_help.txt',& +'fpm run -- help new >> fpm_scratch_help.txt',& +'fpm run -- build --help >> fpm_scratch_help.txt',& +'fpm run -- help run >> fpm_scratch_help.txt',& +'fpm run -- help test >> fpm_scratch_help.txt',& +'fpm run -- help runner >> fpm_scratch_help.txt',& +'fpm run -- help list >> fpm_scratch_help.txt',& +'fpm run -- help help >> fpm_scratch_help.txt',& +'fpm run -- --version >> fpm_scratch_help.txt',& ! generate manual -'fpm help manual > fpm_scratch_manual.txt'] +'fpm run -- help manual > fpm_scratch_manual.txt'] -!'fpm >> fpm_scratch_help.txt',& -!'fpm --list >> fpm_scratch_help.txt',& -!'fpm list --list >> fpm_scratch_help.txt',& +!'fpm run >> fpm_scratch_help.txt',& +!'fpm run -- --list >> fpm_scratch_help.txt',& +!'fpm run -- 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' @@ -40,7 +40,7 @@ character(len=*),parameter :: names(*)=[character(len=10) :: 'fpm','new','build' ! check that output has NAME SYNOPSIS DESCRIPTION do i=1,size(names) write(*,*)'check '//names(i)//' for NAME SYNOPSIS DESCRIPTION' - path= 'fpm help '//names(i)//' >fpm_scratch_help.txt' + path= 'fpm run -- 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) -- cgit v1.2.3 From 68e4946510cfed8c79434ac04ed690e474215dd5 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Fri, 4 Dec 2020 00:37:22 -0500 Subject: remove unused variables --- fpm/test/help_test/help_test.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/fpm/test/help_test/help_test.f90 b/fpm/test/help_test/help_test.f90 index f73a4f5..8d5437e 100644 --- a/fpm/test/help_test/help_test.f90 +++ b/fpm/test/help_test/help_test.f90 @@ -1,7 +1,7 @@ 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 :: i, j integer :: be, af character(len=:),allocatable :: path integer :: estat, cstat @@ -131,7 +131,7 @@ 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 +integer :: nchars, igetunit, ios character(len=256) :: message character(len=4096) :: local_filename ios=0 -- cgit v1.2.3 From 7b8d1dcf1ba8ad2ae7a0090bd07ebaf366145c82 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Fri, 4 Dec 2020 08:46:36 -0500 Subject: remove compare of built manual and manual --- fpm/test/help_test/help_test.f90 | 64 ++++++++++++++++++++++++---------------- 1 file changed, 38 insertions(+), 26 deletions(-) diff --git a/fpm/test/help_test/help_test.f90 b/fpm/test/help_test/help_test.f90 index 8d5437e..ad5d3a9 100644 --- a/fpm/test/help_test/help_test.f90 +++ b/fpm/test/help_test/help_test.f90 @@ -1,14 +1,15 @@ program help_test use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit implicit none -integer :: i, j +integer :: i 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(:) +!intel_bug!character(len=:),allocatable :: page1(:) +character(len=132),allocatable :: page1(:) integer :: lines integer :: chars ! run a variety of "fpm help" variations and verify expected files are generated @@ -31,7 +32,7 @@ character(len=*),parameter :: cmds(*) = [character(len=80) :: & !'fpm run -- 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' + write(*,'(g0:,1x)')'TEST help SUBCOMMAND STARTED' if(allocated(tally))deallocate(tally) allocate(tally(0)) call wipe('fpm_scratch_help.txt') @@ -39,11 +40,11 @@ character(len=*),parameter :: names(*)=[character(len=10) :: 'fpm','new','build' ! check that output has NAME SYNOPSIS DESCRIPTION do i=1,size(names) - write(*,*)'check '//names(i)//' for NAME SYNOPSIS DESCRIPTION' + write(*,*)'check '//names(i)//' for NAME SYNOPSIS DESCRIPTION' path= 'fpm run -- 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) + 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 @@ -61,7 +62,7 @@ character(len=*),parameter :: names(*)=[character(len=10) :: 'fpm','new','build' write(*,*)'missing expected sections in ',names(i) write(*,'(a)')page1 endif - write(*,*)'have completed ',count(tally),' tests' + write(*,*)'have completed ',count(tally),' tests' call wipe('fpm_scratch_help.txt') call wipe('fpm_scratch_manual.txt') enddo @@ -72,42 +73,49 @@ character(len=*),parameter :: names(*)=[character(len=10) :: 'fpm','new','build' 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) + 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 + write(*,*)'book1 ',size(book1), len(book1) + write(*,*)'book2 ',size(book2), len(book2) + !if(size(book1).ne.size(book2))then + ! write(*,*)'manual and appended pages are not the same size' + ! tally=[tally,.false.] + !else + ! 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 + !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 + write(*,*)'manual is suspiciously small, bytes=',chars,' lines=',lines tally=[tally,.false.] else - write(*,*)'manual size is bytes=',chars,' lines=',lines + write(*,*)'manual size is bytes=',chars,' lines=',lines tally=[tally,.true.] endif - write(*,'("HELP TEST TALLY=",*(g0))')tally + write(*,'("HELP TEST TALLY=",*(g0))')tally + call wipe('fpm_scratch_help.txt') + call wipe('fpm_scratch_manual.txt') if(all(tally))then - write(*,'(*(g0))')'PASSED: all ',count(tally),' tests passed ' + write(*,'(*(g0))')'PASSED: all ',count(tally),' tests passed ' else - write(*,*)'FAILED: PASSED=',count(tally),' FAILED=',count(.not.tally) + 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' + write(*,'(g0:,1x)')'TEST help SUBCOMMAND COMPLETE' contains subroutine wipe(filename) @@ -168,13 +176,14 @@ 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 +!intel-bug!character(len=:),allocatable,intent(out) :: pageout(:) ! page to hold file in memory +character(len=132),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 + write(*,*)'*swallow* failed to load file '//FILENAME else ! convert array of characters to array of lines pageout=page(text) deallocate(text) ! release memory @@ -186,7 +195,8 @@ 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(:) +!intel-bug!character(len=:),allocatable :: table(:) +character(len=132),allocatable :: table(:) integer :: i integer :: linelength integer :: length @@ -216,7 +226,8 @@ character(len=1),parameter :: nl=char(10) endif if(allocated(table))deallocate(table) - allocate(character(len=linelength) :: table(lines)) + !intel-bug!allocate(character(len=linelength) :: table(lines)) + allocate(character(len=132) :: table(lines)) table=' ' linecount=1 @@ -226,6 +237,7 @@ character(len=1),parameter :: nl=char(10) linecount=linecount+1 position=1 elseif(linelength.ne.0)then + write(*,*)'',linecount,position,array(i) table(linecount)(position:position)=array(i) position=position+1 endif -- cgit v1.2.3 From ee130ab59e3d052757b525aa114d71b6c7f70e0f Mon Sep 17 00:00:00 2001 From: urbanjost Date: Fri, 4 Dec 2020 08:50:48 -0500 Subject: Update fpm/src/fpm_compiler.f90 Co-authored-by: Laurence Kedward --- fpm/src/fpm_compiler.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/fpm/src/fpm_compiler.f90 b/fpm/src/fpm_compiler.f90 index 2dd520f..ffdb80c 100644 --- a/fpm/src/fpm_compiler.f90 +++ b/fpm/src/fpm_compiler.f90 @@ -52,6 +52,7 @@ character(len=:),allocatable :: module_path_switch & -fmax-errors=1& & -ffast-math& & -funroll-loops& + & -fcoarray=single& &' case('debug_gfortran') module_path_switch='-J ' -- cgit v1.2.3 From a3111ca2d223624617a91bb1c5025e9e078de691 Mon Sep 17 00:00:00 2001 From: urbanjost Date: Fri, 4 Dec 2020 08:51:30 -0500 Subject: Update fpm/src/fpm_compiler.f90 Co-authored-by: Laurence Kedward --- fpm/src/fpm_compiler.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/fpm/src/fpm_compiler.f90 b/fpm/src/fpm_compiler.f90 index ffdb80c..2dae4b6 100644 --- a/fpm/src/fpm_compiler.f90 +++ b/fpm/src/fpm_compiler.f90 @@ -65,6 +65,7 @@ character(len=:),allocatable :: module_path_switch & -fbounds-check& & -fcheck-array-temporaries& & -fbacktrace& + & -fcoarray=single& &' case('release_f95') -- cgit v1.2.3 From 388dbe5b379eb46e3bbf22f79cf4ba8fee09ce0e Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Fri, 4 Dec 2020 09:04:55 -0500 Subject: debug mingw --- fpm/test/help_test/help_test.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/fpm/test/help_test/help_test.f90 b/fpm/test/help_test/help_test.f90 index ad5d3a9..e6b2312 100644 --- a/fpm/test/help_test/help_test.f90 +++ b/fpm/test/help_test/help_test.f90 @@ -237,7 +237,6 @@ character(len=1),parameter :: nl=char(10) linecount=linecount+1 position=1 elseif(linelength.ne.0)then - write(*,*)'',linecount,position,array(i) table(linecount)(position:position)=array(i) position=position+1 endif -- cgit v1.2.3 From 9fdc865d23bd49a687c8ae13d6142b9b351f554b Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Fri, 4 Dec 2020 09:27:13 -0500 Subject: add caf case to fpm_compiler.f90; debug mingw help_test.f90 --- fpm/src/fpm_compiler.f90 | 22 ++++++++++++++++++++++ fpm/test/help_test/help_test.f90 | 14 +++++++++----- 2 files changed, 31 insertions(+), 5 deletions(-) diff --git a/fpm/src/fpm_compiler.f90 b/fpm/src/fpm_compiler.f90 index 2dae4b6..c3e2cfe 100644 --- a/fpm/src/fpm_compiler.f90 +++ b/fpm/src/fpm_compiler.f90 @@ -43,6 +43,28 @@ character(len=:),allocatable :: module_path_switch select case(build_name//'_'//compiler) + case('release_caf') + module_path_switch='-J ' + fflags='& + & -O3& + & -Wimplicit-interface& + & -fPIC& + & -fmax-errors=1& + & -ffast-math& + & -funroll-loops& + &' + case('debug_caf') + module_path_switch='-J ' + fflags = '& + & -Wall& + & -Wextra& + & -Wimplicit-interface& + & -fPIC -fmax-errors=1& + & -g& + & -fbounds-check& + & -fcheck-array-temporaries& + & -fbacktrace& + &' case('release_gfortran') module_path_switch='-J ' fflags='& diff --git a/fpm/test/help_test/help_test.f90 b/fpm/test/help_test/help_test.f90 index e6b2312..c489018 100644 --- a/fpm/test/help_test/help_test.f90 +++ b/fpm/test/help_test/help_test.f90 @@ -1,7 +1,7 @@ program help_test use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit implicit none -integer :: i +integer :: i, j integer :: be, af character(len=:),allocatable :: path integer :: estat, cstat @@ -54,13 +54,17 @@ character(len=*),parameter :: names(*)=[character(len=10) :: 'fpm','new','build' 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)] + tally=[tally,count(page1.eq.'NAME').eq.1] + tally=[tally,count(page1.eq.'SYNOPSIS').eq.1] + tally=[tally,count(page1.eq.'DESCRIPTION').eq.1] af=count(.not.tally) if(be.ne.af)then write(*,*)'missing expected sections in ',names(i) - write(*,'(a)')page1 + 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(*,'(a)')(trim(page1(j)),j=1,size(page1)) endif write(*,*)'have completed ',count(tally),' tests' call wipe('fpm_scratch_help.txt') -- cgit v1.2.3 From 76047363a625e9e4fbb90403050c29d070a5c126 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Fri, 4 Dec 2020 09:54:30 -0500 Subject: workaround for old compiler --- fpm/test/help_test/help_test.f90 | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/fpm/test/help_test/help_test.f90 b/fpm/test/help_test/help_test.f90 index c489018..c7c62ee 100644 --- a/fpm/test/help_test/help_test.f90 +++ b/fpm/test/help_test/help_test.f90 @@ -54,9 +54,13 @@ character(len=*),parameter :: names(*)=[character(len=10) :: 'fpm','new','build' endif !!write(*,*)findloc(page1,'NAME').eq.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] + !!mingw bug this returns 0 + !!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,bugcount(page1,'NAME').eq.1] + tally=[tally,bugcount(page1,'SYNOPSIS').eq.1] + tally=[tally,bugcount(page1,'DESCRIPTION').eq.1] af=count(.not.tally) if(be.ne.af)then write(*,*)'missing expected sections in ',names(i) @@ -122,6 +126,17 @@ character(len=*),parameter :: names(*)=[character(len=10) :: 'fpm','new','build' write(*,'(g0:,1x)')'TEST help SUBCOMMAND COMPLETE' contains +function bugcount(page,string) +character(len=*),intent(in) :: page(:) +character(len=*),intent(in) :: string +integer :: bugcount +integer :: i +bugcount=0 + do i = 1,size(page) + if(page(i).eq.string)bugcount=bugcount+1 + enddo +end function bugcount + subroutine wipe(filename) character(len=*),intent(in) :: filename integer :: ios -- cgit v1.2.3 From 88389c926ee095e8fa35cbd37bfbc2e794b8b412 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Fri, 4 Dec 2020 10:19:46 -0500 Subject: debugging mingw --- fpm/test/help_test/help_test.f90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/fpm/test/help_test/help_test.f90 b/fpm/test/help_test/help_test.f90 index c7c62ee..fd0a3c9 100644 --- a/fpm/test/help_test/help_test.f90 +++ b/fpm/test/help_test/help_test.f90 @@ -15,6 +15,7 @@ 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 +'fpm run -- --version ',& ! verify fpm version being used 'fpm run -- --help > fpm_scratch_help.txt',& 'fpm run -- help new >> fpm_scratch_help.txt',& 'fpm run -- build --help >> fpm_scratch_help.txt',& @@ -247,8 +248,13 @@ character(len=1),parameter :: nl=char(10) if(allocated(table))deallocate(table) !intel-bug!allocate(character(len=linelength) :: table(lines)) allocate(character(len=132) :: table(lines)) + !!----------------------------------------------------------- table=' ' - + !!possible bug in mingw. null filled instead of space padded? + do i=1,lines + table(i)=repeat(' ',len(table)) + enddo + !!----------------------------------------------------------- linecount=1 position=1 do i=1,sz -- cgit v1.2.3 From c96e244379407fc566dadba57344c782d6fa3d32 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Fri, 4 Dec 2020 10:31:14 -0500 Subject: dos line terminators --- fpm/test/help_test/help_test.f90 | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/fpm/test/help_test/help_test.f90 b/fpm/test/help_test/help_test.f90 index fd0a3c9..4aa625f 100644 --- a/fpm/test/help_test/help_test.f90 +++ b/fpm/test/help_test/help_test.f90 @@ -226,6 +226,7 @@ integer :: position integer :: sz !!character(len=1),parameter :: nl=new_line('A') character(len=1),parameter :: nl=char(10) +character(len=1),parameter :: cr=char(13) lines=0 linelength=0 length=0 @@ -248,19 +249,14 @@ character(len=1),parameter :: nl=char(10) if(allocated(table))deallocate(table) !intel-bug!allocate(character(len=linelength) :: table(lines)) allocate(character(len=132) :: table(lines)) - !!----------------------------------------------------------- table=' ' - !!possible bug in mingw. null filled instead of space padded? - do i=1,lines - table(i)=repeat(' ',len(table)) - enddo - !!----------------------------------------------------------- linecount=1 position=1 do i=1,sz if(array(i).eq.nl)then linecount=linecount+1 position=1 + elseif(array(i).eq.cr)then elseif(linelength.ne.0)then table(linecount)(position:position)=array(i) position=position+1 -- cgit v1.2.3 From 06316651ed41fbf034227cf5e55a9529d3cde1f1 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Fri, 4 Dec 2020 13:17:22 -0500 Subject: remove debug from help-test --- fpm/test/help_test/help_test.f90 | 72 +++++++++++++++++----------------------- 1 file changed, 31 insertions(+), 41 deletions(-) diff --git a/fpm/test/help_test/help_test.f90 b/fpm/test/help_test/help_test.f90 index 4aa625f..1852ba6 100644 --- a/fpm/test/help_test/help_test.f90 +++ b/fpm/test/help_test/help_test.f90 @@ -1,15 +1,15 @@ program help_test use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit implicit none -integer :: i, j +integer :: i 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 :: book1(:), book2(:) !intel_bug!character(len=:),allocatable :: page1(:) -character(len=132),allocatable :: page1(:) +character(len=:),allocatable :: page1(:) integer :: lines integer :: chars ! run a variety of "fpm help" variations and verify expected files are generated @@ -55,13 +55,9 @@ character(len=*),parameter :: names(*)=[character(len=10) :: 'fpm','new','build' endif !!write(*,*)findloc(page1,'NAME').eq.1 be=count(.not.tally) - !!mingw bug this returns 0 - !!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,bugcount(page1,'NAME').eq.1] - tally=[tally,bugcount(page1,'SYNOPSIS').eq.1] - tally=[tally,bugcount(page1,'DESCRIPTION').eq.1] + tally=[tally,count(page1.eq.'NAME').eq.1] + tally=[tally,count(page1.eq.'SYNOPSIS').eq.1] + tally=[tally,count(page1.eq.'DESCRIPTION').eq.1] af=count(.not.tally) if(be.ne.af)then write(*,*)'missing expected sections in ',names(i) @@ -69,7 +65,7 @@ character(len=*),parameter :: names(*)=[character(len=10) :: 'fpm','new','build' write(*,*)count(page1.eq.'NAME') write(*,*)count(page1.eq.'SYNOPSIS') write(*,*)count(page1.eq.'DESCRIPTION') - write(*,'(a)')(trim(page1(j)),j=1,size(page1)) + write(*,'(a)')page1 endif write(*,*)'have completed ',count(tally),' tests' call wipe('fpm_scratch_help.txt') @@ -87,26 +83,31 @@ character(len=*),parameter :: names(*)=[character(len=10) :: 'fpm','new','build' enddo ! compare book written in fragments with manual - call slurp('fpm_scratch_help.txt',book1) - call slurp('fpm_scratch_manual.txt',book2) + 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) write(*,*)'book1 ',size(book1), len(book1) write(*,*)'book2 ',size(book2), len(book2) - !if(size(book1).ne.size(book2))then - ! write(*,*)'manual and appended pages are not the same size' - ! tally=[tally,.false.] - !else - ! 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 - !endif + if(size(book1).ne.size(book2))then + write(*,*)'manual and appended pages are not the same size' + tally=[tally,.false.] + else + 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 + endif ! overall size of manual - chars=size(book2) - lines=max(count(char(10).eq.book2),count(char(13).eq.book2)) + !chars=size(book2) + !lines=max(count(char(10).eq.book2),count(char(13).eq.book2)) + chars=size(book2)*len(book2) + lines=size(book2) if( (chars.lt.13000) .or. (lines.lt.350) )then write(*,*)'manual is suspiciously small, bytes=',chars,' lines=',lines tally=[tally,.false.] @@ -127,17 +128,6 @@ character(len=*),parameter :: names(*)=[character(len=10) :: 'fpm','new','build' write(*,'(g0:,1x)')'TEST help SUBCOMMAND COMPLETE' contains -function bugcount(page,string) -character(len=*),intent(in) :: page(:) -character(len=*),intent(in) :: string -integer :: bugcount -integer :: i -bugcount=0 - do i = 1,size(page) - if(page(i).eq.string)bugcount=bugcount+1 - enddo -end function bugcount - subroutine wipe(filename) character(len=*),intent(in) :: filename integer :: ios @@ -197,7 +187,7 @@ subroutine swallow(FILENAME,pageout) implicit none character(len=*),intent(in) :: FILENAME ! file to read !intel-bug!character(len=:),allocatable,intent(out) :: pageout(:) ! page to hold file in memory -character(len=132),allocatable,intent(out) :: pageout(:) ! page to hold file in memory +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 @@ -216,7 +206,7 @@ function page(array) result (table) character(len=1),intent(in) :: array(:) !intel-bug!character(len=:),allocatable :: table(:) -character(len=132),allocatable :: table(:) +character(len=:),allocatable :: table(:) integer :: i integer :: linelength integer :: length @@ -248,7 +238,7 @@ character(len=1),parameter :: cr=char(13) if(allocated(table))deallocate(table) !intel-bug!allocate(character(len=linelength) :: table(lines)) - allocate(character(len=132) :: table(lines)) + allocate(character(len=linelength) :: table(lines)) table=' ' linecount=1 position=1 -- cgit v1.2.3 From 5de92b8dcf4b27f7701ed941e153763196545374 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Fri, 4 Dec 2020 13:51:46 -0500 Subject: mingw bug --- fpm/test/help_test/help_test.f90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/fpm/test/help_test/help_test.f90 b/fpm/test/help_test/help_test.f90 index 1852ba6..03daa97 100644 --- a/fpm/test/help_test/help_test.f90 +++ b/fpm/test/help_test/help_test.f90 @@ -7,9 +7,10 @@ character(len=:),allocatable :: path integer :: estat, cstat character(len=256) :: message logical,allocatable :: tally(:) -character(len=:),allocatable :: book1(:), book2(:) -!intel_bug!character(len=:),allocatable :: page1(:) -character(len=:),allocatable :: page1(:) +!intel-bug!character(len=:),allocatable :: book1(:), book2(:) +character(len=132),allocatable :: book1(:), book2(:) +!intel-bug!character(len=:),allocatable :: page1(:) +character(len=132),allocatable :: page1(:) integer :: lines integer :: chars ! run a variety of "fpm help" variations and verify expected files are generated @@ -187,7 +188,7 @@ subroutine swallow(FILENAME,pageout) implicit none character(len=*),intent(in) :: FILENAME ! file to read !intel-bug!character(len=:),allocatable,intent(out) :: pageout(:) ! page to hold file in memory -character(len=:),allocatable,intent(out) :: pageout(:) ! page to hold file in memory +character(len=132),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 @@ -206,7 +207,7 @@ function page(array) result (table) character(len=1),intent(in) :: array(:) !intel-bug!character(len=:),allocatable :: table(:) -character(len=:),allocatable :: table(:) +character(len=132),allocatable :: table(:) integer :: i integer :: linelength integer :: length @@ -238,7 +239,7 @@ character(len=1),parameter :: cr=char(13) if(allocated(table))deallocate(table) !intel-bug!allocate(character(len=linelength) :: table(lines)) - allocate(character(len=linelength) :: table(lines)) + allocate(character(len=132) :: table(lines)) table=' ' linecount=1 position=1 -- cgit v1.2.3 From be8f4d228ccd939e381abe4e0cb50cd0178645a9 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Fri, 4 Dec 2020 21:34:52 -0500 Subject: add coarray and less verbose warnings for intel ifort --- fpm/src/fpm_compiler.f90 | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/fpm/src/fpm_compiler.f90 b/fpm/src/fpm_compiler.f90 index c3e2cfe..081c1f7 100644 --- a/fpm/src/fpm_compiler.f90 +++ b/fpm/src/fpm_compiler.f90 @@ -1,5 +1,5 @@ module fpm_compiler -use fpm_model, only: fpm_model_t +use fpm_model, only: fpm_model_t use fpm_filesystem, only: join_path public add_compile_flag_defaults @@ -9,9 +9,9 @@ subroutine add_compile_flag_defaults(build_name,compiler,model) character(len=*),intent(in) :: build_name, compiler type(fpm_model_t), intent(inout) :: model -! could just be a function to return a string instead of passing model +! could just be a function to return a string instead of passing model ! but likely to change other components like matching C compiler - + character(len=:),allocatable :: fflags character(len=:),allocatable :: module_path_switch @@ -43,7 +43,7 @@ character(len=:),allocatable :: module_path_switch select case(build_name//'_'//compiler) - case('release_caf') + case('release_caf') module_path_switch='-J ' fflags='& & -O3& @@ -65,7 +65,7 @@ character(len=:),allocatable :: module_path_switch & -fcheck-array-temporaries& & -fbacktrace& &' - case('release_gfortran') + case('release_gfortran') module_path_switch='-J ' fflags='& & -O3& @@ -137,6 +137,7 @@ character(len=:),allocatable :: module_path_switch & -fp-model precise& & -pc 64& & -align all& + & -coarray& & -error-limit 1& & -reentrancy threaded& & -nogen-interfaces& @@ -147,7 +148,8 @@ character(len=:),allocatable :: module_path_switch module_path_switch='-module ' fflags = '& & -warn all& - & -check all& + & -check:all:noarg_temp_created& + & -coarray& & -error-limit 1& & -O0& & -g& -- cgit v1.2.3 From 0a5953e7683c3284c49ca885c6d2e1f02ab646ac Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Sat, 5 Dec 2020 14:04:08 -0500 Subject: add test with --release switch on run --- fpm/src/fpm_command_line.f90 | 4 +- fpm/test/help_test/help_test.f90 | 125 +++++++++++++++++++++++++++------------ 2 files changed, 89 insertions(+), 40 deletions(-) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index da885f9..2a44a4f 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -489,9 +489,6 @@ contains ' part of your default programming environment, as well as letting ', & ' you share your projects with others in a similar manner. ', & ' ', & - ' See the fpm(1) repository at https://fortran-lang.org/packages/fpm ', & - ' for a listing of registered projects. ', & - ' ', & ' All output goes into the directory "build/" which can generally be ', & ' removed and rebuilt if required. Note that if external packages are ', & ' being used you need network connectivity to rebuild from scratch. ', & @@ -545,6 +542,7 @@ contains ' fpm run myprogram --release -- -x 10 -y 20 --title "my title" ', & ' ', & 'SEE ALSO ', & + ' ', & ' + The fpm(1) home page is at https://github.com/fortran-lang/fpm ', & ' + Registered fpm(1) packages are at https://fortran-lang.org/packages ', & ' + The fpm(1) TOML file format is described at ', & diff --git a/fpm/test/help_test/help_test.f90 b/fpm/test/help_test/help_test.f90 index 03daa97..78b9c81 100644 --- a/fpm/test/help_test/help_test.f90 +++ b/fpm/test/help_test/help_test.f90 @@ -1,14 +1,14 @@ program help_test use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit implicit none -integer :: i +integer :: i, j integer :: be, af character(len=:),allocatable :: path integer :: estat, cstat character(len=256) :: message logical,allocatable :: tally(:) !intel-bug!character(len=:),allocatable :: book1(:), book2(:) -character(len=132),allocatable :: book1(:), book2(:) +character(len=132),allocatable :: book1(:), book2(:), book3(:) !intel-bug!character(len=:),allocatable :: page1(:) character(len=132),allocatable :: page1(:) integer :: lines @@ -16,6 +16,7 @@ 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 +! debug version 'fpm run -- --version ',& ! verify fpm version being used 'fpm run -- --help > fpm_scratch_help.txt',& 'fpm run -- help new >> fpm_scratch_help.txt',& @@ -26,6 +27,17 @@ character(len=*),parameter :: cmds(*) = [character(len=80) :: & 'fpm run -- help list >> fpm_scratch_help.txt',& 'fpm run -- help help >> fpm_scratch_help.txt',& 'fpm run -- --version >> fpm_scratch_help.txt',& +! release version +'fpm run --release -- --version ',& ! verify fpm version being used +'fpm run --release -- --help > fpm_scratch_help3.txt',& +'fpm run --release -- help new >> fpm_scratch_help3.txt',& +'fpm run --release -- build --help >> fpm_scratch_help3.txt',& +'fpm run --release -- help run >> fpm_scratch_help3.txt',& +'fpm run --release -- help test >> fpm_scratch_help3.txt',& +'fpm run --release -- help runner >> fpm_scratch_help3.txt',& +'fpm run --release -- help list >> fpm_scratch_help3.txt',& +'fpm run --release -- help help >> fpm_scratch_help3.txt',& +'fpm run --release -- --version >> fpm_scratch_help3.txt',& ! generate manual 'fpm run -- help manual > fpm_scratch_manual.txt'] @@ -33,44 +45,52 @@ character(len=*),parameter :: cmds(*) = [character(len=80) :: & !'fpm run -- --list >> fpm_scratch_help.txt',& !'fpm run -- list --list >> fpm_scratch_help.txt',& character(len=*),parameter :: names(*)=[character(len=10) :: 'fpm','new','build','run','test','runner','list','help'] +character(len=:),allocatable :: add 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_help3.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= 'fpm run -- 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(*,*)'help for '//names(i)//' ridiculiously small' - tally=[tally,.false.] - exit - endif - !!write(*,*)findloc(page1,'NAME').eq.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] - 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(*,'(a)')page1 + do j=1,2 + if(j.eq.1)then + ADD=' ' + else + ADD=' --release ' endif - write(*,*)'have completed ',count(tally),' tests' - call wipe('fpm_scratch_help.txt') - call wipe('fpm_scratch_manual.txt') + do i=1,size(names) + write(*,*)'check '//names(i)//' for NAME SYNOPSIS DESCRIPTION' + path= 'fpm run '//add//' -- 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(*,*)'help for '//names(i)//' ridiculiously small' + tally=[tally,.false.] + exit + endif + !!write(*,*)findloc(page1,'NAME').eq.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] + 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(*,'(a)')page1 + endif + write(*,*)'have completed ',count(tally),' tests' + call wipe('fpm_scratch_help.txt') + enddo enddo @@ -86,20 +106,35 @@ character(len=*),parameter :: names(*)=[character(len=10) :: 'fpm','new','build' ! compare book written in fragments with manual call swallow('fpm_scratch_help.txt',book1) call swallow('fpm_scratch_manual.txt',book2) + call swallow('fpm_scratch_help3.txt',book3) ! 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) + book3=pack(book3,index(book3,' + build/').eq.0) write(*,*)'book1 ',size(book1), len(book1) write(*,*)'book2 ',size(book2), len(book2) + write(*,*)'book2 ',size(book3), len(book3) if(size(book1).ne.size(book2))then - write(*,*)'manual and appended pages are not the same size' + write(*,*)'manual and "debug" appended pages are not the same size' tally=[tally,.false.] else if(all(book1.ne.book2))then tally=[tally,.false.] - write(*,*)'manual and appended pages are not the same' + write(*,*)'manual and "debug" appended pages are not the same' else - write(*,*)'manual and appended pages are the same' + write(*,*)'manual and "debug" appended pages are the same' + tally=[tally,.true.] + endif + endif + if(size(book3).ne.size(book2))then + write(*,*)'manual and "release" appended pages are not the same size' + tally=[tally,.false.] + else + if(all(book3.ne.book2))then + tally=[tally,.false.] + write(*,*)'manual and "release" appended pages are not the same' + else + write(*,*)'manual and "release" appended pages are the same' tally=[tally,.true.] endif endif @@ -110,15 +145,25 @@ character(len=*),parameter :: names(*)=[character(len=10) :: 'fpm','new','build' chars=size(book2)*len(book2) lines=size(book2) if( (chars.lt.13000) .or. (lines.lt.350) )then - write(*,*)'manual is suspiciously small, bytes=',chars,' lines=',lines + write(*,*)'"debug" manual is suspiciously small, bytes=',chars,' lines=',lines + tally=[tally,.false.] + else + write(*,*)'"debug" manual size is bytes=',chars,' lines=',lines + tally=[tally,.true.] + endif + chars=size(book3)*len(book3) + lines=size(book3) + if( (chars.lt.13000) .or. (lines.lt.350) )then + write(*,*)'"release" manual is suspiciously small, bytes=',chars,' lines=',lines tally=[tally,.false.] else - write(*,*)'manual size is bytes=',chars,' lines=',lines + write(*,*)'"release" manual size is bytes=',chars,' lines=',lines tally=[tally,.true.] endif write(*,'("HELP TEST TALLY=",*(g0))')tally call wipe('fpm_scratch_help.txt') + call wipe('fpm_scratch_help3.txt') call wipe('fpm_scratch_manual.txt') if(all(tally))then write(*,'(*(g0))')'PASSED: all ',count(tally),' tests passed ' @@ -249,7 +294,13 @@ character(len=1),parameter :: cr=char(13) position=1 elseif(array(i).eq.cr)then elseif(linelength.ne.0)then - table(linecount)(position:position)=array(i) + if(position.gt.len(table))then + write(*,*)' adding character past edge of text',table(linecount),array(i) + elseif(linecount.gt.size(table))then + write(*,*)' adding line past end of text',linecount,size(table) + else + table(linecount)(position:position)=array(i) + endif position=position+1 endif enddo -- cgit v1.2.3 From cbdb4be730f7c353fa1a8b989f508df7079e3220 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Sun, 6 Dec 2020 00:37:53 -0500 Subject: nagfor compiler options --- fpm/src/fpm_compiler.f90 | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/fpm/src/fpm_compiler.f90 b/fpm/src/fpm_compiler.f90 index 081c1f7..540b48f 100644 --- a/fpm/src/fpm_compiler.f90 +++ b/fpm/src/fpm_compiler.f90 @@ -186,11 +186,21 @@ character(len=:),allocatable :: module_path_switch case('release_nagfor') module_path_switch='-mdir ' - fflags = ' ' + fflags = ' & + & -O4& + & -coarray=single& + & -PIC& + ' case('debug_nagfor') module_path_switch='-mdir ' - fflags = ' ' - + fflags = '& + & -g& + & -C=all& + & -O0& + & -gline& + & -coarray=single& + & -PIC& + ' case('release_crayftn') module_path_switch='-J ' fflags = ' ' -- cgit v1.2.3 From ad9aee94ae3bc0b9c29af954071058aa4c3f65c2 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Sun, 6 Dec 2020 12:51:33 -0500 Subject: change way module directory is specified per concepts from @awvwgk to make nagfor work --- fpm/src/fpm_compiler.f90 | 67 ++++++++++++++++++++++++------------------------ 1 file changed, 34 insertions(+), 33 deletions(-) diff --git a/fpm/src/fpm_compiler.f90 b/fpm/src/fpm_compiler.f90 index 540b48f..76a91ad 100644 --- a/fpm/src/fpm_compiler.f90 +++ b/fpm/src/fpm_compiler.f90 @@ -12,8 +12,9 @@ type(fpm_model_t), intent(inout) :: model ! could just be a function to return a string instead of passing model ! but likely to change other components like matching C compiler -character(len=:),allocatable :: fflags -character(len=:),allocatable :: module_path_switch +character(len=:),allocatable :: fflags ! optional flags that might be overridden by user +character(len=:),allocatable :: modpath +character(len=:),allocatable :: mandatory ! flags required for fpm to function properly ! special reserved names "debug" and "release" are for supported compilers with no user-specified compile or load flags @@ -40,11 +41,13 @@ character(len=:),allocatable :: module_path_switch ! G95 ? ? -fmod= -I -fopenmp discontinued ! Open64 ? ? -module -I -mp discontinued ! Unisys ? ? ? ? ? discontinued + modpath=join_path(model%output_directory,model%package_name) + fflags='' + mandatory='' select case(build_name//'_'//compiler) case('release_caf') - module_path_switch='-J ' fflags='& & -O3& & -Wimplicit-interface& @@ -53,8 +56,8 @@ character(len=:),allocatable :: module_path_switch & -ffast-math& & -funroll-loops& &' + mandatory=' -J '//modpath//' -I '//modpath ! add module path as apprpriate case('debug_caf') - module_path_switch='-J ' fflags = '& & -Wall& & -Wextra& @@ -65,8 +68,8 @@ character(len=:),allocatable :: module_path_switch & -fcheck-array-temporaries& & -fbacktrace& &' + mandatory=' -J '//modpath//' -I '//modpath ! add module path as apprpriate case('release_gfortran') - module_path_switch='-J ' fflags='& & -O3& & -Wimplicit-interface& @@ -76,8 +79,8 @@ character(len=:),allocatable :: module_path_switch & -funroll-loops& & -fcoarray=single& &' + mandatory=' -J '//modpath//' -I '//modpath ! add module path as apprpriate case('debug_gfortran') - module_path_switch='-J ' fflags = '& & -Wall& & -Wextra& @@ -89,9 +92,9 @@ character(len=:),allocatable :: module_path_switch & -fbacktrace& & -fcoarray=single& &' + mandatory=' -J '//modpath//' -I '//modpath ! add module path as apprpriate case('release_f95') - module_path_switch='-J ' fflags='& & -O3& & -Wimplicit-interface& @@ -100,8 +103,8 @@ character(len=:),allocatable :: module_path_switch & -ffast-math& & -funroll-loops& &' + mandatory=' -J '//modpath//' -I '//modpath ! add module path as apprpriate case('debug_f95') - module_path_switch='-J ' fflags = '& & -Wall& & -Wextra& @@ -113,14 +116,14 @@ character(len=:),allocatable :: module_path_switch & -Wno-maybe-uninitialized -Wno-uninitialized& & -fbacktrace& &' + mandatory=' -J '//modpath//' -I '//modpath ! add module path as apprpriate case('release_nvfortran') - module_path_switch='-module ' fflags = '& & -Mbackslash& &' + mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate case('debug_nvfortran') - module_path_switch='-module ' fflags = '& & -Minform=inform& & -Mbackslash& @@ -130,9 +133,9 @@ character(len=:),allocatable :: module_path_switch & -Mchkstk& & -traceback& &' + mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate case('release_ifort') - module_path_switch='-module ' fflags = '& & -fp-model precise& & -pc 64& @@ -144,8 +147,8 @@ character(len=:),allocatable :: module_path_switch & -assume byterecl& & -assume nounderscore& &' + mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate case('debug_ifort') - module_path_switch='-module ' fflags = '& & -warn all& & -check:all:noarg_temp_created& @@ -156,43 +159,43 @@ character(len=:),allocatable :: module_path_switch & -assume byterecl& & -traceback& &' + mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate case('release_ifx') - module_path_switch='-module ' fflags = ' ' + mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate case('debug_ifx') - module_path_switch='-module ' fflags = ' ' + mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate case('release_pgfortran','release_pgf90','release_pgf95') ! Portland Group F90/F95 compilers - module_path_switch='-module ' fflags = ' ' + mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate case('debug_pgfortran','debug_pgf90','debug_pgf95') ! Portland Group F90/F95 compilers - module_path_switch='-module ' fflags = ' ' + mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate case('release_flang') - module_path_switch='-module ' fflags = ' ' + mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate case('debug_flang') - module_path_switch='-module ' fflags = ' ' + mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate case('release_lfc') - module_path_switch='-M ' fflags = ' ' + mandatory=' -M '//modpath//' -I '//modpath ! add module path as apprpriate case('debug_lfc') - module_path_switch='-M ' fflags = ' ' + mandatory=' -M '//modpath//' -I '//modpath ! add module path as apprpriate case('release_nagfor') - module_path_switch='-mdir ' fflags = ' & & -O4& & -coarray=single& & -PIC& ' + mandatory=' -mdir '//modpath//' -I '//modpath !! add module path as apprpriate case('debug_nagfor') - module_path_switch='-mdir ' fflags = '& & -g& & -C=all& @@ -201,34 +204,32 @@ character(len=:),allocatable :: module_path_switch & -coarray=single& & -PIC& ' + mandatory=' -mdir '//modpath//' -I '//modpath !! add module path as apprpriate case('release_crayftn') - module_path_switch='-J ' fflags = ' ' + mandatory=' -J '//modpath//' -I '//modpath ! add module path as apprpriate case('debug_crayftn') - module_path_switch='-J ' fflags = ' ' + mandatory=' -J '//modpath//' -I '//modpath ! add module path as apprpriate case('release_xlf90') - module_path_switch='-qmoddir ' fflags = ' ' + mandatory=' -qmoddir '//modpath//' -I '//modpath ! add module path as apprpriate case('debug_xlf90') - module_path_switch='-qmoddir ' fflags = ' ' + mandatory=' -qmoddir '//modpath//' -I '//modpath ! add module path as apprpriate case default - module_path_switch='-module ' fflags = ' ' + mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate write(*,*)' unknown compiler (',compiler,')' - write(*,*)' and build name (',build_name,')' + write(*,*)' and build name (',build_name,')' write(*,*)' combination.' write(*,*)' known compilers are gfortran, nvfortran, ifort' end select -! NOTE THAT MODULE_PATH_SWITCH IS ASSUMED TO CONTAIN REQUIRED TRAILING SPACE IF NEEDED -! so that values that do not require a space such as -moddir= will work - model%fortran_compile_flags = fflags//' '//& - & module_path_switch//join_path(model%output_directory,model%package_name) - + model%fortran_compile_flags = fflags//' '//mandatory + end subroutine add_compile_flag_defaults end module fpm_compiler -- cgit v1.2.3 From 125e2e1ad171f3bb49e3f318044281f91dcf691d Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Sun, 6 Dec 2020 14:08:42 -0500 Subject: cleanup errata in fpm_compiler.f90 --- fpm/src/fpm_compiler.f90 | 57 ++++++++++++++++++++-------------------- fpm/test/help_test/help_test.f90 | 30 +++++++++++---------- 2 files changed, 45 insertions(+), 42 deletions(-) diff --git a/fpm/src/fpm_compiler.f90 b/fpm/src/fpm_compiler.f90 index 76a91ad..6336e4e 100644 --- a/fpm/src/fpm_compiler.f90 +++ b/fpm/src/fpm_compiler.f90 @@ -14,7 +14,8 @@ type(fpm_model_t), intent(inout) :: model character(len=:),allocatable :: fflags ! optional flags that might be overridden by user character(len=:),allocatable :: modpath -character(len=:),allocatable :: mandatory ! flags required for fpm to function properly +character(len=:),allocatable :: mandatory ! flags required for fpm to function properly; + ! ie. add module path and module include directory as appropriate ! special reserved names "debug" and "release" are for supported compilers with no user-specified compile or load flags @@ -56,7 +57,7 @@ character(len=:),allocatable :: mandatory ! flags required for fpm to function p & -ffast-math& & -funroll-loops& &' - mandatory=' -J '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -J '//modpath//' -I '//modpath case('debug_caf') fflags = '& & -Wall& @@ -68,7 +69,7 @@ character(len=:),allocatable :: mandatory ! flags required for fpm to function p & -fcheck-array-temporaries& & -fbacktrace& &' - mandatory=' -J '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -J '//modpath//' -I '//modpath case('release_gfortran') fflags='& & -O3& @@ -79,7 +80,7 @@ character(len=:),allocatable :: mandatory ! flags required for fpm to function p & -funroll-loops& & -fcoarray=single& &' - mandatory=' -J '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -J '//modpath//' -I '//modpath case('debug_gfortran') fflags = '& & -Wall& @@ -92,7 +93,7 @@ character(len=:),allocatable :: mandatory ! flags required for fpm to function p & -fbacktrace& & -fcoarray=single& &' - mandatory=' -J '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -J '//modpath//' -I '//modpath case('release_f95') fflags='& @@ -103,7 +104,7 @@ character(len=:),allocatable :: mandatory ! flags required for fpm to function p & -ffast-math& & -funroll-loops& &' - mandatory=' -J '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -J '//modpath//' -I '//modpath case('debug_f95') fflags = '& & -Wall& @@ -116,13 +117,13 @@ character(len=:),allocatable :: mandatory ! flags required for fpm to function p & -Wno-maybe-uninitialized -Wno-uninitialized& & -fbacktrace& &' - mandatory=' -J '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -J '//modpath//' -I '//modpath case('release_nvfortran') fflags = '& & -Mbackslash& &' - mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -module '//modpath//' -I '//modpath case('debug_nvfortran') fflags = '& & -Minform=inform& @@ -133,7 +134,7 @@ character(len=:),allocatable :: mandatory ! flags required for fpm to function p & -Mchkstk& & -traceback& &' - mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -module '//modpath//' -I '//modpath case('release_ifort') fflags = '& @@ -147,7 +148,7 @@ character(len=:),allocatable :: mandatory ! flags required for fpm to function p & -assume byterecl& & -assume nounderscore& &' - mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -module '//modpath//' -I '//modpath case('debug_ifort') fflags = '& & -warn all& @@ -159,42 +160,42 @@ character(len=:),allocatable :: mandatory ! flags required for fpm to function p & -assume byterecl& & -traceback& &' - mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -module '//modpath//' -I '//modpath case('release_ifx') fflags = ' ' - mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -module '//modpath//' -I '//modpath case('debug_ifx') fflags = ' ' - mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -module '//modpath//' -I '//modpath case('release_pgfortran','release_pgf90','release_pgf95') ! Portland Group F90/F95 compilers fflags = ' ' - mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -module '//modpath//' -I '//modpath case('debug_pgfortran','debug_pgf90','debug_pgf95') ! Portland Group F90/F95 compilers fflags = ' ' - mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -module '//modpath//' -I '//modpath case('release_flang') fflags = ' ' - mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -module '//modpath//' -I '//modpath case('debug_flang') fflags = ' ' - mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -module '//modpath//' -I '//modpath case('release_lfc') fflags = ' ' - mandatory=' -M '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -M '//modpath//' -I '//modpath case('debug_lfc') fflags = ' ' - mandatory=' -M '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -M '//modpath//' -I '//modpath case('release_nagfor') fflags = ' & & -O4& & -coarray=single& & -PIC& - ' - mandatory=' -mdir '//modpath//' -I '//modpath !! add module path as apprpriate + &' + mandatory=' -mdir '//modpath//' -I '//modpath ! case('debug_nagfor') fflags = '& & -g& @@ -203,25 +204,25 @@ character(len=:),allocatable :: mandatory ! flags required for fpm to function p & -gline& & -coarray=single& & -PIC& - ' - mandatory=' -mdir '//modpath//' -I '//modpath !! add module path as apprpriate + &' + mandatory=' -mdir '//modpath//' -I '//modpath ! case('release_crayftn') fflags = ' ' - mandatory=' -J '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -J '//modpath//' -I '//modpath case('debug_crayftn') fflags = ' ' - mandatory=' -J '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -J '//modpath//' -I '//modpath case('release_xlf90') fflags = ' ' - mandatory=' -qmoddir '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -qmoddir '//modpath//' -I '//modpath case('debug_xlf90') fflags = ' ' - mandatory=' -qmoddir '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -qmoddir '//modpath//' -I '//modpath case default fflags = ' ' - mandatory=' -module '//modpath//' -I '//modpath ! add module path as apprpriate + mandatory=' -module '//modpath//' -I '//modpath write(*,*)' unknown compiler (',compiler,')' write(*,*)' and build name (',build_name,')' write(*,*)' combination.' diff --git a/fpm/test/help_test/help_test.f90 b/fpm/test/help_test/help_test.f90 index 78b9c81..390b274 100644 --- a/fpm/test/help_test/help_test.f90 +++ b/fpm/test/help_test/help_test.f90 @@ -1,16 +1,18 @@ program help_test +! note hardcoded len=512 instead of len=: in this test is a work-around a gfortran bug in old +! pre-v8.3 versions use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit implicit none integer :: i, j integer :: be, af character(len=:),allocatable :: path integer :: estat, cstat -character(len=256) :: message +character(len=512) :: message logical,allocatable :: tally(:) !intel-bug!character(len=:),allocatable :: book1(:), book2(:) -character(len=132),allocatable :: book1(:), book2(:), book3(:) +character(len=512),allocatable :: book1(:), book2(:), book3(:) !intel-bug!character(len=:),allocatable :: page1(:) -character(len=132),allocatable :: page1(:) +character(len=512),allocatable :: page1(:) integer :: lines integer :: chars ! run a variety of "fpm help" variations and verify expected files are generated @@ -142,22 +144,22 @@ character(len=:),allocatable :: add ! overall size of manual !chars=size(book2) !lines=max(count(char(10).eq.book2),count(char(13).eq.book2)) - chars=size(book2)*len(book2) + chars=sum(len_trim(book2)) ! SUM TRIMMED LENGTH lines=size(book2) - if( (chars.lt.13000) .or. (lines.lt.350) )then + if( (chars.lt.12000) .or. (lines.lt.350) )then write(*,*)'"debug" manual is suspiciously small, bytes=',chars,' lines=',lines tally=[tally,.false.] else - write(*,*)'"debug" manual size is bytes=',chars,' lines=',lines + write(*,*)'"debug" manual size in bytes=',chars,' lines=',lines tally=[tally,.true.] endif - chars=size(book3)*len(book3) + chars=sum(len_trim(book3)) ! SUM TRIMMED LENGTH lines=size(book3) - if( (chars.lt.13000) .or. (lines.lt.350) )then + if( (chars.lt.12000) .or. (lines.lt.350) )then write(*,*)'"release" manual is suspiciously small, bytes=',chars,' lines=',lines tally=[tally,.false.] else - write(*,*)'"release" manual size is bytes=',chars,' lines=',lines + write(*,*)'"release" manual size in bytes=',chars,' lines=',lines tally=[tally,.true.] endif @@ -178,7 +180,7 @@ subroutine wipe(filename) character(len=*),intent(in) :: filename integer :: ios integer :: lun -character(len=256) :: message +character(len=512) :: message open(file=filename,newunit=lun,iostat=ios,iomsg=message) if(ios.eq.0)then close(unit=lun,iostat=ios,status='delete',iomsg=message) @@ -196,7 +198,7 @@ implicit none character(*),intent(in) :: filename ! filename to shlep character(len=1),allocatable,intent(out) :: text(:) ! array to hold file integer :: nchars, igetunit, ios -character(len=256) :: message +character(len=512) :: message character(len=4096) :: local_filename ios=0 nchars=0 @@ -233,7 +235,7 @@ subroutine swallow(FILENAME,pageout) implicit none character(len=*),intent(in) :: FILENAME ! file to read !intel-bug!character(len=:),allocatable,intent(out) :: pageout(:) ! page to hold file in memory -character(len=132),allocatable,intent(out) :: pageout(:) ! page to hold file in memory +character(len=512),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 @@ -252,7 +254,7 @@ function page(array) result (table) character(len=1),intent(in) :: array(:) !intel-bug!character(len=:),allocatable :: table(:) -character(len=132),allocatable :: table(:) +character(len=512),allocatable :: table(:) integer :: i integer :: linelength integer :: length @@ -284,7 +286,7 @@ character(len=1),parameter :: cr=char(13) if(allocated(table))deallocate(table) !intel-bug!allocate(character(len=linelength) :: table(lines)) - allocate(character(len=132) :: table(lines)) + allocate(character(len=512) :: table(lines)) table=' ' linecount=1 position=1 -- cgit v1.2.3