diff options
| -rw-r--r-- | fpm/fpm.toml | 10 | ||||
| -rw-r--r-- | fpm/src/fpm_command_line.f90 | 139 | ||||
| -rw-r--r-- | fpm/test/cli_test/cli_test.f90 | 232 | ||||
| -rw-r--r-- | fpm/test/fpm_test/main.f90 | 96 | ||||
| -rw-r--r-- | fpm/test/fpm_test/test_manifest.f90 | 749 | ||||
| -rw-r--r-- | fpm/test/fpm_test/test_source_parsing.f90 | 695 | ||||
| -rw-r--r-- | fpm/test/fpm_test/test_toml.f90 | 107 | ||||
| -rw-r--r-- | fpm/test/fpm_test/testsuite.f90 | 286 |
8 files changed, 149 insertions, 2165 deletions
diff --git a/fpm/fpm.toml b/fpm/fpm.toml index ee2e714..0fcc91c 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -21,7 +21,17 @@ main = "cli_test.f90" [[test]] name = "fpm-test" +<<<<<<< HEAD source-dir = "test/fpm_test" main = "main.f90" +======= +source-dir = "test/main" +main = "main.f90" + +[[test]] +name = "cli-test" +source-dir = "test/cli_test" +main = "cli_test.f90" +>>>>>>> add test program for CLI diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index d1714bf..51c1172 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -74,7 +74,11 @@ contains ! text for --version switch, version_text = [character(len=80) :: & +<<<<<<< HEAD & 'VERSION: 0.1.0, Pre-alpha', & +======= + & 'VERSION: 0.0.0, 20200920', & +>>>>>>> add test program for CLI & 'PROGRAM: fpm(1)', & & 'DESCRIPTION: A Fortran package manager and build system', & & 'HOME PAGE: https://github.com/fortran-lang/fpm', & @@ -142,6 +146,7 @@ contains case('build') help_text=[character(len=80) :: & +<<<<<<< HEAD 'NAME ', & ' build(1) - the fpm(1) subcommand to build a project ', & 'SYNOPSIS ', & @@ -175,6 +180,39 @@ contains ' fpm build -release # build with high optimization ', & 'SEE ALSO ', & ' The fpm(1) home page is https://github.com/fortran-lang/fpm ', & +======= + 'NAME ', & + ' build(1) - the fpm(1) subcommand to build a project', & + 'SYNOPSIS ', & + ' fpm build [--release] build ', & + ' fpm build --help|--version|--usage ', & + ' ', & + '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 ', & + ' --usage show table of options and exit ', & + ' ', & + 'EXAMPLES ', & + ' Sample commands: ', & + ' ', & + ' fpm build # build with debug options ', & + ' fpm build -release # build with high optimization ', & +>>>>>>> add test program for CLI '' ] call set_args( '--release F --list F --',help_text,version_text ) @@ -182,6 +220,7 @@ contains cmd_settings=fpm_build_settings( release=lget('release'),list=lget('list') ) case('new') +<<<<<<< HEAD help_text=[character(len=80) :: & 'NAME ', & ' new(1) - the fpm(1) subcommand to initialize a new project ', & @@ -226,18 +265,53 @@ contains ' The fpm(1) home page is https://github.com/fortran-lang/fpm ', & ' ', & ' Registered packages are at https://fortran-lang.org/packages ', & +======= + 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|--usage ', & + ' ', & + 'DESCRIPTION ', & + ' Create a new 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. ', & + ' ', & + 'EXAMPLES ', & + ' Enter the directory and run commands such as ', & + ' ', & + ' fpm new myproject ', & + ' cd myproject ', & + ' fpm build ', & + ' fpm run # if you selected --with-executable ', & + ' fpm test # if you selected --with-test ', & + ' ', & +>>>>>>> add test program for CLI '' ] call set_args(' --with-executable F --with-test F --lib F --app F --test F', help_text, version_text) select case(size(unnamed)) case(1) +<<<<<<< HEAD write(stderr,'(*(g0))')'ERROR: directory name required' write(stderr,'(*(g0))')' usage: fpm new NAME [--with-executable] [--with-test]' +======= + write(stderr,*)'FPM:NEW: directory name required' +>>>>>>> add test program for CLI stop 1 case(2) name=trim(unnamed(2)) case default +<<<<<<< HEAD write(stderr,'(*(g0))')'ERROR: only one directory name allowed' write(stderr,'(*(g0))')' usage: fpm new NAME [--with-executable] [--with-test]' +======= + write(stderr,*)'FPM:NEW: only one directory name allowed' +>>>>>>> add test program for CLI stop 2 end select @@ -346,6 +420,7 @@ contains case default ; help_text=[character(len=80) :: help_text, " UNKNOWN" ] end select help_text=[character(len=80) :: help_text, & +<<<<<<< HEAD 'SYNOPSIS ', & ' fpm SUBCOMMAND [SUBCOMMAND_OPTIONS] ', & ' ', & @@ -414,6 +489,70 @@ contains write(stderr,'(g0)')(trim(help_text(i)), i=1, size(help_text) ) !!stop 3 ! causes github site tests to fail stop +======= + 'SYNTAX ', & + ' fpm SUBCOMMAND [SUBCOMMAND_OPTIONS] ', & + ' ', & + ' fpm --help|--version|--usage ', & + ' ', & + '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 similiar 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 ', & + ''] + + call set_args(' ', help_text, version_text) + ! Note: will not get here if --version or --usage or --help is present on commandline + write(stderr,'(*(a))')'*fpm* error: unknown or missing subcommand [', trim(cmdarg), ']' + help_text=[character(len=80) :: & + ' Usage: fpm [COMMAND [[--release] [--]|[--help|--version|--usage] ', & + ' Enter "fpm --help" for more information ', & + '' ] + write(stderr,'(g0)')(trim(help_text(i)), i=1, size(help_text) ) + stop 3 +>>>>>>> add test program for CLI end select end subroutine get_command_line_settings diff --git a/fpm/test/cli_test/cli_test.f90 b/fpm/test/cli_test/cli_test.f90 deleted file mode 100644 index ab032f5..0000000 --- a/fpm/test/cli_test/cli_test.f90 +++ /dev/null @@ -1,232 +0,0 @@ -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/fpm_test/main.f90 b/fpm/test/fpm_test/main.f90 deleted file mode 100644 index 6f20a3f..0000000 --- a/fpm/test/fpm_test/main.f90 +++ /dev/null @@ -1,96 +0,0 @@ -!> Driver for unit testing -program fpm_testing - use, intrinsic :: iso_fortran_env, only : error_unit - use testsuite, only : run_testsuite, new_testsuite, testsuite_t, & - & select_suite, run_selected - use test_toml, only : collect_toml - use test_manifest, only : collect_manifest - use test_source_parsing, only : collect_source_parsing - use test_versioning, only : collect_versioning - implicit none - integer :: stat, is - character(len=:), allocatable :: suite_name, test_name - type(testsuite_t), allocatable :: testsuite(:) - character(len=*), parameter :: fmt = '("#", *(1x, a))' - - stat = 0 - - testsuite = [ & - & new_testsuite("fpm_toml", collect_toml), & - & new_testsuite("fpm_manifest", collect_manifest), & - & new_testsuite("fpm_source_parsing", collect_source_parsing), & - & new_testsuite("fpm_versioning", collect_versioning) & - & ] - - call get_argument(1, suite_name) - call get_argument(2, test_name) - - if (allocated(suite_name)) then - is = select_suite(testsuite, suite_name) - if (is > 0 .and. is <= size(testsuite)) then - if (allocated(test_name)) then - write(error_unit, fmt) "Suite:", testsuite(is)%name - call run_selected(testsuite(is)%collect, test_name, error_unit, stat) - if (stat < 0) then - error stop 1 - end if - else - write(error_unit, fmt) "Testing:", testsuite(is)%name - call run_testsuite(testsuite(is)%collect, error_unit, stat) - end if - else - write(error_unit, fmt) "Available testsuites" - do is = 1, size(testsuite) - write(error_unit, fmt) "-", testsuite(is)%name - end do - error stop 1 - end if - else - do is = 1, size(testsuite) - write(error_unit, fmt) "Testing:", testsuite(is)%name - call run_testsuite(testsuite(is)%collect, error_unit, stat) - end do - end if - - if (stat > 0) then - write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" - error stop 1 - end if - - -contains - - - !> Obtain the command line argument at a given index - subroutine get_argument(idx, arg) - - !> Index of command line argument, range [0:command_argument_count()] - integer, intent(in) :: idx - - !> Command line argument - character(len=:), allocatable, intent(out) :: arg - - integer :: length, stat - - call get_command_argument(idx, length=length, status=stat) - if (stat /= 0) then - return - endif - - allocate(character(len=length) :: arg, stat=stat) - if (stat /= 0) then - return - endif - - if (length > 0) then - call get_command_argument(idx, arg, status=stat) - if (stat /= 0) then - deallocate(arg) - return - end if - end if - - end subroutine get_argument - - -end program fpm_testing diff --git a/fpm/test/fpm_test/test_manifest.f90 b/fpm/test/fpm_test/test_manifest.f90 deleted file mode 100644 index d2dc891..0000000 --- a/fpm/test/fpm_test/test_manifest.f90 +++ /dev/null @@ -1,749 +0,0 @@ -!> Define tests for the `fpm_manifest` modules -module test_manifest - use testsuite, only : new_unittest, unittest_t, error_t, test_failed, & - & check_string - use fpm_manifest - implicit none - private - - public :: collect_manifest - - -contains - - - !> Collect all exported unit tests - subroutine collect_manifest(testsuite) - - !> Collection of tests - type(unittest_t), allocatable, intent(out) :: testsuite(:) - - testsuite = [ & - & new_unittest("valid-manifest", test_valid_manifest), & - & new_unittest("invalid-manifest", test_invalid_manifest, should_fail=.true.), & - & new_unittest("default-library", test_default_library), & - & new_unittest("default-executable", test_default_executable), & - & new_unittest("dependency-empty", test_dependency_empty, should_fail=.true.), & - & new_unittest("dependency-pathtag", test_dependency_pathtag, should_fail=.true.), & - & new_unittest("dependency-gitpath", test_dependency_gitpath, should_fail=.true.), & - & new_unittest("dependency-nourl", test_dependency_nourl, should_fail=.true.), & - & new_unittest("dependency-gitconflict", test_dependency_gitconflict, should_fail=.true.), & - & new_unittest("dependency-wrongkey", test_dependency_wrongkey, should_fail=.true.), & - & new_unittest("dependencies-empty", test_dependencies_empty), & - & new_unittest("dependencies-typeerror", test_dependencies_typeerror, should_fail=.true.), & - & new_unittest("executable-empty", test_executable_empty, should_fail=.true.), & - & new_unittest("executable-typeerror", test_executable_typeerror, should_fail=.true.), & - & new_unittest("executable-noname", test_executable_noname, should_fail=.true.), & - & new_unittest("executable-wrongkey", test_executable_wrongkey, should_fail=.true.), & - & new_unittest("library-empty", test_library_empty), & - & new_unittest("library-wrongkey", test_library_wrongkey, should_fail=.true.), & - & new_unittest("package-simple", test_package_simple), & - & new_unittest("package-empty", test_package_empty, should_fail=.true.), & - & new_unittest("package-typeerror", test_package_typeerror, should_fail=.true.), & - & new_unittest("package-noname", test_package_noname, should_fail=.true.), & - & new_unittest("package-wrongexe", test_package_wrongexe, should_fail=.true.), & - & new_unittest("package-wrongtest", test_package_wrongtest, should_fail=.true.), & - & new_unittest("test-simple", test_test_simple), & - & new_unittest("test-empty", test_test_empty, should_fail=.true.), & - & new_unittest("test-typeerror", test_test_typeerror, should_fail=.true.), & - & new_unittest("test-noname", test_test_noname, should_fail=.true.), & - & new_unittest("test-wrongkey", test_test_wrongkey, should_fail=.true.)] - - end subroutine collect_manifest - - - !> Try to read some unnecessary obscure and convoluted but not invalid package file - subroutine test_valid_manifest(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(package_t) :: package - character(len=*), parameter :: manifest = 'fpm-valid-manifest.toml' - integer :: unit - - open(file=manifest, newunit=unit) - write(unit, '(a)') & - & 'name = "example"', & - & '[dependencies.fpm]', & - & 'git = "https://github.com/fortran-lang/fpm"', & - & '[[executable]]', & - & 'name = "example-#1" # comment', & - & 'source-dir = "prog"', & - & '[dependencies]', & - & 'toml-f.git = "git@github.com:toml-f/toml-f.git"', & - & '"toml..f" = { path = ".." }', & - & '[["executable"]]', & - & 'name = "example-#2"', & - & 'source-dir = "prog"', & - & '[executable.dependencies]', & - & '[''library'']', & - & 'source-dir = """', & - & 'lib""" # comment' - close(unit) - - call get_package_data(package, manifest, error) - - open(file=manifest, newunit=unit) - close(unit, status='delete') - - if (allocated(error)) return - - if (package%name /= "example") then - call test_failed(error, "Package name is "//package%name//" but should be example") - return - end if - - if (.not.allocated(package%library)) then - call test_failed(error, "library is not present in package data") - return - end if - - if (.not.allocated(package%executable)) then - call test_failed(error, "executable is not present in package data") - return - end if - - if (size(package%executable) /= 2) then - call test_failed(error, "Number of executables in package is not two") - return - end if - - if (.not.allocated(package%dependency)) then - call test_failed(error, "dependency is not present in package data") - return - end if - - if (size(package%dependency) /= 3) then - call test_failed(error, "Number of dependencies in package is not three") - return - end if - - if (allocated(package%test)) then - call test_failed(error, "test is present in package but not in package file") - return - end if - - end subroutine test_valid_manifest - - - !> Try to read a valid TOML document which represent an invalid package file - subroutine test_invalid_manifest(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(package_t) :: package - character(len=*), parameter :: manifest = 'fpm-invalid-manifest.toml' - integer :: unit - - open(file=manifest, newunit=unit) - write(unit, '(a)') & - & '[package]', & - & 'name = "example"', & - & 'version = "0.1.0"' - close(unit) - - call get_package_data(package, manifest, error) - - open(file=manifest, newunit=unit) - close(unit, status='delete') - - end subroutine test_invalid_manifest - - - !> Create a default library - subroutine test_default_library(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(package_t) :: package - - allocate(package%library) - call default_library(package%library) - - call check_string(error, package%library%source_dir, "src", & - & "Default library source-dir") - if (allocated(error)) return - - end subroutine test_default_library - - - !> Create a default executable - subroutine test_default_executable(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(package_t) :: package - character(len=*), parameter :: name = "default" - - allocate(package%executable(1)) - call default_executable(package%executable(1), name) - - call check_string(error, package%executable(1)%source_dir, "app", & - & "Default executable source-dir") - if (allocated(error)) return - - call check_string(error, package%executable(1)%name, name, & - & "Default executable name") - if (allocated(error)) return - - end subroutine test_default_executable - - - !> Dependencies cannot be created from empty tables - subroutine test_dependency_empty(error) - use fpm_manifest_dependency - use fpm_toml, only : new_table, toml_table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(dependency_t) :: dependency - - call new_table(table) - table%key = "example" - - call new_dependency(dependency, table, error) - - end subroutine test_dependency_empty - - - !> Try to create a dependency with conflicting entries - subroutine test_dependency_pathtag(error) - use fpm_manifest_dependency - use fpm_toml, only : new_table, toml_table, set_value - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - integer :: stat - type(dependency_t) :: dependency - - call new_table(table) - table%key = 'example' - call set_value(table, 'path', '"package"', stat) - call set_value(table, 'tag', '"v20.1"', stat) - - call new_dependency(dependency, table, error) - - end subroutine test_dependency_pathtag - - - !> Try to create a dependency with conflicting entries - subroutine test_dependency_nourl(error) - use fpm_manifest_dependency - use fpm_toml, only : new_table, toml_table, set_value - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - integer :: stat - type(dependency_t) :: dependency - - call new_table(table) - table%key = 'example' - call set_value(table, 'tag', '"v20.1"', stat) - - call new_dependency(dependency, table, error) - - end subroutine test_dependency_nourl - - - !> Try to create a dependency with conflicting entries - subroutine test_dependency_gitpath(error) - use fpm_manifest_dependency - use fpm_toml, only : new_table, toml_table, set_value - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - integer :: stat - type(dependency_t) :: dependency - - call new_table(table) - table%key = 'example' - call set_value(table, 'path', '"package"', stat) - call set_value(table, 'git', '"https://gitea.com/fortran-lang/pack"', stat) - - call new_dependency(dependency, table, error) - - end subroutine test_dependency_gitpath - - - !> Try to create a dependency with conflicting entries - subroutine test_dependency_gitconflict(error) - use fpm_manifest_dependency - use fpm_toml, only : new_table, toml_table, set_value - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - integer :: stat - type(dependency_t) :: dependency - - call new_table(table) - table%key = 'example' - call set_value(table, 'git', '"https://gitea.com/fortran-lang/pack"', stat) - call set_value(table, 'branch', '"latest"', stat) - call set_value(table, 'tag', '"v20.1"', stat) - - call new_dependency(dependency, table, error) - - end subroutine test_dependency_gitconflict - - - !> Try to create a dependency with conflicting entries - subroutine test_dependency_wrongkey(error) - use fpm_manifest_dependency - use fpm_toml, only : new_table, toml_table, set_value - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - integer :: stat - type(dependency_t) :: dependency - - call new_table(table) - table%key = 'example' - call set_value(table, 'not-available', '"anywhere"', stat) - - call new_dependency(dependency, table, error) - - end subroutine test_dependency_wrongkey - - - !> Dependency tables can be empty - subroutine test_dependencies_empty(error) - use fpm_manifest_dependency - use fpm_toml, only : new_table, toml_table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(dependency_t), allocatable :: dependencies(:) - - call new_table(table) - - call new_dependencies(dependencies, table, error) - if (allocated(error)) return - - if (allocated(dependencies)) then - call test_failed(error, "Found dependencies in empty table") - end if - - end subroutine test_dependencies_empty - - - !> Add a dependency as an array, which is not supported - subroutine test_dependencies_typeerror(error) - use fpm_manifest_dependency - use fpm_toml, only : new_table, add_array, toml_table, toml_array - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(toml_array), pointer :: children - integer :: stat - type(dependency_t), allocatable :: dependencies(:) - - call new_table(table) - call add_array(table, 'dep1', children, stat) - - call new_dependencies(dependencies, table, error) - - end subroutine test_dependencies_typeerror - - - !> Executables cannot be created from empty tables - subroutine test_executable_empty(error) - use fpm_manifest_executable - use fpm_toml, only : new_table, toml_table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(executable_t) :: executable - - call new_table(table) - - call new_executable(executable, table, error) - - end subroutine test_executable_empty - - - !> Pass a wrong TOML type to the name field of the executable - subroutine test_executable_typeerror(error) - use fpm_manifest_executable - use fpm_toml, only : new_table, add_table, toml_table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(toml_table), pointer :: child - integer :: stat - type(executable_t) :: executable - - call new_table(table) - call add_table(table, 'name', child, stat) - - call new_executable(executable, table, error) - - end subroutine test_executable_typeerror - - - !> Pass a TOML table with insufficient entries to the executable constructor - subroutine test_executable_noname(error) - use fpm_manifest_executable - use fpm_toml, only : new_table, add_table, toml_table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(toml_table), pointer :: child - integer :: stat - type(executable_t) :: executable - - call new_table(table) - call add_table(table, 'dependencies', child, stat) - - call new_executable(executable, table, error) - - end subroutine test_executable_noname - - - !> Pass a TOML table with not allowed keys - subroutine test_executable_wrongkey(error) - use fpm_manifest_executable - use fpm_toml, only : new_table, add_table, toml_table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(toml_table), pointer :: child - integer :: stat - type(executable_t) :: executable - - call new_table(table) - call add_table(table, 'wrong-field', child, stat) - - call new_executable(executable, table, error) - - end subroutine test_executable_wrongkey - - - !> Libraries can be created from empty tables - subroutine test_library_empty(error) - use fpm_manifest_library - use fpm_toml, only : new_table, toml_table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(library_t) :: library - - call new_table(table) - - call new_library(library, table, error) - if (allocated(error)) return - - call check_string(error, library%source_dir, "src", & - & "Default library source-dir") - if (allocated(error)) return - - end subroutine test_library_empty - - - !> Pass a TOML table with not allowed keys - subroutine test_library_wrongkey(error) - use fpm_manifest_library - use fpm_toml, only : new_table, add_table, toml_table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(toml_table), pointer :: child - integer :: stat - type(library_t) :: library - - call new_table(table) - call add_table(table, 'not-allowed', child, stat) - - call new_library(library, table, error) - - end subroutine test_library_wrongkey - - - !> Packages cannot be created from empty tables - subroutine test_package_simple(error) - use fpm_manifest_package - use fpm_toml, only : new_table, add_table, add_array, set_value, & - & toml_table, toml_array - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(toml_table), pointer :: child, child2 - type(toml_array), pointer :: children - integer :: stat - type(package_t) :: package - - call new_table(table) - call set_value(table, 'name', '"example"', stat) - call set_value(table, 'license', '"MIT"', stat) - call add_table(table, 'dev-dependencies', child, stat) - call add_table(child, 'pkg1', child2, stat) - call set_value(child2, 'git', '"https://github.com/fortran-lang/pkg1"', stat) - call add_table(child, 'pkg2', child2) - call set_value(child2, 'git', '"https://gitlab.com/fortran-lang/pkg2"', stat) - call set_value(child2, 'branch', '"devel"', stat) - call add_table(child, 'pkg3', child2) - call set_value(child2, 'git', '"https://bitbucket.org/fortran-lang/pkg3"', stat) - call set_value(child2, 'rev', '"9fceb02d0ae598e95dc970b74767f19372d61af8"', stat) - call add_table(child, 'pkg4', child2) - call set_value(child2, 'git', '"https://gitea.com/fortran-lang/pkg4"', stat) - call set_value(child2, 'tag', '"v1.8.5-rc3"', stat) - call add_array(table, 'test', children, stat) - call add_table(children, child, stat) - call set_value(child, 'name', '"tester"', stat) - - call new_package(package, table, error) - - end subroutine test_package_simple - - - !> Packages cannot be created from empty tables - subroutine test_package_empty(error) - use fpm_manifest_package - use fpm_toml, only : new_table, toml_table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(package_t) :: package - - call new_table(table) - - call new_package(package, table, error) - - end subroutine test_package_empty - - - !> Create an array in the package name, which should cause an error - subroutine test_package_typeerror(error) - use fpm_manifest_package - use fpm_toml, only : new_table, add_array, toml_table, toml_array - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(toml_array), pointer :: child - integer :: stat - type(package_t) :: package - - call new_table(table) - call add_array(table, "name", child, stat) - - call new_package(package, table, error) - - end subroutine test_package_typeerror - - - !> Try to create a new package without a name field - subroutine test_package_noname(error) - use fpm_manifest_package - use fpm_toml, only : new_table, add_table, toml_table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(toml_table), pointer :: child - integer :: stat - type(package_t) :: package - - call new_table(table) - call add_table(table, "library", child, stat) - call add_table(table, "dev-dependencies", child, stat) - call add_table(table, "dependencies", child, stat) - - call new_package(package, table, error) - - end subroutine test_package_noname - - - !> Try to read executables from a mixed type array - subroutine test_package_wrongexe(error) - use fpm_manifest_package - use fpm_toml, only : new_table, set_value, add_array, toml_table, toml_array - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(toml_array), pointer :: children, children2 - integer :: stat - type(package_t) :: package - - call new_table(table) - call set_value(table, 'name', '"example"', stat) - call add_array(table, 'executable', children, stat) - call add_array(children, children2, stat) - - call new_package(package, table, error) - - end subroutine test_package_wrongexe - - - !> Try to read tests from a mixed type array - subroutine test_package_wrongtest(error) - use fpm_manifest_package - use fpm_toml, only : new_table, set_value, add_array, toml_table, toml_array - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(toml_array), pointer :: children, children2 - integer :: stat - type(package_t) :: package - - call new_table(table) - call set_value(table, 'name', '"example"', stat) - call add_array(table, 'test', children, stat) - call add_array(children, children2, stat) - - call new_package(package, table, error) - - end subroutine test_package_wrongtest - - - !> Tests cannot be created from empty tables - subroutine test_test_simple(error) - use fpm_manifest_test - use fpm_toml, only : new_table, set_value, add_table, toml_table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(toml_table), pointer :: child - integer :: stat - type(test_t) :: test - - call new_table(table) - call set_value(table, 'name', '"example"', stat) - call set_value(table, 'source-dir', '"tests"', stat) - call set_value(table, 'main', '"tester.f90"', stat) - call add_table(table, 'dependencies', child, stat) - - call new_test(test, table, error) - if (allocated(error)) return - - call check_string(error, test%main, "tester.f90", "Test main") - if (allocated(error)) return - - end subroutine test_test_simple - - - !> Tests cannot be created from empty tables - subroutine test_test_empty(error) - use fpm_manifest_test - use fpm_toml, only : new_table, toml_table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(test_t) :: test - - call new_table(table) - - call new_test(test, table, error) - - end subroutine test_test_empty - - - !> Pass a wrong TOML type to the name field of the test - subroutine test_test_typeerror(error) - use fpm_manifest_test - use fpm_toml, only : new_table, add_table, toml_table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(toml_table), pointer :: child - integer :: stat - type(test_t) :: test - - call new_table(table) - call add_table(table, 'name', child, stat) - - call new_test(test, table, error) - - end subroutine test_test_typeerror - - - !> Pass a TOML table with insufficient entries to the test constructor - subroutine test_test_noname(error) - use fpm_manifest_test - use fpm_toml, only : new_table, add_table, toml_table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(toml_table), pointer :: child - integer :: stat - type(test_t) :: test - - call new_table(table) - call add_table(table, 'dependencies', child, stat) - - call new_test(test, table, error) - - end subroutine test_test_noname - - - !> Pass a TOML table with not allowed keys - subroutine test_test_wrongkey(error) - use fpm_manifest_test - use fpm_toml, only : new_table, add_table, toml_table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table) :: table - type(toml_table), pointer :: child - integer :: stat - type(test_t) :: test - - call new_table(table) - call add_table(table, 'not-supported', child, stat) - - call new_test(test, table, error) - - end subroutine test_test_wrongkey - - -end module test_manifest diff --git a/fpm/test/fpm_test/test_source_parsing.f90 b/fpm/test/fpm_test/test_source_parsing.f90 deleted file mode 100644 index 0b92bef..0000000 --- a/fpm/test/fpm_test/test_source_parsing.f90 +++ /dev/null @@ -1,695 +0,0 @@ -!> Define tests for the `fpm_sources` module (parsing routines) -module test_source_parsing - use testsuite, only : new_unittest, unittest_t, error_t, test_failed - use fpm_filesystem, only: get_temp_filename - use fpm_sources, only: parse_f_source, parse_c_source - use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & - FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE - use fpm_strings, only: operator(.in.) - implicit none - private - - public :: collect_source_parsing - -contains - - - !> Collect all exported unit tests - subroutine collect_source_parsing(testsuite) - - !> Collection of tests - type(unittest_t), allocatable, intent(out) :: testsuite(:) - - testsuite = [ & - & new_unittest("modules-used", test_modules_used), & - & new_unittest("intrinsic-modules-used", test_intrinsic_modules_used), & - & new_unittest("include-stmt", test_include_stmt), & - & new_unittest("module", test_module), & - & new_unittest("program-with-module", test_program_with_module), & - & new_unittest("submodule", test_submodule), & - & new_unittest("submodule-ancestor", test_submodule_ancestor), & - & new_unittest("subprogram", test_subprogram), & - & new_unittest("csource", test_csource), & - & new_unittest("invalid-use-stmt", & - test_invalid_use_stmt, should_fail=.true.), & - & new_unittest("invalid-include-stmt", & - test_invalid_include_stmt, should_fail=.true.), & - & new_unittest("invalid-module", & - test_invalid_module, should_fail=.true.), & - & new_unittest("invalid-submodule", & - test_invalid_submodule, should_fail=.true.) & - ] - - end subroutine collect_source_parsing - - - !> Check parsing of module 'USE' statements - subroutine test_modules_used(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - integer :: unit - character(:), allocatable :: temp_file - type(srcfile_t), allocatable :: f_source - - allocate(temp_file, source=get_temp_filename()) - - open(file=temp_file, newunit=unit) - write(unit, '(a)') & - & 'program test', & - & ' use module_one', & - & ' use :: module_two', & - & ' use module_three, only: a, b, c', & - & ' use :: module_four, only: a => b', & - & '! use module_not_used', & - & ' implicit none', & - & 'end program test' - close(unit) - - f_source = parse_f_source(temp_file,error) - if (allocated(error)) then - return - end if - - if (f_source%unit_type /= FPM_UNIT_PROGRAM) then - call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_PROGRAM') - return - end if - - if (size(f_source%modules_provided) /= 0) then - call test_failed(error,'Unexpected modules_provided - expecting zero') - return - end if - - if (size(f_source%modules_used) /= 4) then - call test_failed(error,'Incorrect number of modules_used - expecting four') - return - end if - - if (.not.('module_one' .in. f_source%modules_used)) then - call test_failed(error,'Missing module in modules_used') - return - end if - - if (.not.('module_two' .in. f_source%modules_used)) then - call test_failed(error,'Missing module in modules_used') - return - end if - - if (.not.('module_three' .in. f_source%modules_used)) then - call test_failed(error,'Missing module in modules_used') - return - end if - - if (.not.('module_four' .in. f_source%modules_used)) then - call test_failed(error,'Missing module in modules_used') - return - end if - - if ('module_not_used' .in. f_source%modules_used) then - call test_failed(error,'Commented module found in modules_used') - return - end if - - end subroutine test_modules_used - - - !> Check that intrinsic modules are properly ignore - subroutine test_intrinsic_modules_used(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - integer :: unit - character(:), allocatable :: temp_file - type(srcfile_t), allocatable :: f_source - - allocate(temp_file, source=get_temp_filename()) - - open(file=temp_file, newunit=unit) - write(unit, '(a)') & - & 'program test', & - & ' use iso_c_binding', & - & ' use iso_fortran_env', & - & ' use ieee_arithmetic', & - & ' use ieee_exceptions', & - & ' use ieee_features', & - & ' implicit none', & - & 'end program test' - close(unit) - - f_source = parse_f_source(temp_file,error) - if (allocated(error)) then - return - end if - - if (size(f_source%modules_provided) /= 0) then - call test_failed(error,'Unexpected modules_provided - expecting zero') - return - end if - - if (size(f_source%modules_used) /= 0) then - call test_failed(error,'Incorrect number of modules_used - expecting zero') - return - end if - - if ('iso_c_binding' .in. f_source%modules_used) then - call test_failed(error,'Intrinsic module found in modules_used') - return - end if - - if ('iso_fortran_env' .in. f_source%modules_used) then - call test_failed(error,'Intrinsic module found in modules_used') - return - end if - - if ('ieee_arithmetic' .in. f_source%modules_used) then - call test_failed(error,'Intrinsic module found in modules_used') - return - end if - - if ('ieee_exceptions' .in. f_source%modules_used) then - call test_failed(error,'Intrinsic module found in modules_used') - return - end if - - if ('ieee_features' .in. f_source%modules_used) then - call test_failed(error,'Intrinsic module found in modules_used') - return - end if - - end subroutine test_intrinsic_modules_used - - - !> Check parsing of include statements - subroutine test_include_stmt(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - integer :: unit - character(:), allocatable :: temp_file - type(srcfile_t), allocatable :: f_source - - allocate(temp_file, source=get_temp_filename()) - - open(file=temp_file, newunit=unit) - write(unit, '(a)') & - & 'program test', & - & ' implicit none', & - & ' include "included_file.f90"', & - & ' contains ', & - & ' include "second_include.f90"', & - & 'end program test' - close(unit) - - f_source = parse_f_source(temp_file,error) - if (allocated(error)) then - return - end if - - if (size(f_source%modules_provided) /= 0) then - call test_failed(error,'Unexpected modules_provided - expecting zero') - return - end if - - if (size(f_source%modules_used) /= 0) then - call test_failed(error,'Incorrect number of modules_used - expecting zero') - return - end if - - if (size(f_source%include_dependencies) /= 2) then - call test_failed(error,'Incorrect number of include_dependencies - expecting two') - return - end if - - if (.not.('included_file.f90' .in. f_source%include_dependencies)) then - call test_failed(error,'Missing include file in include_dependencies') - return - end if - - if (.not.('second_include.f90' .in. f_source%include_dependencies)) then - call test_failed(error,'Missing include file in include_dependencies') - return - end if - - end subroutine test_include_stmt - - - !> Try to parse fortran module - subroutine test_module(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - integer :: unit - character(:), allocatable :: temp_file - type(srcfile_t), allocatable :: f_source - - allocate(temp_file, source=get_temp_filename()) - - open(file=temp_file, newunit=unit) - write(unit, '(a)') & - & 'module my_mod', & - & 'use module_one', & - & 'interface', & - & ' module subroutine f()', & - & 'end interface', & - & 'contains', & - & 'module procedure f()', & - & 'end procedure f', & - & 'end module test' - close(unit) - - f_source = parse_f_source(temp_file,error) - if (allocated(error)) then - return - end if - - if (f_source%unit_type /= FPM_UNIT_MODULE) then - call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_MODULE') - return - end if - - if (size(f_source%modules_provided) /= 1) then - call test_failed(error,'Unexpected modules_provided - expecting one') - return - end if - - if (size(f_source%modules_used) /= 1) then - call test_failed(error,'Incorrect number of modules_used - expecting one') - return - end if - - if (.not.('my_mod' .in. f_source%modules_provided)) then - call test_failed(error,'Missing module in modules_provided') - return - end if - - if (.not.('module_one' .in. f_source%modules_used)) then - call test_failed(error,'Missing module in modules_used') - return - end if - - end subroutine test_module - - - !> Try to parse combined fortran module and program - !> Check that parsed unit type is FPM_UNIT_PROGRAM - subroutine test_program_with_module(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - integer :: unit - character(:), allocatable :: temp_file - type(srcfile_t), allocatable :: f_source - - allocate(temp_file, source=get_temp_filename()) - - open(file=temp_file, newunit=unit) - write(unit, '(a)') & - & 'module my_mod', & - & 'use module_one', & - & 'interface', & - & ' module subroutine f()', & - & 'end interface', & - & 'contains', & - & 'module procedure f()', & - & 'end procedure f', & - & 'end module test', & - & 'program my_program', & - & 'use my_mod', & - & 'implicit none', & - & 'end my_program' - close(unit) - - f_source = parse_f_source(temp_file,error) - if (allocated(error)) then - return - end if - - if (f_source%unit_type /= FPM_UNIT_PROGRAM) then - call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_PROGRAM') - return - end if - - if (size(f_source%modules_provided) /= 1) then - call test_failed(error,'Unexpected modules_provided - expecting one') - return - end if - - if (.not.('my_mod' .in. f_source%modules_provided)) then - call test_failed(error,'Missing module in modules_provided') - return - end if - - if (.not.('module_one' .in. f_source%modules_used)) then - call test_failed(error,'Missing module in modules_used') - return - end if - - if (.not.('my_mod' .in. f_source%modules_used)) then - call test_failed(error,'Missing module in modules_used') - return - end if - - end subroutine test_program_with_module - - - !> Try to parse fortran submodule for ancestry - subroutine test_submodule(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - integer :: unit - character(:), allocatable :: temp_file - type(srcfile_t), allocatable :: f_source - - allocate(temp_file, source=get_temp_filename()) - - open(file=temp_file, newunit=unit) - write(unit, '(a)') & - & 'submodule (parent) child', & - & 'use module_one', & - & 'end submodule test' - close(unit) - - f_source = parse_f_source(temp_file,error) - if (allocated(error)) then - return - end if - - if (f_source%unit_type /= FPM_UNIT_SUBMODULE) then - call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_SUBMODULE') - return - end if - - if (size(f_source%modules_provided) /= 1) then - call test_failed(error,'Unexpected modules_provided - expecting one') - return - end if - - if (size(f_source%modules_used) /= 2) then - call test_failed(error,'Incorrect number of modules_used - expecting two') - return - end if - - if (.not.('child' .in. f_source%modules_provided)) then - call test_failed(error,'Missing module in modules_provided') - return - end if - - if (.not.('module_one' .in. f_source%modules_used)) then - call test_failed(error,'Missing module in modules_used') - return - end if - - if (.not.('parent' .in. f_source%modules_used)) then - call test_failed(error,'Missing parent module in modules_used') - return - end if - - end subroutine test_submodule - - - !> Try to parse fortran multi-level submodule for ancestry - subroutine test_submodule_ancestor(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - integer :: unit - character(:), allocatable :: temp_file - type(srcfile_t), allocatable :: f_source - - allocate(temp_file, source=get_temp_filename()) - - open(file=temp_file, newunit=unit) - write(unit, '(a)') & - & 'submodule (ancestor:parent) child', & - & 'use module_one', & - & 'end submodule test' - close(unit) - - f_source = parse_f_source(temp_file,error) - if (allocated(error)) then - return - end if - - if (f_source%unit_type /= FPM_UNIT_SUBMODULE) then - call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_SUBMODULE') - return - end if - - if (size(f_source%modules_provided) /= 1) then - call test_failed(error,'Unexpected modules_provided - expecting one') - return - end if - - if (size(f_source%modules_used) /= 2) then - call test_failed(error,'Incorrect number of modules_used - expecting two') - return - end if - - if (.not.('child' .in. f_source%modules_provided)) then - call test_failed(error,'Missing module in modules_provided') - return - end if - - if (.not.('module_one' .in. f_source%modules_used)) then - call test_failed(error,'Missing module in modules_used') - return - end if - - if (.not.('parent' .in. f_source%modules_used)) then - call test_failed(error,'Missing parent module in modules_used') - return - end if - - end subroutine test_submodule_ancestor - - - !> Try to parse standard fortran sub-program (non-module) source - subroutine test_subprogram(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - integer :: unit - character(:), allocatable :: temp_file - type(srcfile_t), allocatable :: f_source - - allocate(temp_file, source=get_temp_filename()) - - open(file=temp_file, newunit=unit) - write(unit, '(a)') & - & 'subroutine my_sub(a)', & - & ' use module_one', & - & ' integer, intent(in) :: a', & - & 'end subroutine my_sub' - close(unit) - - f_source = parse_f_source(temp_file,error) - if (allocated(error)) then - return - end if - - if (f_source%unit_type /= FPM_UNIT_SUBPROGRAM) then - call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_SUBPROGRAM') - return - end if - - if (size(f_source%modules_provided) /= 0) then - call test_failed(error,'Unexpected modules_provided - expecting zero') - return - end if - - if (size(f_source%modules_used) /= 1) then - call test_failed(error,'Incorrect number of modules_used - expecting one') - return - end if - - if (.not.('module_one' .in. f_source%modules_used)) then - call test_failed(error,'Missing module in modules_used') - return - end if - - end subroutine test_subprogram - - - !> Try to parse standard c source for includes - subroutine test_csource(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - integer :: unit - character(:), allocatable :: temp_file - type(srcfile_t), allocatable :: f_source - - allocate(temp_file, source=get_temp_filename()) - temp_file = temp_file//'.c' - - open(file=temp_file, newunit=unit) - write(unit, '(a)') & - & '#include "proto.h"', & - & 'void c_func(int a) {', & - & ' #include "function_body.c"', & - & ' return', & - & '}' - close(unit) - - f_source = parse_c_source(temp_file,error) - if (allocated(error)) then - return - end if - - if (f_source%unit_type /= FPM_UNIT_CSOURCE) then - call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_CSOURCE') - return - end if - - if (size(f_source%modules_provided) /= 0) then - call test_failed(error,'Unexpected modules_provided - expecting zero') - return - end if - - if (size(f_source%modules_used) /= 0) then - call test_failed(error,'Incorrect number of modules_used - expecting zero') - return - end if - - if (size(f_source%include_dependencies) /= 2) then - call test_failed(error,'Incorrect number of include_dependencies - expecting two') - return - end if - - if (.not.('proto.h' .in. f_source%include_dependencies)) then - call test_failed(error,'Missing file in include_dependencies') - return - end if - - if (.not.('function_body.c' .in. f_source%include_dependencies)) then - call test_failed(error,'Missing file in include_dependencies') - return - end if - - end subroutine test_csource - - - !> Try to parse fortran program with invalid use statement - subroutine test_invalid_use_stmt(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - integer :: unit - character(:), allocatable :: temp_file - type(srcfile_t), allocatable :: f_source - - allocate(temp_file, source=get_temp_filename()) - - open(file=temp_file, newunit=unit) - write(unit, '(a)') & - & 'program test', & - & 'use module_one', & - & 'use :: ', & - & 'end program test' - close(unit) - - f_source = parse_f_source(temp_file,error) - if (allocated(error)) then - return - end if - - end subroutine test_invalid_use_stmt - - - !> Try to parse fortran program with invalid use statement - subroutine test_invalid_include_stmt(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - integer :: unit - character(:), allocatable :: temp_file - type(srcfile_t), allocatable :: f_source - - allocate(temp_file, source=get_temp_filename()) - - open(file=temp_file, newunit=unit) - write(unit, '(a)') & - & 'program test', & - & ' include "', & - & 'end program test' - close(unit) - - f_source = parse_f_source(temp_file,error) - if (allocated(error)) then - return - end if - - end subroutine test_invalid_include_stmt - - - !> Try to parse incorrect fortran module syntax - subroutine test_invalid_module(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - integer :: unit - character(:), allocatable :: temp_file - type(srcfile_t), allocatable :: f_source - - allocate(temp_file, source=get_temp_filename()) - - open(file=temp_file, newunit=unit) - write(unit, '(a)') & - & 'module :: my_mod', & - & 'end module test' - close(unit) - - f_source = parse_f_source(temp_file,error) - if (allocated(error)) then - return - end if - - write(*,*) '"',f_source%modules_used(1)%s,'"' - - end subroutine test_invalid_module - - - !> Try to parse incorrect fortran submodule syntax - subroutine test_invalid_submodule(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - integer :: unit - character(:), allocatable :: temp_file - type(srcfile_t), allocatable :: f_source - - allocate(temp_file, source=get_temp_filename()) - - open(file=temp_file, newunit=unit) - write(unit, '(a)') & - & 'submodule :: child', & - & 'end submodule test' - close(unit) - - f_source = parse_f_source(temp_file,error) - if (allocated(error)) then - return - end if - - write(*,*) '"',f_source%modules_used(1)%s,'"' - - end subroutine test_invalid_submodule - - - -end module test_source_parsing diff --git a/fpm/test/fpm_test/test_toml.f90 b/fpm/test/fpm_test/test_toml.f90 deleted file mode 100644 index ba48307..0000000 --- a/fpm/test/fpm_test/test_toml.f90 +++ /dev/null @@ -1,107 +0,0 @@ -!> Define tests for the `fpm_toml` modules -module test_toml - use testsuite, only : new_unittest, unittest_t, error_t - use fpm_toml - implicit none - private - - public :: collect_toml - - -contains - - - !> Collect all exported unit tests - subroutine collect_toml(testsuite) - - !> Collection of tests - type(unittest_t), allocatable, intent(out) :: testsuite(:) - - testsuite = [ & - & new_unittest("valid-toml", test_valid_toml), & - & new_unittest("invalid-toml", test_invalid_toml, should_fail=.true.), & - & new_unittest("missing-file", test_missing_file, should_fail=.true.)] - - end subroutine collect_toml - - - !> Try to read some unnecessary obscure and convoluted but not invalid package file - subroutine test_valid_toml(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table), allocatable :: table - character(len=*), parameter :: manifest = 'fpm-valid-toml.toml' - integer :: unit - - open(file=manifest, newunit=unit) - write(unit, '(a)') & - & 'name = "example"', & - & '[dependencies.fpm]', & - & 'git = "https://github.com/fortran-lang/fpm"', & - & '[[executable]]', & - & 'name = "example-#1" # comment', & - & 'source-dir = "prog"', & - & '[dependencies]', & - & 'toml-f.git = "git@github.com:toml-f/toml-f.git"', & - & '"toml..f" = { path = ".." }', & - & '[["executable"]]', & - & 'name = "example-#2"', & - & 'source-dir = "prog"', & - & '[executable.dependencies]', & - & '[''library'']', & - & 'source-dir = """', & - & 'lib""" # comment' - close(unit) - - call read_package_file(table, manifest, error) - - open(file=manifest, newunit=unit) - close(unit, status='delete') - - end subroutine test_valid_toml - - - !> Try to read an invalid TOML document - subroutine test_invalid_toml(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table), allocatable :: table - character(len=*), parameter :: manifest = 'fpm-invalid-toml.toml' - integer :: unit - - open(file=manifest, newunit=unit) - write(unit, '(a)') & - & '# INVALID TOML DOC', & - & 'name = "example"', & - & 'dependencies.fpm.git = "https://github.com/fortran-lang/fpm"', & - & '[dependencies]', & - & 'toml-f.git = "git@github.com:toml-f/toml-f.git"', & - & '"toml..f" = { path = ".." }' - close(unit) - - call read_package_file(table, manifest, error) - - open(file=manifest, newunit=unit) - close(unit, status='delete') - - end subroutine test_invalid_toml - - - !> Try to read configuration from a non-existing file - subroutine test_missing_file(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_table), allocatable :: table - - call read_package_file(table, 'low+chance+of+existing.toml', error) - - end subroutine test_missing_file - - -end module test_toml diff --git a/fpm/test/fpm_test/testsuite.f90 b/fpm/test/fpm_test/testsuite.f90 deleted file mode 100644 index 124d19a..0000000 --- a/fpm/test/fpm_test/testsuite.f90 +++ /dev/null @@ -1,286 +0,0 @@ -!> Define some procedures to automate collecting and launching of tests -module testsuite - use fpm_error, only : error_t, test_failed => fatal_error - implicit none - private - - public :: run_testsuite, run_selected, new_unittest, new_testsuite, test_failed - public :: select_test, select_suite - public :: check_string - public :: unittest_t, testsuite_t, error_t - - - abstract interface - !> Entry point for tests - subroutine test_interface(error) - import :: error_t - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - end subroutine test_interface - end interface - - - !> Declaration of a unit test - type :: unittest_t - - !> Name of the test - character(len=:), allocatable :: name - - !> Entry point of the test - procedure(test_interface), pointer, nopass :: test => null() - - !> Whether test is supposed to fail - logical :: should_fail = .false. - - end type unittest_t - - - abstract interface - !> Collect all tests - subroutine collect_interface(testsuite) - import :: unittest_t - - !> Collection of tests - type(unittest_t), allocatable, intent(out) :: testsuite(:) - - end subroutine collect_interface - end interface - - - !> Collection of unit tests - type :: testsuite_t - - !> Name of the testsuite - character(len=:), allocatable :: name - - !> Entry point of the test - procedure(collect_interface), pointer, nopass :: collect => null() - - end type testsuite_t - - - character(len=*), parameter :: fmt = '("#", *(1x, a))' - character(len=*), parameter :: indent = repeat(" ", 5) // repeat(".", 3) - - -contains - - - !> Driver for testsuite - subroutine run_testsuite(collect, unit, stat) - - !> Collect tests - procedure(collect_interface) :: collect - - !> Unit for IO - integer, intent(in) :: unit - - !> Number of failed tests - integer, intent(inout) :: stat - - type(unittest_t), allocatable :: testsuite(:) - integer :: ii - - call collect(testsuite) - - do ii = 1, size(testsuite) - write(unit, '("#", 3(1x, a), 1x, "(", i0, "/", i0, ")")') & - & "Starting", testsuite(ii)%name, "...", ii, size(testsuite) - call run_unittest(testsuite(ii), unit, stat) - end do - - end subroutine run_testsuite - - - !> Driver for selective testing - subroutine run_selected(collect, name, unit, stat) - - !> Collect tests - procedure(collect_interface) :: collect - - !> Name of the selected test - character(len=*), intent(in) :: name - - !> Unit for IO - integer, intent(in) :: unit - - !> Number of failed tests - integer, intent(inout) :: stat - - type(unittest_t), allocatable :: testsuite(:) - integer :: ii - - call collect(testsuite) - - ii = select_test(testsuite, name) - - if (ii > 0 .and. ii <= size(testsuite)) then - call run_unittest(testsuite(ii), unit, stat) - else - write(unit, fmt) "Available tests:" - do ii = 1, size(testsuite) - write(unit, fmt) "-", testsuite(ii)%name - end do - stat = -huge(ii) - end if - - end subroutine run_selected - - - !> Run a selected unit test - subroutine run_unittest(test, unit, stat) - - !> Unit test - type(unittest_t), intent(in) :: test - - !> Unit for IO - integer, intent(in) :: unit - - !> Number of failed tests - integer, intent(inout) :: stat - - type(error_t), allocatable :: error - - call test%test(error) - if (allocated(error) .neqv. test%should_fail) then - if (test%should_fail) then - write(unit, fmt) indent, test%name, "[UNEXPECTED PASS]" - else - write(unit, fmt) indent, test%name, "[FAILED]" - end if - stat = stat + 1 - else - if (test%should_fail) then - write(unit, fmt) indent, test%name, "[EXPECTED FAIL]" - else - write(unit, fmt) indent, test%name, "[PASSED]" - end if - end if - if (allocated(error)) then - write(unit, fmt) "Message:", error%message - end if - - end subroutine run_unittest - - - !> Select a unit test from all available tests - function select_test(tests, name) result(pos) - - !> Name identifying the test suite - character(len=*), intent(in) :: name - - !> Available unit tests - type(unittest_t) :: tests(:) - - !> Selected test suite - integer :: pos - - integer :: it - - pos = 0 - do it = 1, size(tests) - if (name == tests(it)%name) then - pos = it - exit - end if - end do - - end function select_test - - - !> Select a test suite from all available suites - function select_suite(suites, name) result(pos) - - !> Name identifying the test suite - character(len=*), intent(in) :: name - - !> Available test suites - type(testsuite_t) :: suites(:) - - !> Selected test suite - integer :: pos - - integer :: it - - pos = 0 - do it = 1, size(suites) - if (name == suites(it)%name) then - pos = it - exit - end if - end do - - end function select_suite - - - !> Register a new unit test - function new_unittest(name, test, should_fail) result(self) - - !> Name of the test - character(len=*), intent(in) :: name - - !> Entry point for the test - procedure(test_interface) :: test - - !> Whether test is supposed to error or not - logical, intent(in), optional :: should_fail - - !> Newly registered test - type(unittest_t) :: self - - self%name = name - self%test => test - if (present(should_fail)) self%should_fail = should_fail - - end function new_unittest - - - !> Register a new testsuite - function new_testsuite(name, collect) result(self) - - !> Name of the testsuite - character(len=*), intent(in) :: name - - !> Entry point to collect tests - procedure(collect_interface) :: collect - - !> Newly registered testsuite - type(testsuite_t) :: self - - self%name = name - self%collect => collect - - end function new_testsuite - - - !> Check a deferred length character variable against a reference value - subroutine check_string(error, actual, expected, name) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - !> Actual string value - character(len=:), allocatable, intent(in) :: actual - - !> Expected string value - character(len=*), intent(in) :: expected - - !> Name of the string to check - character(len=*), intent(in) :: name - - if (.not.allocated(actual)) then - call test_failed(error, name//" is not set correctly") - return - end if - - if (actual /= expected) then - call test_failed(error, name//" is "//actual// & - & " but should be "//expected) - end if - - end subroutine check_string - - -end module testsuite |