diff options
| -rw-r--r-- | bootstrap/src/Build.hs | 2 | ||||
| -rw-r--r-- | fpm/.gitignore | 1 | ||||
| -rw-r--r-- | fpm/app/main.f90 | 8 | ||||
| -rw-r--r-- | fpm/fpm.toml | 13 | ||||
| -rw-r--r-- | fpm/src/fpm.f90 | 120 | ||||
| -rw-r--r-- | fpm/src/fpm_command_line.f90 | 375 | ||||
| -rw-r--r-- | fpm/test/cli_test/cli_test.f90 | 232 | ||||
| -rw-r--r-- | fpm/test/fpm_test/main.f90 (renamed from fpm/test/main.f90) | 0 | ||||
| -rw-r--r-- | fpm/test/fpm_test/test_manifest.f90 (renamed from fpm/test/test_manifest.f90) | 0 | ||||
| -rw-r--r-- | fpm/test/fpm_test/test_source_parsing.f90 (renamed from fpm/test/test_source_parsing.f90) | 0 | ||||
| -rw-r--r-- | fpm/test/fpm_test/test_toml.f90 (renamed from fpm/test/test_toml.f90) | 0 | ||||
| -rw-r--r-- | fpm/test/fpm_test/testsuite.f90 (renamed from fpm/test/testsuite.f90) | 0 |
12 files changed, 668 insertions, 83 deletions
diff --git a/bootstrap/src/Build.hs b/bootstrap/src/Build.hs index ffbf264..cdcbb02 100644 --- a/bootstrap/src/Build.hs +++ b/bootstrap/src/Build.hs @@ -259,7 +259,7 @@ createSourceToObjectMap buildDirectory libraryDirectory sourceFile = sourceFileToObjectFile :: FilePath -> FilePath -> FilePath -> FilePath sourceFileToObjectFile buildDirectory libraryDirectory sourceFile = - buildDirectory + (foldl (</>) "" $ splitDirectories buildDirectory) </> map toLower (pathSeparatorsToUnderscores diff --git a/fpm/.gitignore b/fpm/.gitignore index a007fea..c602557 100644 --- a/fpm/.gitignore +++ b/fpm/.gitignore @@ -1 +1,2 @@ build/* +*/FODDER/* diff --git a/fpm/app/main.f90 b/fpm/app/main.f90 index c7f9786..be9b805 100644 --- a/fpm/app/main.f90 +++ b/fpm/app/main.f90 @@ -17,15 +17,15 @@ call get_command_line_settings(cmd_settings) select type(settings=>cmd_settings) type is (fpm_new_settings) - call cmd_new() + call cmd_new(settings) type is (fpm_build_settings) call cmd_build(settings) type is (fpm_run_settings) - call cmd_run() + call cmd_run(settings) type is (fpm_test_settings) - call cmd_test() + call cmd_test(settings) type is (fpm_install_settings) - call cmd_install() + call cmd_install(settings) end select end program main diff --git a/fpm/fpm.toml b/fpm/fpm.toml index d29994a..ee2e714 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -10,7 +10,18 @@ copyright = "2020 fpm contributors" git = "https://github.com/toml-f/toml-f" tag = "v0.2" +[dependencies.M_CLI2] +git = "https://github.com/urbanjost/M_CLI2.git" +rev = "5c7df1267c918ec2b1b8e2c6a0ac000367b562cf" + +[[test]] +name = "cli-test" +source-dir = "test/cli_test" +main = "cli_test.f90" + [[test]] name = "fpm-test" -source-dir = "test" +source-dir = "test/fpm_test" main = "main.f90" + + diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index b57a713..1975d28 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -2,15 +2,19 @@ module fpm use fpm_strings, only: string_t, str_ends_with use fpm_backend, only: build_package -use fpm_command_line, only: fpm_build_settings +use fpm_command_line, only: fpm_build_settings, fpm_new_settings, & + fpm_run_settings, fpm_install_settings, fpm_test_settings use fpm_environment, only: run, get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS -use fpm_filesystem, only: join_path, number_of_rows, list_files, exists +use fpm_filesystem, only: join_path, number_of_rows, list_files, exists, basename use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t use fpm_sources, only: add_executable_sources, add_sources_from_dir, & resolve_module_dependencies use fpm_manifest, only : get_package_data, default_executable, & default_library, package_t use fpm_error, only : error_t +use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & + & stdout=>output_unit, & + & stderr=>error_unit implicit none private public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test @@ -30,10 +34,23 @@ subroutine build_model(model, settings, package, error) ! #TODO: Choose flags and output directory based on cli settings & manifest inputs model%fortran_compiler = 'gfortran' - 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) + + 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%link_flags = '' ! Add sources from executable directories @@ -41,7 +58,7 @@ subroutine build_model(model, settings, package, error) call add_executable_sources(model%sources, package%executable, & is_test=.false., error=error) - + if (allocated(error)) then return end if @@ -111,24 +128,91 @@ call build_package(model) end subroutine -subroutine cmd_install() +subroutine cmd_install(settings) +type(fpm_install_settings), intent(in) :: settings print *, "fpm error: 'fpm install' not implemented." error stop 1 -end subroutine - -subroutine cmd_new() - print *, "fpm error: 'fpm new' not implemented." - error stop 1 -end subroutine +end subroutine cmd_install + +subroutine cmd_new(settings) ! --with-executable F --with-test F ' +type(fpm_new_settings), intent(in) :: settings +character(len=:),allocatable :: message(:) +character(len=:),allocatable :: bname + bname=basename(settings%name) !! new basename(dirname) if full paths are allowed ??? + + message=[character(len=80) :: & ! create fpm.toml + &'name = "'//bname//'" ', & + &'version = "0.1.0" ', & + &'license = "license" ', & + &'author = "Jane Doe" ', & + &'maintainer = "jane.doe@example.com" ', & + &'copyright = "2020 Jane Doe" ', & + &' ', & + &'[library] ', & + &'source-dir="src" ', & + &''] + + if(settings%with_test)then + message=[character(len=80) :: message, & ! create next section of fpm.toml + &'[[test]] ', & + &'name="runTests" ', & + &'source-dir="test" ', & + &'main="main.f90" ', & + &''] + endif + + if(settings%with_executable)then + message=[character(len=80) :: message, & ! create next section of fpm.toml + &'[[executable]] ', & + &'name="'//bname//'" ', & + &'source-dir="app" ', & + &'main="main.f90" ', & + &''] + endif + + write(*,'(a)')message + print *, "fpm error: 'fpm new' not implemented." + error stop 1 +end subroutine cmd_new + +subroutine cmd_run(settings) + type(fpm_run_settings), intent(in) :: settings + integer :: i + + write(*,*)'RELEASE=',settings%release + if(size(settings%name).eq.0)then + write(*,*)'RUN DEFAULTS with arguments ['//settings%args//']' + else + do i=1,size(settings%name) + write(*,*)'RUN:'//trim(settings%name(i))//' with arguments ['//settings%args//']' + enddo + endif -subroutine cmd_run() print *, "fpm error: 'fpm run' not implemented." error stop 1 -end subroutine -subroutine cmd_test() +end subroutine cmd_run + +subroutine cmd_test(settings) + type(fpm_test_settings), intent(in) :: settings + character(len=:),allocatable :: release_name + integer :: i + + !! looks like would get this from model when cmd_test is implimented + release_name=trim(merge('gfortran_release','gfortran_debug ',settings%release)) + + write(*,*)'RELEASE=',settings%release,' RELEASE_NAME=',release_name,' ARGS=',settings%args + if( size(settings%name) .gt.0 )then + write(*,*)'RUN THESE:' + do i=1,size(settings%name) + write(*,*)'RUN:'//trim(settings%name(i))//' with arguments ['//settings%args//']' + enddo + else + write(*,*)'RUN DEFAULTS: with arguments ['//settings%args//']' + endif + print *, "fpm error: 'fpm test' not implemented." error stop 1 -end subroutine +end subroutine cmd_test end module fpm diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 406b58e..84b4693 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -1,7 +1,14 @@ +!! new are full pathnames allowed? Is more than one pathname allowed? +!! fpm --search search keywords, descriptions, names of fpm(1) package registry +!! install not sure what it is supposed to do. Install files in build/ to a user-specified area? module fpm_command_line use fpm_environment, only: get_os_type, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD + use M_CLI2, only : set_args, lget, unnamed, remaining + use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & + & stdout=>output_unit, & + & stderr=>error_unit implicit none private @@ -16,87 +23,337 @@ module fpm_command_line type, abstract :: fpm_cmd_settings end type - type, extends(fpm_cmd_settings) :: fpm_new_settings + integer,parameter :: ibug=4096 + type, extends(fpm_cmd_settings) :: fpm_new_settings + character(len=:),allocatable :: name + logical :: with_executable=.false. + logical :: with_test=.false. end type - type, extends(fpm_cmd_settings) :: fpm_build_settings + type, extends(fpm_cmd_settings) :: fpm_build_settings + logical :: release=.false. end type - type, extends(fpm_cmd_settings) :: fpm_run_settings + type, extends(fpm_cmd_settings) :: fpm_run_settings + character(len=ibug),allocatable :: name(:) + logical :: release=.false. + logical :: list=.false. + character(len=:),allocatable :: args end type - type, extends(fpm_cmd_settings) :: fpm_test_settings + type, extends(fpm_cmd_settings) :: fpm_test_settings + character(len=ibug),allocatable :: name(:) + logical :: release=.false. + character(len=:),allocatable :: args end type - type, extends(fpm_cmd_settings) :: fpm_install_settings + type, extends(fpm_cmd_settings) :: fpm_install_settings end type + character(len=:),allocatable :: name + character(len=ibug),allocatable :: names(:) + contains subroutine get_command_line_settings(cmd_settings) class(fpm_cmd_settings), allocatable, intent(out) :: cmd_settings - character(len=100) :: cmdarg - - if (command_argument_count() == 0) then - call print_help() - else if (command_argument_count() == 1) then - call get_command_argument(1, cmdarg) - select case(trim(cmdarg)) - case("new") - allocate(fpm_new_settings :: cmd_settings) - case("build") - allocate(fpm_build_settings :: cmd_settings) - case("run") - allocate(fpm_run_settings :: cmd_settings) - case("test") - allocate(fpm_test_settings :: cmd_settings) - case("install") - allocate(fpm_install_settings :: cmd_settings) - case default - print *, "fpm error: No such command " // trim(cmdarg) - error stop 1 - end select - else - print *, "Too many arguments" - error stop 1 - end if - end subroutine + character(len=4096) :: cmdarg + integer :: i + character(len=:), allocatable :: help_text(:), version_text(:) + + ! text for --version switch, + version_text = [character(len=80) :: & + & 'VERSION: 0.1.0, Pre-alpha', & + & 'PROGRAM: fpm(1)', & + & 'DESCRIPTION: A Fortran package manager and build system', & + & 'HOME PAGE: https://github.com/fortran-lang/fpm', & + & 'LICENSE: MIT', & + & ''] + ! find the subcommand name by looking for first word on command not starting with dash + cmdarg = '' + do i = 1, command_argument_count() + call get_command_argument(i, cmdarg) + if(adjustl(cmdarg(1:1)) .ne. '-')exit + enddo + + ! now set subcommand-specific help text and process commandline arguments. Then call subcommand routine + select case(trim(cmdarg)) + + case('run') + help_text=[character(len=80) :: & + 'NAME ', & + ' run(1) - the fpm(1) subcommand to run project applications ', & + ' ', & + 'SYNOPSIS ', & + ' fpm run [NAME(s)] [--release] [-- ARGS] ', & + ' ', & + ' fpm run --help|--version ', & + ' ', & + 'DESCRIPTION ', & + ' Run applications you have built in your fpm(1) project. ', & + ' ', & + 'OPTIONS ', & + ' NAME(s) optional list of specific names to execute. ', & + ' The default is to run all the applications in app/ ', & + ' or the programs listed in the "fpm.toml" file. ', & + ' --release selects the optimized build instead of the debug ', & + ' build. ', & + ' -- ARGS optional arguments to pass to the program(s). ', & + ' The same arguments are passed to all names ', & + ' specified. ', & + ' ', & + 'EXAMPLES ', & + 'run fpm(1) project applications ', & + ' ', & + ' # run default programs in /app or as specified in "fpm.toml" ', & + ' fpm run ', & + ' ', & + ' # run a specific program and pass arguments to the command ', & + ' fpm run mytest -- -x 10 -y 20 -title "my title line" ', & + ' ', & + ' # production version of two applications ', & + ' fpm run tst1 test2 -release ', & + '' ] + call set_args('--list F --release F --',help_text,version_text) + + if( size(unnamed) .gt. 1 )then + names=unnamed(2:) + else + names=[character(len=len(names)) :: ] + endif - subroutine print_help() - print *, 'fpm - A Fortran package manager and build system' + allocate(fpm_run_settings :: cmd_settings) + cmd_settings=fpm_run_settings( name=names, release=lget('release'), args=remaining ) - select case (get_os_type()) - case (OS_UNKNOWN) - print *, 'OS Type: Unknown' + case('build') + help_text=[character(len=80) :: & + 'NAME ', & + ' build(1) - the fpm(1) subcommand to build a project ', & + 'SYNOPSIS ', & + ' fpm build [--release] build ', & + ' fpm build --help|--version ', & + ' ', & + 'DESCRIPTION ', & + ' Finds the Fortran source files in app/, test/, and ', & + ' src/ by default; determines the dependencies ', & + ' between the files and rebuilds unbuilt or changed ', & + ' files. The results are placed in the build/ directory. ', & + ' ', & + ' Non-default pathnames are used if specified in the ', & + ' "fpm.toml" file. ', & + ' ', & + ' Remote dependencies are satisfied as well if specified ', & + ' in the "fpm.toml" file. ', & + ' ', & + 'OPTIONS ', & + ' --release build in build/*_release instead of ', & + ' build/*_debug/ with high optimization ', & + ' instead of full debug options. ', & + ' --help print this help and exit ', & + ' --version print program version information and exit ', & + ' ', & + 'EXAMPLES ', & + ' Sample commands: ', & + ' ', & + ' fpm build # build with debug options ', & + ' fpm build -release # build with high optimization ', & + '' ] + call set_args( '--release F --',help_text,version_text ) - case (OS_LINUX) - print *, 'OS Type: Linux' + allocate( fpm_build_settings :: cmd_settings ) + cmd_settings=fpm_build_settings( release=lget('release') ) - case (OS_MACOS) - print *, 'OS Type: macOS' + case('new') + help_text=[character(len=80) :: & + 'NAME ', & + ' new(1) - the fpm(1) subcommand to initialize a new project ', & + 'SYNOPSIS ', & + ' fpm new NAME [--with-executable] [--with-test] ', & + ' ', & + ' fpm new --help|--version ', & + ' ', & + 'DESCRIPTION ', & + ' Create a new programming project in a new directory ', & + ' ', & + ' The "new" subcommand creates a directory and runs the command ', & + ' "git init" in that directory and makes an example "fpm.toml" ', & + ' file, a src/ directory, and optionally a test/ and app/ ', & + ' directory with trivial example Fortran source files. ', & + ' ', & + ' Remember to update the information in the sample "fpm.toml" ', & + ' file with such information as your name and e-mail address. ', & + ' ', & + 'EXAMPLES ', & + ' Sample use ', & + ' ', & + ' # create new project directory and seed it ', & + ' fpm new myproject ', & + ' # Enter the new directory ', & + ' cd myproject ', & + ' # and run commands such as ', & + ' fpm build ', & + ' fpm run # if you selected --with-executable ', & + ' fpm test # if you selected --with-test ', & + ' ', & + '' ] + call set_args(' --with-executable F --with-test F ', help_text, version_text) + select case(size(unnamed)) + case(1) + write(stderr,'(*(g0))')'ERROR: directory name required' + write(stderr,'(*(g0))')' usage: fpm new NAME [--with-executable] [--with-test]' + stop 1 + case(2) + name=trim(unnamed(2)) + case default + write(stderr,'(*(g0))')'ERROR: only one directory name allowed' + write(stderr,'(*(g0))')' usage: fpm new NAME [--with-executable] [--with-test]' + stop 2 + end select - case (OS_WINDOWS) - print *, 'OS Type: Windows' + allocate(fpm_new_settings :: cmd_settings) + cmd_settings=fpm_new_settings(name=name, with_executable=lget('with-executable'), with_test=lget('with-test') ) - case (OS_CYGWIN) - print *, 'OS Type: Cygwin' + case('install') + help_text=[character(len=80) :: & + ' fpm(1) subcommand "install" ', & + ' ', & + ' Usage: fpm install NAME ', & + '' ] + call set_args('--release F ', help_text, version_text) + + allocate(fpm_install_settings :: cmd_settings) + + case('test') + help_text=[character(len=80) :: & + 'NAME ', & + ' test(1) - the fpm(1) subcommand to run project tests ', & + ' ', & + 'SYNOPSIS ', & + ' fpm test [NAME(s)] [--release] [-- ARGS] ', & + ' ', & + ' fpm test --help|--version ', & + ' ', & + 'DESCRIPTION ', & + ' Run applications you have built to test your project. ', & + ' ', & + 'OPTIONS ', & + ' NAME(s) optional list of specific test names to execute. ', & + ' The default is to run all the tests in test/ ', & + ' or the tests listed in the "fpm.toml" file. ', & + ' --release selects the optimized build instead of the debug ', & + ' build. ', & + ' -- ARGS optional arguments to pass to the test program(s). ', & + ' The same arguments are passed to all test names ', & + ' specified. ', & + ' ', & + 'EXAMPLES ', & + 'run tests ', & + ' ', & + ' # run default tests in /test or as specified in "fpm.toml" ', & + ' fpm test ', & + ' ', & + ' # run a specific test and pass arguments to the command ', & + ' fpm test mytest -- -x 10 -y 20 -title "my title line" ', & + ' ', & + ' fpm test tst1 test2 -release # production version of two tests', & + ' ', & + '' ] + call set_args(' -release F --', help_text, version_text) + + if( size(unnamed) .gt. 1 )then + names=unnamed(2:) + else + names=[character(len=len(names)) :: ] + endif + + allocate(fpm_test_settings :: cmd_settings) + cmd_settings=fpm_test_settings(name=names, release=lget('release'), args=remaining ) + + case default + help_text=[character(len=80) :: & + 'NAME', & + ' fpm(1) - A Fortran package manager and build system', & + 'OS TYPE' ] + select case (get_os_type()) + case (OS_LINUX); help_text=[character(len=80) :: help_text, " Linux" ] + case (OS_MACOS); help_text=[character(len=80) :: help_text, " macOS" ] + case (OS_WINDOWS); help_text=[character(len=80) :: help_text, " Windows" ] + case (OS_CYGWIN); help_text=[character(len=80) :: help_text, " Cygwin" ] + case (OS_SOLARIS); help_text=[character(len=80) :: help_text, " Solaris" ] + case (OS_FREEBSD); help_text=[character(len=80) :: help_text, " FreeBSD" ] + case (OS_UNKNOWN); help_text=[character(len=80) :: help_text, " Unknown" ] + case default ; help_text=[character(len=80) :: help_text, " UNKNOWN" ] + end select + help_text=[character(len=80) :: help_text, & + 'SYNTAX ', & + ' fpm SUBCOMMAND [SUBCOMMAND_OPTIONS] ', & + ' ', & + ' fpm --help|--version ', & + ' ', & + 'DESCRIPTION ', & + ' fpm is a package manager that helps you create Fortran projects that are ', & + ' optionally dependent on multiple files and other fpm(1) packages. ', & + ' ', & + ' Most significantly fpm(1) lets you pull upon other fpm(1) packages in ', & + ' distributed git(1) repositories as if the packages were a basic 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 for a listing of such available projects. ', & + ' ', & + ' All output goes into the directory "build/". ', & + ' ', & + 'SUBCOMMANDS ', & + ' Valid fpm subcommands are: ', & + ' ', & + ' build [--release] Compile the packages into the "build/" directory. ', & + ' new NAME [--with-executable] [--with-test] ', & + ' Create a new Fortran package directory ', & + ' with sample files ', & + ' run [NAME(s)] [--release] [--list] [-- ARGS] ', & + ' Run the local package binaries. defaults to all ', & + ' binaries for that release. ', & + ' test [NAME(s)] [--release] [-- ARGS] ', & + ' Run the tests ', & + 'SUBCOMMAND OPTIONS ', & + ' --release Builds or runs in release mode (versus debug mode). fpm(1) ', & + ' Defaults to using common compiler debug flags and building ', & + ' in "build/gfortran_debug/". When this flag is present build ', & + ' output goes into "build/gfortran_release/" and common ', & + ' compiler optimization flags are used. ', & + ' --list list candidates instead of building or running them ', & + ' -- ARGS Arguments to pass to executables/tests ', & + ' --help Show this help text and exit. Valid for all subcommands. ', & + ' --version Show version information and exit. Valid for all subcommands.', & + 'EXAMPLES ', & + ' sample commands: ', & + ' ', & + ' fpm build ', & + ' fpm test ', & + ' fpm run ', & + ' fpm new --help ', & + ' fpm new mypackage --with-executable --with-test ', & + ' fpm run myprogram --release -- -x 10 -y 20 --title "my title" ', & + 'SEE ALSO ', & + ' For examples and documentation see https://github.com/fortran-lang/fpm ', & + ''] - case (OS_SOLARIS) - print *, 'OS Type: Solaris' + call set_args(' ', help_text, version_text) + ! Note: will not get here if --version or --usage or --help is present on commandline + if(len_trim(cmdarg).eq.0)then + write(stderr,'(*(a))')'ERROR: missing subcommand' + else + write(stderr,'(*(a))')'ERROR: unknown subcommand [', trim(cmdarg), ']' + endif + help_text=[character(len=80) :: & + 'USAGE: fpm [ SUBCOMMAND [SUBCOMMAND_OPTIONS] ] | [|--help|--version] ', & + ' Enter "fpm --help" for more information ', & + '' ] + write(stderr,'(g0)')(trim(help_text(i)), i=1, size(help_text) ) + !!stop 3 ! causes github site tests to fail + stop - case (OS_FREEBSD) - print *, 'OS Type: FreeBSD' end select + end subroutine get_command_line_settings - print * - print *, 'Usage:' - print *, ' fpm [COMMAND]' - print * - print *, 'Valid fpm commands are:' - print *, ' build Compile the current package' - print *, ' install Install a Fortran binary or library (not implemented)' - print *, ' new Create a new Fortran package (not implemented)' - print *, ' run Run a binary of the local package (not implemented)' - print *, ' test Run the tests (not implemented)' - end subroutine end module fpm_command_line diff --git a/fpm/test/cli_test/cli_test.f90 b/fpm/test/cli_test/cli_test.f90 new file mode 100644 index 0000000..ab032f5 --- /dev/null +++ b/fpm/test/cli_test/cli_test.f90 @@ -0,0 +1,232 @@ +program main + +! for each set of command options, call this command recursively which will print the resulting parameters with a +! given test command CMD from the TEST() array. +! +! Then read the expected values as a NAMELIST group from the test array and compare the expected +! results with the actual results. +! +! the PARSE() subroutine is a copy of the app/main.f90 program except it creates and writes a NAMELIST file instead +! of actually calling the subcommands. +! +! The program will exit with a non-zero status if any of the tests fail + +use, intrinsic :: iso_fortran_env, only : compiler_version, compiler_options +implicit none + +! convenient arbitrary sizes for test + +! assuming no name over 15 characters to make output have shorter lines +character(len=15),allocatable :: name(:),act_name(:) ; namelist/act_cli/act_name +integer,parameter :: max_names=10 + +character(len=:),allocatable :: command +character(len=:),allocatable :: cmd +integer :: cstat, estat +integer :: act_cstat, act_estat +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=:),allocatable :: args,act_args ; namelist/act_cli/act_args +namelist/expected/cmd,cstat,estat,w_e,w_t,name,release,args +integer :: lun +logical,allocatable :: tally(:) +logical,allocatable :: subtally(:) +character(len=256) :: message + +! table of arguments to pass to program and expected non-default values for that execution in NAMELIST group format +character(len=*),parameter :: tests(*)= [ character(len=256) :: & + +'CMD="new", ESTAT=1,', & +'CMD="new -unknown", ESTAT=2,', & +'CMD="new my_project another yet_another -with-test", ESTAT=2,', & +'CMD="new my_project --with-executable", W_E=T, NAME="my_project",', & +'CMD="new my_project --with-executable -with-test", W_E=T,W_T=T, NAME="my_project",', & +'CMD="new my_project -with-test", W_T=T, NAME="my_project",', & +'CMD="new my_project", NAME="my_project",', & + +'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 -- arg1 -x ""and a long one""", & + &NAME="proj1","p2","project3",RELEASE=T 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 -- arg1 -x ""and a long one""", & + &NAME="proj1","p2","project3",RELEASE=T ARGS="""arg1"" -x ""and a long one""", ', & + +'CMD="build", NAME= RELEASE=F,ARGS="",', & +'CMD="build --release", NAME= RELEASE=T,ARGS="",', & +' ' ] +character(len=256) :: readme(3) + +readme(1)='&EXPECTED' ! top and bottom line for a NAMELIST group read from TEST() used to set the expected values +readme(3)=' /' +tally=[logical ::] ! an array that tabulates the command test results as pass or fail. + +if(command_argument_count().eq.0)then ! assume if called with no arguments to do the tests. This means you cannot + ! have a test of no parameters. Could improve on this. + ! if called with parameters assume this is a test and call the routine to + ! parse the resulting values after calling the CLI command line parser + ! and write the NAMELIST group so it can be read and tested against the + ! expected results + write(*,*)'start tests of the CLI command line parser' + command=repeat(' ',4096) + call get_command_argument(0,command) + command=trim(command) + write(*,*)'command=',command + + do i=1,size(tests) + if(tests(i).eq.' ')then + open(file='_test_cli',newunit=lun,delim='quote') + close(unit=lun,status='delete') + exit + 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 + w_e=.false. ! --with-executable + w_t=.false. ! --with-test + args=repeat(' ',132) ! -- ARGS + cmd=repeat(' ',132) ! the command line arguments to test + cstat=0 ! status values from EXECUTE_COMMAND_LINE() + estat=0 + readme(2)=' '//tests(i) ! select command options to test for CMD and set nondefault expected values + read(readme,nml=expected) + + write(*,'(*(g0))')'START: TEST ',i,' CMD=',trim(cmd) + ! call this program which will crack command line and write results to scratch file _test_cli + call execute_command_line(command//' '//trim(cmd),cmdstat=act_cstat,exitstat=act_estat) + if(cstat.eq.act_cstat.and.estat.eq.act_estat)then + if(estat.eq.0)then + open(file='_test_cli',newunit=lun,delim='quote') + act_name=[(repeat(' ',len(act_name)),i=1,max_names)] + act_release=.false. + act_w_e=.false. + act_w_t=.false. + act_args=repeat(' ',132) + read(lun,nml=act_cli,iostat=ios,iomsg=message) + if(ios.ne.0)then + write(*,'(a)')'ERROR:',trim(message) + endif + close(unit=lun) + ! 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('WITH_EXPECTED',act_w_e.eqv.w_e) + call test_test('WITH_TESTED',act_w_t.eqv.w_t) + call test_test('WITH_TEST',act_w_t.eqv.w_t) + call test_test('ARGS',act_args.eq.args) + if(all(subtally))then + write(*,'(*(g0))')'PASSED: TEST ',i,' STATUS: expected ',cstat,' ',estat,' actual ',act_cstat,' ',act_estat,& + & ' for [',trim(cmd),']' + tally=[tally,.true.] + else + write(*,'(*(g0))')'FAILED: TEST ',i,' STATUS: expected ',cstat,' ',estat,' actual ',act_cstat,' ',act_estat,& + & ' for [',trim(cmd),']' + print '(4a)', & + 'This file was compiled by ', & + compiler_version(), & + ' using the options ', & + compiler_options() + write(*,nml=act_cli,delim='quote') + tally=[tally,.false.] + endif + else + write(*,'(*(g0))')'PASSED: TEST ',i,' EXPECTED BAD STATUS: expected ',cstat,' ',estat, & + ' actual ',act_cstat,' ',act_estat,' for [',trim(cmd),']' + tally=[tally,.true.] + endif + else + write(*,'(*(g0))')'FAILED: TEST ',i,'BAD STATUS: expected ',cstat,' ',estat,' actual ',act_cstat,' ',act_estat,& + ' for [',trim(cmd),']' + tally=[tally,.false.] + endif + enddo + ! write up total results and if anything failed exit with a non-zero status + write(*,'(*(g0))')'TALLY;',tally + if(all(tally))then + write(*,'(*(g0))')'PASSED: all ',count(tally),' tests passed ' + else + write(*,*)'FAILED: PASSED=',count(tally),' FAILED=',count(.not.tally) + stop 4 + endif +else + ! call this program with arguments + !============================================= + debugit: block + integer :: j, ilen + character(len=256) :: big_argument + write(*,*)'arguments seen directly by program' + do j=1,command_argument_count() + call get_command_argument(number=j,value=big_argument,length=ilen) + write(*,'(*(g0))')j,'[',big_argument(:ilen),']' + enddo + end block debugit + !============================================= + call parse() +endif + +contains + +subroutine test_test(name,tst) +character(len=*) :: name +logical,intent(in) :: tst + !!write(*,'(*(g0,1x))')' SUBTEST ',name,' ',merge('PASSED','FAILED',tst) + subtally=[subtally,tst] +end subroutine test_test + +subroutine parse() +! all the extended types for settings from the main program +use fpm_command_line, only: & + fpm_cmd_settings, & + fpm_new_settings, & + fpm_build_settings, & + fpm_run_settings, & + fpm_test_settings, & + fpm_install_settings, & + get_command_line_settings +use fpm, only: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test +class(fpm_cmd_settings), allocatable :: cmd_settings +! duplicates the calls as seen in the main program for fpm +call get_command_line_settings(cmd_settings) + +allocate (character(len=len(name)) :: act_name(0) ) +act_args='' +act_w_e=.false. +act_w_t=.false. +act_release=.false. + +select type(settings=>cmd_settings) +type is (fpm_new_settings) + act_w_e=settings%with_executable + act_w_t=settings%with_test + act_name=[trim(settings%name)] +type is (fpm_build_settings) + act_release=settings%release +type is (fpm_run_settings) + act_release=settings%release + act_name=settings%name + act_args=settings%args +type is (fpm_test_settings) + act_release=settings%release + act_name=settings%name + act_args=settings%args +type is (fpm_install_settings) +end select + +open(file='_test_cli',newunit=lun,delim='quote') +write(lun,nml=act_cli,delim='quote') +!!write(*,nml=act_cli) +close(unit=lun) + +end subroutine parse + +end program main diff --git a/fpm/test/main.f90 b/fpm/test/fpm_test/main.f90 index bc8ad29..bc8ad29 100644 --- a/fpm/test/main.f90 +++ b/fpm/test/fpm_test/main.f90 diff --git a/fpm/test/test_manifest.f90 b/fpm/test/fpm_test/test_manifest.f90 index d2dc891..d2dc891 100644 --- a/fpm/test/test_manifest.f90 +++ b/fpm/test/fpm_test/test_manifest.f90 diff --git a/fpm/test/test_source_parsing.f90 b/fpm/test/fpm_test/test_source_parsing.f90 index 0b92bef..0b92bef 100644 --- a/fpm/test/test_source_parsing.f90 +++ b/fpm/test/fpm_test/test_source_parsing.f90 diff --git a/fpm/test/test_toml.f90 b/fpm/test/fpm_test/test_toml.f90 index ba48307..ba48307 100644 --- a/fpm/test/test_toml.f90 +++ b/fpm/test/fpm_test/test_toml.f90 diff --git a/fpm/test/testsuite.f90 b/fpm/test/fpm_test/testsuite.f90 index 124d19a..124d19a 100644 --- a/fpm/test/testsuite.f90 +++ b/fpm/test/fpm_test/testsuite.f90 |