From 4e5dc0d49cbd66785c42d938458cf982cf3ecaf3 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Fri, 18 Dec 2020 12:01:44 -0500 Subject: Update subcommand "new" to reflect the addition of support for the example/ directory The "new" subcommand was updated with an --example switch in line with the other standard directories. Corresponding changes were made to the documentation and the test of the "new" subcommand. This reflexs the addition of --example to the "run" subcommand and the model changes to automatically build applications found in the example/ directory. --- fpm/src/fpm/cmd/new.f90 | 22 ++++++++++++++++++ fpm/src/fpm_command_line.f90 | 48 +++++++++++++++++++++++++--------------- fpm/test/help_test/help_test.f90 | 19 ++++++++-------- fpm/test/new_test/new_test.f90 | 5 ++++- 4 files changed, 66 insertions(+), 28 deletions(-) diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index 04cd7d5..7e21e92 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -107,6 +107,28 @@ character(len=8) :: date call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile) endif + if(settings%with_example)then + + ! create NAME/example or stop + call mkdir(join_path(settings%name, 'example')) + ! create next section of fpm.toml + message=[character(len=80) :: message, & + &'[[example]] ', & + &'name="demo" ', & + &'source-dir="example" ', & + &'main="demo.f90" ', & + &''] + + littlefile=[character(len=80) :: & + &'program demo', & + &'implicit none', & + &'', & + &'print *, "Put some examples in here!"', & + &'end program demo'] + ! create NAME/example/demo.f90 + call warnwrite(join_path(settings%name, 'example/demo.f90'), littlefile) + endif + if(settings%with_executable)then ! create next section of fpm.toml call mkdir(join_path(settings%name, 'app')) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index a733fc2..87b80b9 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -54,6 +54,7 @@ type, extends(fpm_cmd_settings) :: fpm_new_settings logical :: with_executable=.false. logical :: with_test=.false. logical :: with_lib=.true. + logical :: with_example=.false. logical :: backfill=.true. end type @@ -203,6 +204,7 @@ contains & --lib F & & --app F & & --test F & + & --example F & & --backfill F& & --verbose F',& & help_new, version_text) @@ -210,14 +212,14 @@ contains case(1) write(stderr,'(*(g0,/))')' directory name required' write(stderr,'(*(7x,g0,/))') & - & ' fpm new NAME [--lib|--src] [--app] [--test] [--backfill]' + & ' fpm new NAME [--lib|--src] [--app] [--test] [--example] [--backfill]' stop 1 case(2) name=trim(unnamed(2)) case default write(stderr,'(g0)')' only one directory name allowed' write(stderr,'(7x,g0)') & - & ' fpm new NAME [--lib|--src] [--app] [--test] [--backfill]' + & ' fpm new NAME [--lib|--src] [--app] [--test] [--example] [--backfill]' stop 2 end select !*! canon_path is not converting ".", etc. @@ -234,13 +236,14 @@ contains allocate(fpm_new_settings :: cmd_settings) - if (any( specified(['src ','lib ','app ','test']) ) )then + if (any( specified([character(len=10) :: 'src','lib','app','test','example']) ) )then cmd_settings=fpm_new_settings(& & backfill=lget('backfill'), & & name=name, & & with_executable=lget('app'), & & with_lib=any([lget('lib'),lget('src')]), & & with_test=lget('test'), & + & with_example=lget('example'), & & verbose=lget('verbose') ) else cmd_settings=fpm_new_settings(& @@ -249,6 +252,7 @@ contains & with_executable=.true., & & with_lib=.true., & & with_test=.true., & + & with_example=.true., & & verbose=lget('verbose') ) endif @@ -476,7 +480,7 @@ contains ' ', & ' build [--compiler COMPILER_NAME] [--release] [--list] ', & ' help [NAME(s)] ', & - ' new NAME [--lib|--src] [--app] [--test] [--backfill] ', & + ' new NAME [--lib|--src] [--app] [--test] [--example] [--backfill] ', & ' update [NAME(s)] [--fetch-only] [--clean] [--verbose] ', & ' list [--list] ', & ' run [[--target] NAME(s)] [--release] [--runner "CMD"] [--list] [--example] ', & @@ -588,14 +592,16 @@ contains ' ', & ' Their syntax is ', & ' ', & - ' build [--release] [--list] [--compiler COMPILER_NAME] ', & - ' new NAME [--lib|--src] [--app] [--test] [--backfill] ', & - ' update [NAME(s)] [--fetch-only] [--clean] ', & - ' run|test [[--target] NAME(s)] [--release] [--list] ', & - ' [--runner "CMD"] [--compiler COMPILER_NAME] [-- ARGS] ', & - ' help [NAME(s)] ', & - ' list [--list] ', & - ' install [--release] [--no-rebuild] [--prefix PATH] [options] ', & + ' build [--release] [--list] [--compiler COMPILER_NAME] ', & + ' new NAME [--lib|--src] [--app] [--test] [--example] [--backfill] ', & + ' update [NAME(s)] [--fetch-only] [--clean] ', & + ' run [[--target] NAME(s)] [--release] [--list] [--example] ', & + ' [--runner "CMD"] [--compiler COMPILER_NAME] [-- ARGS] ', & + ' test [[--target] NAME(s)] [--release] [--list] ', & + ' [--runner "CMD"] [--compiler COMPILER_NAME] [-- ARGS] ', & + ' help [NAME(s)] ', & + ' list [--list] ', & + ' install [--release] [--no-rebuild] [--prefix PATH] [options] ', & ' ', & 'SUBCOMMAND OPTIONS ', & ' --release Builds or runs in release mode (versus debug mode). fpm(1)', & @@ -730,6 +736,7 @@ contains ' o src/ for modules and procedure source ', & ' o app/ main program(s) for applications ', & ' o test/ main program(s) and support files for project tests ', & + ' o example/ main program(s) for examples and demonstrations ', & ' Changed or new files found are rebuilt. The results are placed in ', & ' the build/ directory. ', & ' ', & @@ -788,7 +795,7 @@ contains 'NAME ', & ' new(1) - the fpm(1) subcommand to initialize a new project ', & 'SYNOPSIS ', & - ' fpm new NAME [--lib|--src] [--app] [--test] [--backfill] ', & + ' fpm new NAME [--lib|--src] [--app] [--test] [--example] [--backfill] ', & ' ', & ' fpm new --help|--version ', & ' ', & @@ -813,6 +820,8 @@ contains ' main.f90 ', & ' test/ ', & ' main.f90 ', & + ' example/ ', & + ' demo.f90 ', & ' ', & ' Remember to update the information in the sample "fpm.toml" ', & ' file with your name and e-mail address. ', & @@ -823,7 +832,7 @@ contains ' ASCII alphanumeric characters and underscores, ', & ' starting with a letter. ', & ' ', & - ' The default is to create all of the src/, app/, and test/ ', & + ' The default is to create all of the src/, app/, test/, and example/ ', & ' directories. If any of the following options are specified ', & ' then only selected subdirectories are generated: ', & ' ', & @@ -834,8 +843,10 @@ contains ' --test create directory test/ and a placeholder program ', & ' for use with the subcommand "test". Note that sans ', & ' "--lib" it really does not have anything to test. ', & + ' --example create directory example/ and a placeholder program ', & + ' for use with the subcommand "run --example". ', & ' ', & - ' So the default is equivalent to "fpm NAME --lib --app --test". ', & + ' So the default is equivalent to "fpm NAME --lib --app --test --example" ', & ' ', & ' --backfill By default the directory must not exist. If this ', & ' option is present the directory may pre-exist and ', & @@ -843,7 +854,7 @@ contains ' already exist will be created. For example, if you ', & ' previously entered "fpm new myname --lib" entering ', & ' "fpm new myname --backfill" will create the missing ', & - ' app/ and test/ directories and programs. ', & + ' app/, test/ and example/ directories and programs. ', & ' ', & ' --help print this help and exit ', & ' --version print program version information and exit ', & @@ -855,8 +866,9 @@ contains ' cd myproject # Enter the new directory ', & ' # and run commands such as ', & ' fpm build ', & - ' fpm run # run example application program ', & - ' fpm test # run example test program ', & + ' fpm run # run example application program(s) ', & + ' fpm test # run example test program(s) ', & + ' fpm run --example # run example program(s) ', & '' ] help_test=[character(len=80) :: & 'NAME ', & diff --git a/fpm/test/help_test/help_test.f90 b/fpm/test/help_test/help_test.f90 index b9c1645..a44786c 100644 --- a/fpm/test/help_test/help_test.f90 +++ b/fpm/test/help_test/help_test.f90 @@ -1,5 +1,5 @@ program help_test -! note hardcoded len=512 instead of len=: in this test is a work-around a gfortran bug in old +! note hardcoded len=k1 instead of len=: in this test is a work-around a gfortran bug in old ! pre-v8.3 versions use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit implicit none @@ -7,12 +7,13 @@ integer :: i, j integer :: be, af character(len=:),allocatable :: path integer :: estat, cstat -character(len=512) :: message +integer,parameter :: k1=132 +character(len=k1) :: message logical,allocatable :: tally(:) !intel-bug!character(len=:),allocatable :: book1(:), book2(:) -character(len=512),allocatable :: book1(:), book2(:), book3(:) +character(len=k1),allocatable :: book1(:), book2(:), book3(:) !intel-bug!character(len=:),allocatable :: page1(:) -character(len=512),allocatable :: page1(:) +character(len=k1),allocatable :: page1(:) integer :: lines integer :: chars ! run a variety of "fpm help" variations and verify expected files are generated @@ -185,7 +186,7 @@ subroutine wipe(filename) character(len=*),intent(in) :: filename integer :: ios integer :: lun -character(len=512) :: message +character(len=k1) :: message open(file=filename,newunit=lun,iostat=ios,iomsg=message) if(ios.eq.0)then close(unit=lun,iostat=ios,status='delete',iomsg=message) @@ -203,7 +204,7 @@ implicit none character(*),intent(in) :: filename ! filename to shlep character(len=1),allocatable,intent(out) :: text(:) ! array to hold file integer :: nchars, igetunit, ios -character(len=512) :: message +character(len=k1) :: message character(len=4096) :: local_filename ios=0 nchars=0 @@ -240,7 +241,7 @@ subroutine swallow(FILENAME,pageout) implicit none character(len=*),intent(in) :: FILENAME ! file to read !intel-bug!character(len=:),allocatable,intent(out) :: pageout(:) ! page to hold file in memory -character(len=512),allocatable,intent(out) :: pageout(:) ! page to hold file in memory +character(len=k1),allocatable,intent(out) :: pageout(:) ! page to hold file in memory character(len=1),allocatable :: text(:) ! array to hold file in memory call slurp(FILENAME,text) ! allocate character array and copy file into it @@ -259,7 +260,7 @@ function page(array) result (table) character(len=1),intent(in) :: array(:) !intel-bug!character(len=:),allocatable :: table(:) -character(len=512),allocatable :: table(:) +character(len=k1),allocatable :: table(:) integer :: i integer :: linelength integer :: length @@ -291,7 +292,7 @@ character(len=1),parameter :: cr=char(13) if(allocated(table))deallocate(table) !intel-bug!allocate(character(len=linelength) :: table(lines)) - allocate(character(len=512) :: table(lines)) + allocate(character(len=k1) :: table(lines)) table=' ' linecount=1 position=1 diff --git a/fpm/test/new_test/new_test.f90 b/fpm/test/new_test/new_test.f90 index 2220b43..2dfc11e 100644 --- a/fpm/test/new_test/new_test.f90 +++ b/fpm/test/new_test/new_test.f90 @@ -21,6 +21,7 @@ character(len=*),parameter :: cmds(*) = [character(len=80) :: & ' new '//scr//'E --lib --test ', & ' new '//scr//'F --lib --app', & ' new '//scr//'G --test --app', & +' new '//scr//'H --example', & ' new '//scr//'BB --lib', & ' new '//scr//'BB --test ', & ' new '//scr//'BB --backfill --test', & @@ -38,7 +39,7 @@ logical :: IS_OS_WINDOWS cmdpath = get_command_path() allocate(tally(0)) - shortdirs=[character(len=80) :: 'A','B','C','D','E','F','G','BB','CC'] + shortdirs=[character(len=80) :: 'A','B','C','D','E','F','G','H','BB','CC'] allocate(character(len=80) :: directories(size(shortdirs))) !! SEE IF EXPECTED FILES ARE GENERATED @@ -104,6 +105,8 @@ logical :: IS_OS_WINDOWS &'F/app','F/fpm.toml','F/README.md','F/src','F/app/main.f90','F/src/'//scr//'F.f90'] case('G'); expected=[ character(len=80)::& &'G/app','G/fpm.toml','G/README.md','G/test','G/app/main.f90','G/test/main.f90'] + case('H'); expected=[ character(len=80)::& + &'H/example','H/fpm.toml','H/README.md','H/example/demo.f90'] case('BB'); expected=[ character(len=80)::& &'BB/fpm.toml','BB/README.md','BB/src','BB/test','BB/src/'//scr//'BB.f90','BB/test/main.f90'] case('CC'); expected=[ character(len=80)::& -- cgit v1.2.3 From e112dc34c423795165cd8385f63cace189a27d65 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Fri, 18 Dec 2020 18:42:53 -0500 Subject: try Ford documentation --- fpm/src/fpm/cmd/new.f90 | 63 ++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 60 insertions(+), 3 deletions(-) diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index 7e21e92..abfc642 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -1,4 +1,57 @@ module fpm_cmd_new +!># Definition of the "new" subcommand +!> +!> A type of the general command base class [[fpm_cmd_settings]] +!> was created for the "new" subcommand ==> type [[fpm_new_settings]]. +!> This procedure read the values that were set on the command line +!> from this type to decide what actions to take. +!> +!> It is virtually self-contained and so independant of the rest of the +!> application that it could function as a seperate program. +!> +!> The "new" subcommand options currently consist of a SINGLE top +!> directory name to create that must have a name that is an +!> allowable Fortran variable name. That should have been ensured +!> by the command line processing before this procedure is called. +!> So basically this routine has already had the options vetted and +!> just needs to conditionally create a few files. +!> +!> As described in the documentation documentation it will selectively +!> create the subdirectories app/, test/, src/, and example/ +!> and populate them with sample files. +!> +!> It also needs to create an initial manifest file "fpm.toml". +!> +!> It then calls the system command "git init". +!> +!> It should test for file existence and not overwrite existing +!> files and inform the user if there were conflicts. +!> +!> Any changes should be reflected in the documentation in +!> [[fpm_command_line.f90]] +!> +!> FUTURE +!> A filename like "." would need system commands or a standard routine +!> like realpath(3c) to process properly. +!> +!> Perhaps allow more than one name on a single command. It is an arbitrary +!> restriction based on a concensus preference, not a required limitation. +!> +!> Initially the name of the directory is used as the module name in the +!> src file so it must be an allowable Fortran variable name. If there are +!> complaints about it it might be changed. Handling unicode at this point +!> might be problematic as not all current compilers handle it. Other +!> utilities like content trackers (ie. git) or repositories like github +!> might also have issues with alternative names or names with spaces, etc. +!> So for the time being it seems prudent to encourage simple ASCII top directory +!> names (similiar to the primary programming language Fortran itself). +!> +!> Should be able to create or pull more complicated initial examples +!> based on various templates. It should place or mention other relevant +!> documents such as a description of the manifest file format in user hands; +!> or how to access registered packages and local packages, +!> although some other command might provide that (and the help command should +!> be the first go-to for a CLI utility). use fpm_command_line, only : fpm_new_settings use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS @@ -17,11 +70,14 @@ character(len=:),allocatable :: message(:) character(len=:),allocatable :: littlefile(:) character(len=8) :: date + !> get date to put into metadata in manifest file "fpm.toml" call date_and_time(DATE=date) + !> TOP DIRECTORY NAME PROCESSING + !> see if requested new directory already exists and process appropriately if(exists(settings%name) .and. .not.settings%backfill )then write(stderr,'(*(g0,1x))')& - & 'ERROR: ',settings%name,'already exists.' + & '',settings%name,'already exists.' write(stderr,'(*(g0,1x))')& & ' perhaps you wanted to add --backfill ?' return @@ -29,14 +85,15 @@ character(len=8) :: date write(*,'(*(g0))')'backfilling ',settings%name elseif(exists(settings%name) )then write(stderr,'(*(g0,1x))')& - & 'ERROR: ',settings%name,'already exists and is not a directory.' + & '',settings%name,'already exists and is not a directory.' return else ! make new directory call mkdir(settings%name) endif - ! change to new directory as a test. System dependent potentially + + !> temporarily change to new directory as a test. NB: System dependent call run('cd '//settings%name) ! NOTE: need some system routines to handle filenames like "." ! like realpath() or getcwd(). -- cgit v1.2.3 From 4a0b902f185867855b6ead8b2e6f4f92845fc1cd Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Sun, 20 Dec 2020 12:10:27 -0500 Subject: Changed so example/ directory is not created by default Also changed the sample program to demo.f90 and the test directory to check.f90 so if they are added with --backfill that reasonable names are created without modifying the manifest file (fpm.toml) so they can will still be built with auto-discovery reasonably. Note test/check.f90 was used instead of test/test.f90 because any program called "test" on ULS platforms is very problematic. After having a few users without `fpm` experience try it, they seem to be looking more for a template to choose and tools to help move existing projects to fpm (or move fpm to work more with existing projects) than what "new" currently does. I think this will change as more programs originate with fpm instead of needing to be moved to it, but instead of having "new" do everything having templates like some of the samples already available pulled down, possibly even with an interactive interface seems like a better long-term direction. --- fpm/src/fpm/cmd/new.f90 | 49 +++++++++++++++++++++--------------------- fpm/src/fpm_command_line.f90 | 16 +++++++------- fpm/test/new_test/new_test.f90 | 14 ++++++------ 3 files changed, 39 insertions(+), 40 deletions(-) diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index abfc642..2435eb3 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -3,49 +3,49 @@ module fpm_cmd_new !> !> A type of the general command base class [[fpm_cmd_settings]] !> was created for the "new" subcommand ==> type [[fpm_new_settings]]. -!> This procedure read the values that were set on the command line -!> from this type to decide what actions to take. +!> This procedure read the values that were set on the command line +!> from this type to decide what actions to take. !> -!> It is virtually self-contained and so independant of the rest of the -!> application that it could function as a seperate program. +!> It is virtually self-contained and so independant of the rest of the +!> application that it could function as a seperate program. !> !> The "new" subcommand options currently consist of a SINGLE top -!> directory name to create that must have a name that is an +!> directory name to create that must have a name that is an !> allowable Fortran variable name. That should have been ensured !> by the command line processing before this procedure is called. !> So basically this routine has already had the options vetted and !> just needs to conditionally create a few files. -!> +!> !> As described in the documentation documentation it will selectively !> create the subdirectories app/, test/, src/, and example/ !> and populate them with sample files. -!> +!> !> It also needs to create an initial manifest file "fpm.toml". -!> +!> !> It then calls the system command "git init". !> !> It should test for file existence and not overwrite existing -!> files and inform the user if there were conflicts. +!> files and inform the user if there were conflicts. !> !> Any changes should be reflected in the documentation in !> [[fpm_command_line.f90]] -!> +!> !> FUTURE !> A filename like "." would need system commands or a standard routine !> like realpath(3c) to process properly. -!> +!> !> Perhaps allow more than one name on a single command. It is an arbitrary !> restriction based on a concensus preference, not a required limitation. -!> +!> !> Initially the name of the directory is used as the module name in the !> src file so it must be an allowable Fortran variable name. If there are !> complaints about it it might be changed. Handling unicode at this point -!> might be problematic as not all current compilers handle it. Other +!> might be problematic as not all current compilers handle it. Other !> utilities like content trackers (ie. git) or repositories like github !> might also have issues with alternative names or names with spaces, etc. !> So for the time being it seems prudent to encourage simple ASCII top directory !> names (similiar to the primary programming language Fortran itself). -!> +!> !> Should be able to create or pull more complicated initial examples !> based on various templates. It should place or mention other relevant !> documents such as a description of the manifest file format in user hands; @@ -92,8 +92,7 @@ character(len=8) :: date call mkdir(settings%name) endif - - !> temporarily change to new directory as a test. NB: System dependent + !> temporarily change to new directory as a test. NB: System dependent call run('cd '//settings%name) ! NOTE: need some system routines to handle filenames like "." ! like realpath() or getcwd(). @@ -151,17 +150,17 @@ character(len=8) :: date &'[[test]] ', & &'name="runTests" ', & &'source-dir="test" ', & - &'main="main.f90" ', & + &'main="check.f90" ', & &''] littlefile=[character(len=80) :: & - &'program main', & + &'program check', & &'implicit none', & &'', & &'print *, "Put some tests in here!"', & - &'end program main'] - ! create NAME/test/main.f90 - call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile) + &'end program check'] + ! create NAME/test/check.f90 + call warnwrite(join_path(settings%name, 'test/check.f90'), littlefile) endif if(settings%with_example)then @@ -229,7 +228,7 @@ character(len=*),intent(in) :: data(:) if(.not.exists(fname))then call filewrite(fname,data) else - write(stderr,'(*(g0,1x))')'INFO: ',fname,& + write(stderr,'(*(g0,1x))')' ',fname,& & 'already exists. Not overwriting' endif @@ -263,7 +262,7 @@ character(len=256) :: message endif if(ios.ne.0)then write(stderr,'(*(a:,1x))')& - & '*filewrite* error:',filename,trim(message) + & ' *filewrite*:',filename,trim(message) error stop 1 endif ! write file @@ -271,14 +270,14 @@ character(len=256) :: message write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i)) if(ios.ne.0)then write(stderr,'(*(a:,1x))')& - & '*filewrite* error:',filename,trim(message) + & ' *filewrite*:',filename,trim(message) error stop 4 endif enddo ! close file close(unit=lun,iostat=ios,iomsg=message) if(ios.ne.0)then - write(stderr,'(*(a:,1x))')'*filewrite* error:',trim(message) + write(stderr,'(*(a:,1x))')' *filewrite*:',trim(message) error stop 2 endif end subroutine filewrite diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 87b80b9..6e9a5bd 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -135,10 +135,10 @@ contains & os_type] ! find the subcommand name by looking for first word on command ! not starting with dash - cmdarg = '' + cmdarg=' ' do i = 1, command_argument_count() - call get_command_argument(i, cmdarg) - if(adjustl(cmdarg(1:1)) .ne. '-')exit + call get_command_argument(i, cmdarg) + if(adjustl(cmdarg(1:1)) .ne. '-')exit enddo ! now set subcommand-specific help text and process commandline @@ -252,7 +252,7 @@ contains & with_executable=.true., & & with_lib=.true., & & with_test=.true., & - & with_example=.true., & + & with_example=.false., & & verbose=lget('verbose') ) endif @@ -819,7 +819,7 @@ contains ' app/ ', & ' main.f90 ', & ' test/ ', & - ' main.f90 ', & + ' check.f90 ', & ' example/ ', & ' demo.f90 ', & ' ', & @@ -832,7 +832,7 @@ contains ' ASCII alphanumeric characters and underscores, ', & ' starting with a letter. ', & ' ', & - ' The default is to create all of the src/, app/, test/, and example/ ', & + ' The default is to create the src/, app/, and test/, ', & ' directories. If any of the following options are specified ', & ' then only selected subdirectories are generated: ', & ' ', & @@ -846,7 +846,7 @@ contains ' --example create directory example/ and a placeholder program ', & ' for use with the subcommand "run --example". ', & ' ', & - ' So the default is equivalent to "fpm NAME --lib --app --test --example" ', & + ' So the default is equivalent to "fpm NAME --lib --app --test" ', & ' ', & ' --backfill By default the directory must not exist. If this ', & ' option is present the directory may pre-exist and ', & @@ -854,7 +854,7 @@ contains ' already exist will be created. For example, if you ', & ' previously entered "fpm new myname --lib" entering ', & ' "fpm new myname --backfill" will create the missing ', & - ' app/, test/ and example/ directories and programs. ', & + ' app/ and test/ directories and programs. ', & ' ', & ' --help print this help and exit ', & ' --version print program version information and exit ', & diff --git a/fpm/test/new_test/new_test.f90 b/fpm/test/new_test/new_test.f90 index 2dfc11e..22cf113 100644 --- a/fpm/test/new_test/new_test.f90 +++ b/fpm/test/new_test/new_test.f90 @@ -92,25 +92,25 @@ logical :: IS_OS_WINDOWS else select case(shortdirs(i)) case('A'); expected=[ character(len=80)::& - &'A/app','A/fpm.toml','A/README.md','A/src','A/test','A/app/main.f90','A/src/'//scr//'A.f90','A/test/main.f90'] + &'A/app','A/fpm.toml','A/README.md','A/src','A/test','A/app/main.f90','A/src/'//scr//'A.f90','A/test/check.f90'] case('B'); expected=[ character(len=80)::& &'B/fpm.toml','B/README.md','B/src','B/src/'//scr//'B.f90'] case('C'); expected=[ character(len=80)::& &'C/app','C/fpm.toml','C/README.md','C/app/main.f90'] case('D'); expected=[ character(len=80)::& - &'D/fpm.toml','D/README.md','D/test','D/test/main.f90'] + &'D/fpm.toml','D/README.md','D/test','D/test/check.f90'] case('E'); expected=[ character(len=80)::& - &'E/fpm.toml','E/README.md','E/src','E/test','E/src/'//scr//'E.f90','E/test/main.f90'] + &'E/fpm.toml','E/README.md','E/src','E/test','E/src/'//scr//'E.f90','E/test/check.f90'] case('F'); expected=[ character(len=80)::& &'F/app','F/fpm.toml','F/README.md','F/src','F/app/main.f90','F/src/'//scr//'F.f90'] case('G'); expected=[ character(len=80)::& - &'G/app','G/fpm.toml','G/README.md','G/test','G/app/main.f90','G/test/main.f90'] + &'G/app','G/fpm.toml','G/README.md','G/test','G/app/main.f90','G/test/check.f90'] case('H'); expected=[ character(len=80)::& &'H/example','H/fpm.toml','H/README.md','H/example/demo.f90'] case('BB'); expected=[ character(len=80)::& - &'BB/fpm.toml','BB/README.md','BB/src','BB/test','BB/src/'//scr//'BB.f90','BB/test/main.f90'] + &'BB/fpm.toml','BB/README.md','BB/src','BB/test','BB/src/'//scr//'BB.f90','BB/test/check.f90'] case('CC'); expected=[ character(len=80)::& - &'CC/app','CC/fpm.toml','CC/README.md','CC/src','CC/test','CC/app/main.f90','CC/src/'//scr//'CC.f90','CC/test/main.f90'] + &'CC/app','CC/fpm.toml','CC/README.md','CC/src','CC/test','CC/app/main.f90','CC/src/'//scr//'CC.f90','CC/test/check.f90'] case default write(*,*)'ERROR: internal error. unknown directory name ',trim(shortdirs(i)) stop 4 @@ -149,7 +149,7 @@ logical :: IS_OS_WINDOWS call execute_command_line('rmdir fpm_scratch_* /s /q',exitstat=estat,cmdstat=cstat,cmdmsg=message) end select - write(*,'("TALLY=",*(g0))')tally + write(*,'("new TEST TALLY=",*(g0))')tally if(all(tally))then write(*,'(*(g0))')'PASSED: all ',count(tally),' tests passed ' else -- cgit v1.2.3 From d435b766f2b3193eb077db0d2e8025daa29d55ef Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Mon, 21 Dec 2020 14:11:43 -0500 Subject: Simplify default for simple projects and experienced user but use --verbose to add the kitchen sink Simplified the defaults to be able to use auto-discovery and the simplest manifest (fpm.toml) file but at the same time provide an easy way to get a fully populated default structure (ie. one that adds the example/ directory) and also provides a heavily annotated manifest that helps with understanding how to create a more complex project and also understanding how your simple project can grow beyond a basic default package (one of the first questions someone will have even if they are not ready to use it all is will using `fpm` be too restrictive?) --- fpm/src/fpm/cmd/new.f90 | 142 +++++++++++++++++++++++++++++++++---------- fpm/src/fpm_command_line.f90 | 17 +++++- 2 files changed, 125 insertions(+), 34 deletions(-) diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index 2435eb3..fcdf6fd 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -66,13 +66,16 @@ contains subroutine cmd_new(settings) type(fpm_new_settings), intent(in) :: settings character(len=:),allocatable :: bname ! baeename of NAME -character(len=:),allocatable :: message(:) +character(len=:),allocatable :: tomlfile(:) character(len=:),allocatable :: littlefile(:) character(len=8) :: date !> get date to put into metadata in manifest file "fpm.toml" call date_and_time(DATE=date) + write(*,*)settings%name + write(*,*)settings%backfill + write(*,*)settings%verbose !> TOP DIRECTORY NAME PROCESSING !> see if requested new directory already exists and process appropriately if(exists(settings%name) .and. .not.settings%backfill )then @@ -107,23 +110,78 @@ character(len=8) :: date call warnwrite(join_path(settings%name, 'README.md'), littlefile) ! start building NAME/fpm.toml - message=[character(len=80) :: & - &'name = "'//bname//'" ', & - &'version = "0.1.0" ', & - &'license = "license" ', & - &'author = "Jane Doe" ', & - &'maintainer = "jane.doe@example.com" ', & - &'copyright = "'//date(1:4)//' Jane Doe" ', & - &' ', & - &''] + if(settings%verbose)then + tomlfile=[character(len=80) :: & + &'# Manifest root ',& + &' ',& + &'## Project Identification ',& + &'name = "'//bname//'"', & + &' # The project name (required) is how the project will be referred to. ',& + &' # It is used by another package using it as a dependency and as the ',& + &' # default name of the library built from src/. ',& + &' ',& + &'version = "0.1.0" ',& + &' # The project version number is a string. A recommended standardized way ',& + &' # to manage and specify versions is the Semantic Versioning scheme. ',& + &' ',& + &'license = "license" ',& + &' # Licensing information specified using a standard such as SPDX ',& + &' # identifiers are preferred (eg. "Apache-2.0 OR MIT" or "LGPL-3.0-or-later").',& + &' ',& + &'maintainer = "jane.doe@example.com" ',& + &' # Information on the project maintainer and means to reach out to them. ',& + &' ',& + &'author = "Jane Doe" ',& + &' # Information on the project author. ',& + &' ',& + &'copyright = "Copyright 2020 Jane Doe" ',& + &' # A statement clarifying the Copyright status of the project. ',& + &' ',& + &'#description = "A short project summary in plain text" ',& + &' # The description provides a short summary on the project. It should be ',& + &' # plain text and not use any markup formatting. ',& + &' ',& + &'#categories = ["fortran", "graphics"] ',& + &' # Categories associated with the project. Listing only one is preferred. ',& + &' ',& + &'#keywords = ["hdf5", "mpi"] ',& + &' # The keywords field is an array of strings describing the project. ',& + &' ',& + &'#homepage = "https://stdlib.fortran-lang.org" ',& + &' # URL to the webpage of the project. ',& + &' ',& + &'## TABLES ',& + &' ',& + &'## BUILD CONFIGURATION SECTION ',& + &'[build] ',& + &'auto-executables = true # Toggle automatic discovery of executables ',& + &'auto-examples = true # Toggle automatic discovery of example programs ',& + &'auto-tests = true # Toggle automatic discovery of test executables ',& + &'#link = ["blas", "lapack", "z", "X11"] # Linking against libraries ',& + &' ',& + &'## TARGETS ',& + &''] + else + tomlfile=[character(len=80) :: & + &'name = "'//bname//'" ', & + &'version = "0.1.0" ', & + &'license = "license" ', & + &'author = "Jane Doe" ', & + &'maintainer = "jane.doe@example.com" ', & + &'copyright = "'//date(1:4)//' Jane Doe" ', & + &' ', & + &''] + endif if(settings%with_lib)then call mkdir(join_path(settings%name,'src') ) ! create next section of fpm.toml - message=[character(len=80) :: message, & - &'[library] ', & - &'source-dir="src" ', & - &''] + if(settings%verbose)then + tomlfile=[character(len=80) :: tomlfile, & + &'[library] ', & + &'source-dir="src" ', & + &''] + endif ! create placeholder module src/bname.f90 littlefile=[character(len=80) :: & &'module '//bname, & @@ -146,12 +204,14 @@ character(len=8) :: date ! create NAME/test or stop call mkdir(join_path(settings%name, 'test')) ! create next section of fpm.toml - message=[character(len=80) :: message, & - &'[[test]] ', & - &'name="runTests" ', & - &'source-dir="test" ', & - &'main="check.f90" ', & - &''] + if(settings%verbose)then + tomlfile=[character(len=80) :: tomlfile ,& + &'[[test]] ', & + &'name="runTests" ', & + &'source-dir="test" ', & + &'main="check.f90" ', & + &''] + endif littlefile=[character(len=80) :: & &'program check', & @@ -168,12 +228,14 @@ character(len=8) :: date ! create NAME/example or stop call mkdir(join_path(settings%name, 'example')) ! create next section of fpm.toml - message=[character(len=80) :: message, & - &'[[example]] ', & - &'name="demo" ', & - &'source-dir="example" ', & - &'main="demo.f90" ', & - &''] + if(settings%verbose)then + tomlfile=[character(len=80) :: tomlfile, & + &'[[example]] ', & + &'name="demo" ', & + &'source-dir="example" ', & + &'main="demo.f90" ', & + &''] + endif littlefile=[character(len=80) :: & &'program demo', & @@ -189,12 +251,14 @@ character(len=8) :: date ! create next section of fpm.toml call mkdir(join_path(settings%name, 'app')) ! create NAME/app or stop - message=[character(len=80) :: message, & - &'[[executable]] ', & - &'name="'//bname//'" ', & - &'source-dir="app" ', & - &'main="main.f90" ', & - &''] + if(settings%verbose)then + tomlfile=[character(len=80) :: tomlfile, & + &'[[executable]] ', & + &'name="'//bname//'" ', & + &'source-dir="app" ', & + &'main="main.f90" ', & + &''] + endif if(exists(bname//'/src/'))then littlefile=[character(len=80) :: & @@ -214,9 +278,21 @@ character(len=8) :: date endif call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile) endif + if(settings%verbose)then + tomlfile=[character(len=80) :: tomlfile, & + &'[dependencies] ', & + &'# ', & + &'#Files will be searched for automatically (by default) in ', & + &'# src/, app/, test/, and example/. ', & + &'#For a complete list of keys and their attributes see ', & + &'# ', & + &'# https://github.com/fortran-lang/fpm/blob/master/manifest-reference.md ', & + &'# ', & + &''] + endif ! now that built it write NAME/fpm.toml - call warnwrite(join_path(settings%name, 'fpm.toml'), message) + call warnwrite(join_path(settings%name, 'fpm.toml'), tomlfile) ! assumes git(1) is installed and in path call run('git init ' // settings%name) contains diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 6e9a5bd..85bfc94 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -252,7 +252,7 @@ contains & with_executable=.true., & & with_lib=.true., & & with_test=.true., & - & with_example=.false., & + & with_example=lget('verbose'), & & verbose=lget('verbose') ) endif @@ -823,6 +823,14 @@ contains ' example/ ', & ' demo.f90 ', & ' ', & + ' Using this file structure is highly encouraged, particularly for ', & + ' small packages primarily intended to be used as dependendencies. ', & + ' ', & + ' If you find this restrictive and need to customize the package ', & + ' structure you will find using the --verbose switch creates a ', & + ' heavily annotated manifest file with references to documentation ', & + ' to aid in constructing complex package structures. ', & + ' ', & ' Remember to update the information in the sample "fpm.toml" ', & ' file with your name and e-mail address. ', & ' ', & @@ -856,6 +864,13 @@ contains ' "fpm new myname --backfill" will create the missing ', & ' app/ and test/ directories and programs. ', & ' ', & + ' --verbose By default a minimal manifest file ("fpm.toml") is ', & + ' created that depends on auto-discovery and (as noted) ', & + ' the example/ directory is only created if explicitly ', & + ' asked for. With this option a much more extensive ', & + ' manifest sample is written and the example/ directory ', & + ' is created by default as well. ', & + ' ', & ' --help print this help and exit ', & ' --version print program version information and exit ', & ' ', & -- cgit v1.2.3 From 0fe6b1fe311ad43acb2ecd98fb2b98cf40636c95 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Tue, 22 Dec 2020 00:37:10 -0500 Subject: complicating new --- fpm/src/fpm/cmd/new.f90 | 295 +++++++++++++++++++++++++++++++++++-------- fpm/src/fpm_command_line.f90 | 48 +++++-- 2 files changed, 281 insertions(+), 62 deletions(-) diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index fcdf6fd..9b0b362 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -65,17 +65,11 @@ contains subroutine cmd_new(settings) type(fpm_new_settings), intent(in) :: settings -character(len=:),allocatable :: bname ! baeename of NAME -character(len=:),allocatable :: tomlfile(:) -character(len=:),allocatable :: littlefile(:) -character(len=8) :: date +integer,parameter :: tfc = selected_char_kind('DEFAULT') +character(len=:,kind=tfc),allocatable :: bname ! baeename of NAME +character(len=:,kind=tfc),allocatable :: tomlfile(:) +character(len=:,kind=tfc),allocatable :: littlefile(:) - !> get date to put into metadata in manifest file "fpm.toml" - call date_and_time(DATE=date) - - write(*,*)settings%name - write(*,*)settings%backfill - write(*,*)settings%verbose !> TOP DIRECTORY NAME PROCESSING !> see if requested new directory already exists and process appropriately if(exists(settings%name) .and. .not.settings%backfill )then @@ -110,7 +104,7 @@ character(len=8) :: date call warnwrite(join_path(settings%name, 'README.md'), littlefile) ! start building NAME/fpm.toml - if(settings%verbose)then + if(settings%with_full)then tomlfile=[character(len=80) :: & &'# Manifest root ',& &' ',& @@ -161,22 +155,13 @@ character(len=8) :: date &' ',& &'## TARGETS ',& &''] - else - tomlfile=[character(len=80) :: & - &'name = "'//bname//'" ', & - &'version = "0.1.0" ', & - &'license = "license" ', & - &'author = "Jane Doe" ', & - &'maintainer = "jane.doe@example.com" ', & - &'copyright = "'//date(1:4)//' Jane Doe" ', & - &' ', & - &''] endif - if(settings%with_lib)then + if(settings%with_bare)then + elseif(settings%with_lib)then call mkdir(join_path(settings%name,'src') ) ! create next section of fpm.toml - if(settings%verbose)then + if(settings%with_full)then tomlfile=[character(len=80) :: tomlfile, & &'[library] ', & &'source-dir="src" ', & @@ -199,12 +184,13 @@ character(len=8) :: date & littlefile) endif - if(settings%with_test)then + if(settings%with_bare)then + elseif(settings%with_test)then ! create NAME/test or stop call mkdir(join_path(settings%name, 'test')) ! create next section of fpm.toml - if(settings%verbose)then + if(settings%with_full)then tomlfile=[character(len=80) :: tomlfile ,& &'[[test]] ', & &'name="runTests" ', & @@ -223,12 +209,13 @@ character(len=8) :: date call warnwrite(join_path(settings%name, 'test/check.f90'), littlefile) endif - if(settings%with_example)then + if(settings%with_bare)then + elseif(settings%with_example)then ! create NAME/example or stop call mkdir(join_path(settings%name, 'example')) ! create next section of fpm.toml - if(settings%verbose)then + if(settings%with_full)then tomlfile=[character(len=80) :: tomlfile, & &'[[example]] ', & &'name="demo" ', & @@ -247,11 +234,12 @@ character(len=8) :: date call warnwrite(join_path(settings%name, 'example/demo.f90'), littlefile) endif - if(settings%with_executable)then + if(settings%with_bare)then + elseif(settings%with_executable)then ! create next section of fpm.toml call mkdir(join_path(settings%name, 'app')) ! create NAME/app or stop - if(settings%verbose)then + if(settings%with_full)then tomlfile=[character(len=80) :: tomlfile, & &'[[executable]] ', & &'name="'//bname//'" ', & @@ -278,7 +266,8 @@ character(len=8) :: date endif call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile) endif - if(settings%verbose)then + + if(settings%with_full)then tomlfile=[character(len=80) :: tomlfile, & &'[dependencies] ', & &'# ', & @@ -292,11 +281,55 @@ character(len=8) :: date endif ! now that built it write NAME/fpm.toml - call warnwrite(join_path(settings%name, 'fpm.toml'), tomlfile) + if( allocated(tomlfile) )then + call validate_toml_data(tomlfile) + call warnwrite(join_path(settings%name, 'fpm.toml'), tomlfile) + else + call create_verified_basic_manifest(join_path(settings%name, 'fpm.toml')) + endif ! assumes git(1) is installed and in path call run('git init ' // settings%name) contains +subroutine create_verified_basic_manifest(filename) +!> create a basic but verified default manifest file +use fpm_toml, only : toml_table, toml_serializer, set_value +use fpm_manifest_package, only : package_config_t, new_package +use fpm_error, only : error_t +implicit none +character(len=*),intent(in) :: filename + type(toml_table) :: table + type(toml_serializer) :: ser + type(package_config_t) :: package + type(error_t), allocatable :: error + integer :: lun + character(len=8) :: date + + !> get date to put into metadata in manifest file "fpm.toml" + call date_and_time(DATE=date) + table = toml_table() + ser = toml_serializer() + call fileopen(filename,lun) ! fileopen stops on error + + call set_value(table, "name", BNAME) + call set_value(table, "version", "0.1.0") + call set_value(table, "license", "license") + call set_value(table, "author", "Jane Doe") + call set_value(table, "maintainer", "jane.doe@example.com") + call set_value(table, "copyright", 'Copyright '//date(1:4)//', Jane Doe') + ! continue building of manifest + ! ... + call new_package(package, table, error) + if (allocated(error)) stop 3 + if(settings%verbose)then + call table%accept(ser) + endif + ser%unit=lun + call table%accept(ser) + call fileclose(lun) ! fileopen stops on error + +end subroutine create_verified_basic_manifest + subroutine warnwrite(fname,data) character(len=*),intent(in) :: fname character(len=*),intent(in) :: data(:) @@ -310,15 +343,15 @@ character(len=*),intent(in) :: data(:) end subroutine warnwrite -subroutine filewrite(filename,filedata) -! procedure to write filedata to file filename +subroutine fileopen(filename,lun) +! procedure to open filedata to file filename use,intrinsic :: iso_fortran_env, only : & & stdin=>input_unit, stdout=>output_unit, stderr=>error_unit -character(len=*),intent(in) :: filename -character(len=*),intent(in) :: filedata(:) -integer :: lun, i, ios -character(len=256) :: message +character(len=*),intent(in) :: filename +integer,intent(out) :: lun +integer :: i, ios +character(len=256) :: message message=' ' ios=0 @@ -339,25 +372,187 @@ character(len=256) :: message if(ios.ne.0)then write(stderr,'(*(a:,1x))')& & ' *filewrite*:',filename,trim(message) - error stop 1 + lun=-1 + stop 1 endif - ! write file - do i=1,size(filedata) - write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i)) + +end subroutine fileopen + +subroutine fileclose(lun) +use,intrinsic :: iso_fortran_env, only : & + & stdin=>input_unit, stdout=>output_unit, stderr=>error_unit +integer,intent(in) :: lun +character(len=256) :: message +integer :: ios + if(lun.ne.-1)then + close(unit=lun,iostat=ios,iomsg=message) if(ios.ne.0)then - write(stderr,'(*(a:,1x))')& - & ' *filewrite*:',filename,trim(message) - error stop 4 + write(stderr,'(*(a:,1x))')' *filewrite*:',trim(message) + stop 2 endif - enddo - ! close file - close(unit=lun,iostat=ios,iomsg=message) - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')' *filewrite*:',trim(message) - error stop 2 endif +end subroutine fileclose + +subroutine filewrite(filename,filedata) +! procedure to write filedata to file filename +use,intrinsic :: iso_fortran_env, only : & + & stdin=>input_unit, stdout=>output_unit, stderr=>error_unit + +character(len=*),intent(in) :: filename +character(len=*),intent(in) :: filedata(:) +integer :: lun, i, ios +character(len=256) :: message + call fileopen(filename,lun) + if(lun.ne.-1)then ! program currently stops on error on open, but might + ! want it to continue so -1 (unallowed LUN) indicates error + ! write file + do i=1,size(filedata) + write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i)) + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')& + & ' *filewrite*:',filename,trim(message) + stop 4 + endif + enddo + endif + ! close file + call fileclose(lun) + end subroutine filewrite +subroutine validate_toml_data(input) +!> verify a string array is a valid fpm.toml file +! +use tomlf, only : toml_parse +use fpm_toml, only : toml_table, toml_serializer +implicit none +character(kind=tfc,len=:),intent(in),allocatable :: input(:) +character(len=1), parameter :: nl = new_line('a') +type(toml_table), allocatable :: table +character(kind=tfc, len=:), allocatable :: joined_string +type(toml_serializer) :: ser + +! you have to add a newline character by using the intrinsic +! function `new_line("a")` to get the lines processed correctly. +joined_string = join(input,right=nl) + +if (allocated(table)) deallocate(table) +call toml_parse(table, joined_string) +if (allocated(table)) then + if(settings%verbose)then + ! If the TOML file is successfully parsed the table will be allocated and + ! can be written to the standard output by passing the `toml_serializer` + ! as visitor to the table. + call table%accept(ser) + endif + call table%destroy +endif + +end subroutine validate_toml_data + +pure function join(str,sep,trm,left,right) result (string) + +!> M_strings::join(3f): append an array of character variables with specified separator into a single CHARACTER variable +!> +!>##NAME +!> join(3f) - [M_strings:EDITING] append CHARACTER variable array into +!> a single CHARACTER variable with specified separator +!> (LICENSE:PD) +!> +!>##SYNOPSIS +!> +!> pure function join(str,sep,trm,left,right) result (string) +!> +!> character(len=*),intent(in) :: str(:) +!> character(len=*),intent(in),optional :: sep +!> logical,intent(in),optional :: trm +!> character(len=*),intent(in),optional :: right +!> character(len=*),intent(in),optional :: left +!> character(len=:),allocatable :: string +!> +!>##DESCRIPTION +!> JOIN(3f) appends the elements of a CHARACTER array into a single +!> CHARACTER variable, with elements 1 to N joined from left to right. +!> By default each element is trimmed of trailing spaces and the +!> default separator is a null string. +!> +!>##OPTIONS +!> STR(:) array of CHARACTER variables to be joined +!> SEP separator string to place between each variable. defaults +!> to a null string. +!> LEFT string to place at left of each element +!> RIGHT string to place at right of each element +!> TRM option to trim each element of STR of trailing +!> spaces. Defaults to .TRUE. +!> +!>##RESULT +!> STRING CHARACTER variable composed of all of the elements of STR() +!> appended together with the optional separator SEP placed +!> between the elements. +!> +!>##EXAMPLE +!> +!> Sample program: +!> +!> program demo_join +!> use M_strings, only: join +!> implicit none +!> character(len=:),allocatable :: s(:) +!> character(len=:),allocatable :: out +!> integer :: i +!> s=[character(len=10) :: 'United',' we',' stand,', & +!> & ' divided',' we fall.'] +!> out=join(s) +!> write(*,'(a)') out +!> write(*,'(a)') join(s,trm=.false.) +!> write(*,'(a)') (join(s,trm=.false.,sep='|'),i=1,3) +!> write(*,'(a)') join(s,sep='<>') +!> write(*,'(a)') join(s,sep=';',left='[',right=']') +!> write(*,'(a)') join(s,left='[',right=']') +!> write(*,'(a)') join(s,left='>>') +!> end program demo_join +!> +!> Expected output: +!> +!> United we stand, divided we fall. +!> United we stand, divided we fall. +!> United | we | stand, | divided | we fall. | +!> United | we | stand, | divided | we fall. | +!> United | we | stand, | divided | we fall. | +!> United<> we<> stand,<> divided<> we fall.<> +!> [United];[ we];[ stand,];[ divided];[ we fall.]; +!> [United][ we][ stand,][ divided][ we fall.] +!> >>United>> we>> stand,>> divided>> we fall. +!> +!>##AUTHOR +!> John S. Urban +!> +!>##LICENSE +!> Public Domain + +character(len=*,kind=tfc),intent(in) :: str(:) +character(len=*),intent(in),optional :: sep, right, left +logical,intent(in),optional :: trm +character(len=:,kind=tfc),allocatable :: string +integer :: i +logical :: trm_local +character(len=:),allocatable :: sep_local, left_local, right_local + + if(present(sep))then ; sep_local=sep ; else ; sep_local='' ; endif + if(present(trm))then ; trm_local=trm ; else ; trm_local=.true. ; endif + if(present(left))then ; left_local=left ; else ; left_local='' ; endif + if(present(right))then ; right_local=right ; else ; right_local='' ; endif + + string='' + do i = 1,size(str) + if(trm_local)then + string=string//left_local//trim(str(i))//right_local//sep_local + else + string=string//left_local//str(i)//right_local//sep_local + endif + enddo +end function join + end subroutine cmd_new end module fpm_cmd_new diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 85bfc94..5bfcc8d 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -55,6 +55,8 @@ type, extends(fpm_cmd_settings) :: fpm_new_settings logical :: with_test=.false. logical :: with_lib=.true. logical :: with_example=.false. + logical :: with_full=.false. + logical :: with_bare=.false. logical :: backfill=.true. end type @@ -205,21 +207,23 @@ contains & --app F & & --test F & & --example F & - & --backfill F& - & --verbose F',& + & --backfill F & + & --full F & + & --bare F & + & --verbose:V F',& & help_new, version_text) select case(size(unnamed)) case(1) write(stderr,'(*(g0,/))')' directory name required' write(stderr,'(*(7x,g0,/))') & - & ' fpm new NAME [--lib|--src] [--app] [--test] [--example] [--backfill]' + & ' fpm new NAME [[--lib|--src] [--app] [--test] [--example]]|[--full|--bare] [--backfill]' stop 1 case(2) name=trim(unnamed(2)) case default write(stderr,'(g0)')' only one directory name allowed' write(stderr,'(7x,g0)') & - & ' fpm new NAME [--lib|--src] [--app] [--test] [--example] [--backfill]' + & ' fpm new NAME [[--lib|--src] [--app] [--test] [--example]]| [--full|--bare] [--backfill]' stop 2 end select !*! canon_path is not converting ".", etc. @@ -235,8 +239,19 @@ contains endif allocate(fpm_new_settings :: cmd_settings) - - if (any( specified([character(len=10) :: 'src','lib','app','test','example']) ) )then + if (any( specified([character(len=10) :: 'src','lib','app','test','example','bare'])) & + & .and.lget('full') )then + write(stderr,'(*(a))')& + &' --full and any of [--src|--lib,--app,--test,--example,--bare]', & + &' are mutually exclusive.' + stop 5 + elseif (any( specified([character(len=10) :: 'src','lib','app','test','example','full'])) & + & .and.lget('bare') )then + write(stderr,'(*(a))')& + &' --bare and any of [--src|--lib,--app,--test,--example,--full]', & + &' are mutually exclusive.' + stop 3 + elseif (any( specified([character(len=10) :: 'src','lib','app','test','example']) ) )then cmd_settings=fpm_new_settings(& & backfill=lget('backfill'), & & name=name, & @@ -252,7 +267,10 @@ contains & with_executable=.true., & & with_lib=.true., & & with_test=.true., & - & with_example=lget('verbose'), & + & with_example=.true., & + !*!& with_example=lget('full'), & + & with_full=lget('full'), & + & with_bare=lget('bare'), & & verbose=lget('verbose') ) endif @@ -480,7 +498,8 @@ contains ' ', & ' build [--compiler COMPILER_NAME] [--release] [--list] ', & ' help [NAME(s)] ', & - ' new NAME [--lib|--src] [--app] [--test] [--example] [--backfill] ', & + ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & + ' [--full|--bare][--backfill] ', & ' update [NAME(s)] [--fetch-only] [--clean] [--verbose] ', & ' list [--list] ', & ' run [[--target] NAME(s)] [--release] [--runner "CMD"] [--list] [--example] ', & @@ -593,7 +612,8 @@ contains ' Their syntax is ', & ' ', & ' build [--release] [--list] [--compiler COMPILER_NAME] ', & - ' new NAME [--lib|--src] [--app] [--test] [--example] [--backfill] ', & + ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & + ' [--full|--bare][--backfill] ', & ' update [NAME(s)] [--fetch-only] [--clean] ', & ' run [[--target] NAME(s)] [--release] [--list] [--example] ', & ' [--runner "CMD"] [--compiler COMPILER_NAME] [-- ARGS] ', & @@ -795,8 +815,8 @@ contains 'NAME ', & ' new(1) - the fpm(1) subcommand to initialize a new project ', & 'SYNOPSIS ', & - ' fpm new NAME [--lib|--src] [--app] [--test] [--example] [--backfill] ', & - ' ', & + ' fpm new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & + ' [--full|--bare][--backfill] ', & ' fpm new --help|--version ', & ' ', & 'DESCRIPTION ', & @@ -864,13 +884,17 @@ contains ' "fpm new myname --backfill" will create the missing ', & ' app/ and test/ directories and programs. ', & ' ', & - ' --verbose By default a minimal manifest file ("fpm.toml") is ', & + ' --full By default a minimal manifest file ("fpm.toml") is ', & ' created that depends on auto-discovery and (as noted) ', & ' the example/ directory is only created if explicitly ', & ' asked for. With this option a much more extensive ', & ' manifest sample is written and the example/ directory ', & ' is created by default as well. ', & ' ', & + ' --bare A minimal manifest file ("fpm.toml") is created and ', & + ' a ".gitignore" and "README.md" file is created but no ', & + ' directories or sample Fortran is generated. ', & + ' ', & ' --help print this help and exit ', & ' --version print program version information and exit ', & ' ', & -- cgit v1.2.3 From bddf01b9a9ad13b4240b38a4a5fbbd39daea17cb Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Tue, 22 Dec 2020 09:24:12 -0500 Subject: adjust documentation to latest proposal --- fpm/src/fpm_command_line.f90 | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 5bfcc8d..18e4429 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -847,7 +847,7 @@ contains ' small packages primarily intended to be used as dependendencies. ', & ' ', & ' If you find this restrictive and need to customize the package ', & - ' structure you will find using the --verbose switch creates a ', & + ' structure you will find using the --full switch creates a ', & ' heavily annotated manifest file with references to documentation ', & ' to aid in constructing complex package structures. ', & ' ', & @@ -885,11 +885,8 @@ contains ' app/ and test/ directories and programs. ', & ' ', & ' --full By default a minimal manifest file ("fpm.toml") is ', & - ' created that depends on auto-discovery and (as noted) ', & - ' the example/ directory is only created if explicitly ', & - ' asked for. With this option a much more extensive ', & - ' manifest sample is written and the example/ directory ', & - ' is created by default as well. ', & + ' created that depends on auto-discovery. With this ', & + ' option a much more extensive manifest sample is written. ', & ' ', & ' --bare A minimal manifest file ("fpm.toml") is created and ', & ' a ".gitignore" and "README.md" file is created but no ', & -- cgit v1.2.3 From 9732d314b4cdb73796faea76a6cfa305964f853d Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Fri, 25 Dec 2020 01:24:02 -0500 Subject: code arrangement Re-arranged the code. Will add amendments to manifest created by --full option shortly. Any other discussions still open? --- fpm/src/fpm/cmd/new.f90 | 214 +++---------------------------------------- fpm/src/fpm_command_line.f90 | 4 +- fpm/src/fpm_filesystem.f90 | 129 ++++++++++++++++++++++---- fpm/src/fpm_strings.f90 | 122 ++++++++++++++++++++++-- 4 files changed, 240 insertions(+), 229 deletions(-) diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index 9b0b362..52a5d42 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -7,7 +7,7 @@ module fpm_cmd_new !> from this type to decide what actions to take. !> !> It is virtually self-contained and so independant of the rest of the -!> application that it could function as a seperate program. +!> application that it could function as a separate program. !> !> The "new" subcommand options currently consist of a SINGLE top !> directory name to create that must have a name that is an @@ -16,7 +16,7 @@ module fpm_cmd_new !> So basically this routine has already had the options vetted and !> just needs to conditionally create a few files. !> -!> As described in the documentation documentation it will selectively +!> As described in the documentation it will selectively !> create the subdirectories app/, test/, src/, and example/ !> and populate them with sample files. !> @@ -56,6 +56,8 @@ module fpm_cmd_new use fpm_command_line, only : fpm_new_settings use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS use fpm_filesystem, only : join_path, exists, basename, mkdir, is_dir +use fpm_filesystem, only : fileopen, fileclose, filewrite, warnwrite +use fpm_strings, only : join use,intrinsic :: iso_fortran_env, only : stderr=>error_unit implicit none private @@ -148,6 +150,9 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &' ',& &'## BUILD CONFIGURATION SECTION ',& &'[build] ',& + &'# ',& + &'# Files will be searched for automatically (by default) in src/, app/, test/ ',& + &'# and example/. This can be turned off for app/, test, exampl ',& &'auto-executables = true # Toggle automatic discovery of executables ',& &'auto-examples = true # Toggle automatic discovery of example programs ',& &'auto-tests = true # Toggle automatic discovery of test executables ',& @@ -270,9 +275,6 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) if(settings%with_full)then tomlfile=[character(len=80) :: tomlfile, & &'[dependencies] ', & - &'# ', & - &'#Files will be searched for automatically (by default) in ', & - &'# src/, app/, test/, and example/. ', & &'#For a complete list of keys and their attributes see ', & &'# ', & &'# https://github.com/fortran-lang/fpm/blob/master/manifest-reference.md ', & @@ -311,11 +313,11 @@ character(len=*),intent(in) :: filename ser = toml_serializer() call fileopen(filename,lun) ! fileopen stops on error - call set_value(table, "name", BNAME) - call set_value(table, "version", "0.1.0") - call set_value(table, "license", "license") - call set_value(table, "author", "Jane Doe") - call set_value(table, "maintainer", "jane.doe@example.com") + call set_value(table, "name", BNAME) + call set_value(table, "version", "0.1.0") + call set_value(table, "license", "license") + call set_value(table, "author", "Jane Doe") + call set_value(table, "maintainer", "jane.doe@example.com") call set_value(table, "copyright", 'Copyright '//date(1:4)//', Jane Doe') ! continue building of manifest ! ... @@ -330,95 +332,6 @@ character(len=*),intent(in) :: filename end subroutine create_verified_basic_manifest -subroutine warnwrite(fname,data) -character(len=*),intent(in) :: fname -character(len=*),intent(in) :: data(:) - - if(.not.exists(fname))then - call filewrite(fname,data) - else - write(stderr,'(*(g0,1x))')' ',fname,& - & 'already exists. Not overwriting' - endif - -end subroutine warnwrite - -subroutine fileopen(filename,lun) -! procedure to open filedata to file filename -use,intrinsic :: iso_fortran_env, only : & - & stdin=>input_unit, stdout=>output_unit, stderr=>error_unit - -character(len=*),intent(in) :: filename -integer,intent(out) :: lun -integer :: i, ios -character(len=256) :: message - - message=' ' - ios=0 - if(filename.ne.' ')then - open(file=filename, & - & newunit=lun, & - & form='formatted', & ! FORM = FORMATTED | UNFORMATTED - & access='sequential', & ! ACCESS = SEQUENTIAL| DIRECT | STREAM - & action='write', & ! ACTION = READ|WRITE| READWRITE - & position='rewind', & ! POSITION= ASIS | REWIND | APPEND - & status='new', & ! STATUS = NEW| REPLACE| OLD| SCRATCH| UNKNOWN - & iostat=ios, & - & iomsg=message) - else - lun=stdout - ios=0 - endif - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')& - & ' *filewrite*:',filename,trim(message) - lun=-1 - stop 1 - endif - -end subroutine fileopen - -subroutine fileclose(lun) -use,intrinsic :: iso_fortran_env, only : & - & stdin=>input_unit, stdout=>output_unit, stderr=>error_unit -integer,intent(in) :: lun -character(len=256) :: message -integer :: ios - if(lun.ne.-1)then - close(unit=lun,iostat=ios,iomsg=message) - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')' *filewrite*:',trim(message) - stop 2 - endif - endif -end subroutine fileclose - -subroutine filewrite(filename,filedata) -! procedure to write filedata to file filename -use,intrinsic :: iso_fortran_env, only : & - & stdin=>input_unit, stdout=>output_unit, stderr=>error_unit - -character(len=*),intent(in) :: filename -character(len=*),intent(in) :: filedata(:) -integer :: lun, i, ios -character(len=256) :: message - call fileopen(filename,lun) - if(lun.ne.-1)then ! program currently stops on error on open, but might - ! want it to continue so -1 (unallowed LUN) indicates error - ! write file - do i=1,size(filedata) - write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i)) - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')& - & ' *filewrite*:',filename,trim(message) - stop 4 - endif - enddo - endif - ! close file - call fileclose(lun) - -end subroutine filewrite subroutine validate_toml_data(input) !> verify a string array is a valid fpm.toml file @@ -450,109 +363,6 @@ endif end subroutine validate_toml_data -pure function join(str,sep,trm,left,right) result (string) - -!> M_strings::join(3f): append an array of character variables with specified separator into a single CHARACTER variable -!> -!>##NAME -!> join(3f) - [M_strings:EDITING] append CHARACTER variable array into -!> a single CHARACTER variable with specified separator -!> (LICENSE:PD) -!> -!>##SYNOPSIS -!> -!> pure function join(str,sep,trm,left,right) result (string) -!> -!> character(len=*),intent(in) :: str(:) -!> character(len=*),intent(in),optional :: sep -!> logical,intent(in),optional :: trm -!> character(len=*),intent(in),optional :: right -!> character(len=*),intent(in),optional :: left -!> character(len=:),allocatable :: string -!> -!>##DESCRIPTION -!> JOIN(3f) appends the elements of a CHARACTER array into a single -!> CHARACTER variable, with elements 1 to N joined from left to right. -!> By default each element is trimmed of trailing spaces and the -!> default separator is a null string. -!> -!>##OPTIONS -!> STR(:) array of CHARACTER variables to be joined -!> SEP separator string to place between each variable. defaults -!> to a null string. -!> LEFT string to place at left of each element -!> RIGHT string to place at right of each element -!> TRM option to trim each element of STR of trailing -!> spaces. Defaults to .TRUE. -!> -!>##RESULT -!> STRING CHARACTER variable composed of all of the elements of STR() -!> appended together with the optional separator SEP placed -!> between the elements. -!> -!>##EXAMPLE -!> -!> Sample program: -!> -!> program demo_join -!> use M_strings, only: join -!> implicit none -!> character(len=:),allocatable :: s(:) -!> character(len=:),allocatable :: out -!> integer :: i -!> s=[character(len=10) :: 'United',' we',' stand,', & -!> & ' divided',' we fall.'] -!> out=join(s) -!> write(*,'(a)') out -!> write(*,'(a)') join(s,trm=.false.) -!> write(*,'(a)') (join(s,trm=.false.,sep='|'),i=1,3) -!> write(*,'(a)') join(s,sep='<>') -!> write(*,'(a)') join(s,sep=';',left='[',right=']') -!> write(*,'(a)') join(s,left='[',right=']') -!> write(*,'(a)') join(s,left='>>') -!> end program demo_join -!> -!> Expected output: -!> -!> United we stand, divided we fall. -!> United we stand, divided we fall. -!> United | we | stand, | divided | we fall. | -!> United | we | stand, | divided | we fall. | -!> United | we | stand, | divided | we fall. | -!> United<> we<> stand,<> divided<> we fall.<> -!> [United];[ we];[ stand,];[ divided];[ we fall.]; -!> [United][ we][ stand,][ divided][ we fall.] -!> >>United>> we>> stand,>> divided>> we fall. -!> -!>##AUTHOR -!> John S. Urban -!> -!>##LICENSE -!> Public Domain - -character(len=*,kind=tfc),intent(in) :: str(:) -character(len=*),intent(in),optional :: sep, right, left -logical,intent(in),optional :: trm -character(len=:,kind=tfc),allocatable :: string -integer :: i -logical :: trm_local -character(len=:),allocatable :: sep_local, left_local, right_local - - if(present(sep))then ; sep_local=sep ; else ; sep_local='' ; endif - if(present(trm))then ; trm_local=trm ; else ; trm_local=.true. ; endif - if(present(left))then ; left_local=left ; else ; left_local='' ; endif - if(present(right))then ; right_local=right ; else ; right_local='' ; endif - - string='' - do i = 1,size(str) - if(trm_local)then - string=string//left_local//trim(str(i))//right_local//sep_local - else - string=string//left_local//str(i)//right_local//sep_local - endif - enddo -end function join - end subroutine cmd_new end module fpm_cmd_new diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 18e4429..2256530 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -93,7 +93,7 @@ end type character(len=:),allocatable :: name character(len=:),allocatable :: os_type -character(len=ibug),allocatable :: names(:) +character(len=ibug),allocatable :: names(:) character(len=:),allocatable :: tnames(:) character(len=:), allocatable :: version_text(:) @@ -434,7 +434,7 @@ contains if(val_compiler.eq.'') then val_compiler='gfortran' endif - + val_build=trim(merge('release','debug ',lget('release'))) end subroutine check_build_vals diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index f221917..7f1cbf5 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -1,4 +1,5 @@ module fpm_filesystem +use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit use fpm_environment, only: get_os_type, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD @@ -7,6 +8,7 @@ module fpm_filesystem private public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, read_lines, list_files, env_variable, & mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file + public :: fileopen, fileclose, filewrite, warnwrite integer, parameter :: LINE_BUFFER_LEN = 1000 @@ -73,7 +75,7 @@ function canon_path(path) result(canon) ! Canonicalize path for comparison ! Handles path string redundancies ! Does not test existence of path - ! + ! ! To be replaced by realpath/_fullname in stdlib_os ! character(*), intent(in) :: path @@ -127,7 +129,7 @@ function canon_path(path) result(canon) end if end if - + temp(j:j) = nixpath(i:i) j = j + 1 @@ -152,23 +154,23 @@ function dirname(path) result (dir) end function dirname -logical function is_dir(dir) - character(*), intent(in) :: dir - integer :: stat +logical function is_dir(dir) + character(*), intent(in) :: dir + integer :: stat - select case (get_os_type()) + select case (get_os_type()) case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD) - call execute_command_line("test -d " // dir , exitstat=stat) + call execute_command_line("test -d " // dir , exitstat=stat) - case (OS_WINDOWS) - call execute_command_line('cmd /c "if not exist ' // windows_path(dir) // '\ exit /B 1"', exitstat=stat) + case (OS_WINDOWS) + call execute_command_line('cmd /c "if not exist ' // windows_path(dir) // '\ exit /B 1"', exitstat=stat) - end select + end select - is_dir = (stat == 0) + is_dir = (stat == 0) -end function is_dir +end function is_dir function join_path(a1,a2,a3,a4,a5) result(path) @@ -315,7 +317,7 @@ recursive subroutine list_files(dir, files, recurse) do i=1,size(files) if (is_dir(files(i)%s)) then - call list_files(files(i)%s, dir_files, recurse=.true.) + call list_files(files(i)%s, dir_files, recurse=.true.) sub_dir_files = [sub_dir_files, dir_files] end if @@ -347,7 +349,7 @@ function get_temp_filename() result(tempfile) type(c_ptr) :: c_tempfile_ptr character(len=1), pointer :: c_tempfile(:) - + interface function c_tempnam(dir,pfx) result(tmp) bind(c,name="tempnam") @@ -389,7 +391,7 @@ function windows_path(path) result(winpath) winpath(idx:idx) = '\' idx = index(winpath,'/') end do - + end function windows_path @@ -408,7 +410,7 @@ function unix_path(path) result(nixpath) nixpath(idx:idx) = '/' idx = index(nixpath,'\') end do - + end function unix_path @@ -464,5 +466,100 @@ subroutine delete_file(file) end if end subroutine delete_file +subroutine warnwrite(fname,data) +!> write trimmed character data to a file if it does not exist +character(len=*),intent(in) :: fname +character(len=*),intent(in) :: data(:) + + if(.not.exists(fname))then + call filewrite(fname,data) + else + write(stderr,'(*(g0,1x))')' ',fname,& + & 'already exists. Not overwriting' + endif + +end subroutine warnwrite + +subroutine fileopen(filename,lun,ier) +! procedure to open filename as a sequential "text" file + +character(len=*),intent(in) :: filename +integer,intent(out) :: lun +integer,intent(out),optional :: ier +integer :: i, ios +character(len=256) :: message + + message=' ' + ios=0 + if(filename.ne.' ')then + open(file=filename, & + & newunit=lun, & + & form='formatted', & ! FORM = FORMATTED | UNFORMATTED + & access='sequential', & ! ACCESS = SEQUENTIAL| DIRECT | STREAM + & action='write', & ! ACTION = READ|WRITE| READWRITE + & position='rewind', & ! POSITION= ASIS | REWIND | APPEND + & status='new', & ! STATUS = NEW| REPLACE| OLD| SCRATCH| UNKNOWN + & iostat=ios, & + & iomsg=message) + else + lun=stdout + ios=0 + endif + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')& + & ' *filewrite*:',filename,trim(message) + lun=-1 + if(present(ier))then + ier=ios + else + stop 1 + endif + endif + +end subroutine fileopen + +subroutine fileclose(lun,ier) +! simple close of a LUN. On error show message and stop (by default) +integer,intent(in) :: lun +integer,intent(out),optional :: ier +character(len=256) :: message +integer :: ios + if(lun.ne.-1)then + close(unit=lun,iostat=ios,iomsg=message) + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')' *filewrite*:',trim(message) + if(present(ier))then + ier=ios + else + stop 2 + endif + endif + endif +end subroutine fileclose + +subroutine filewrite(filename,filedata) +! procedure to write filedata to file filename + +character(len=*),intent(in) :: filename +character(len=*),intent(in) :: filedata(:) +integer :: lun, i, ios +character(len=256) :: message + call fileopen(filename,lun) + if(lun.ne.-1)then ! program currently stops on error on open, but might + ! want it to continue so -1 (unallowed LUN) indicates error + ! write file + do i=1,size(filedata) + write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i)) + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')& + & ' *filewrite*:',filename,trim(message) + stop 4 + endif + enddo + endif + ! close file + call fileclose(lun) + +end subroutine filewrite end module fpm_filesystem diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index 8e57d5b..649be36 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -6,6 +6,7 @@ private public :: f_string, lower, split, str_ends_with, string_t public :: string_array_contains, string_cat, operator(.in.), fnv_1a public :: resize +public :: join type string_t character(len=:), allocatable :: s @@ -48,7 +49,7 @@ pure logical function str_ends_with_any(s, e) result(r) character(*), intent(in) :: e(:) integer :: i - + r = .true. do i=1,size(e) @@ -76,11 +77,11 @@ function f_string(c_string) do i=1,n f_string(i:i) = c_string(i) end do - + end function f_string -!> Hash a character(*) string of default kind +!> Hash a character(*) string of default kind pure function fnv_1a_char(input, seed) result(hash) character(*), intent(in) :: input integer(int64), intent(in), optional :: seed @@ -103,7 +104,7 @@ pure function fnv_1a_char(input, seed) result(hash) end function fnv_1a_char -!> Hash a string_t array of default kind +!> Hash a string_t array of default kind pure function fnv_1a_string_t(input, seed) result(hash) type(string_t), intent(in) :: input(:) integer(int64), intent(in), optional :: seed @@ -166,7 +167,7 @@ logical function string_array_contains(search_string,array) end function string_array_contains -!> Concatenate an array of type(string_t) into +!> Concatenate an array of type(string_t) into !> a single character function string_cat(strings,delim) result(cat) type(string_t), intent(in) :: strings(:) @@ -191,7 +192,7 @@ function string_cat(strings,delim) result(cat) do i=2,size(strings) cat = cat//delim_str//strings(i)%s - + end do end function string_cat @@ -201,7 +202,7 @@ subroutine split(input_line,array,delimiters,order,nulls) ! Author: John S. Urban ! License: Public Domain - + ! given a line of structure " par1 par2 par3 ... parn " store each par(n) into a separate variable in array. ! o by default adjacent delimiters in the input string do not create an empty string in the output array ! o no quoting of delimiters is supported @@ -210,7 +211,7 @@ subroutine split(input_line,array,delimiters,order,nulls) character(len=*),optional,intent(in) :: order ! order of output array sequential|[reverse|right] character(len=*),optional,intent(in) :: nulls ! return strings composed of delimiters or not ignore|return|ignoreend character(len=:),allocatable,intent(out) :: array(:) ! output array of tokens - + integer :: n ! max number of strings INPUT_LINE could split into if all delimiter integer,allocatable :: ibegin(:) ! positions in input string where tokens start integer,allocatable :: iterm(:) ! positions in input string where tokens end @@ -227,7 +228,7 @@ subroutine split(input_line,array,delimiters,order,nulls) integer :: inotnull ! count strings not composed of delimiters integer :: ireturn ! number of tokens returned integer :: imax ! length of longest token - + ! decide on value for optional DELIMITERS parameter if (present(delimiters)) then ! optional delimiter list was present if(delimiters.ne.'')then ! if DELIMITERS was specified and not null use it @@ -349,4 +350,107 @@ subroutine resize_string(list, n) end subroutine resize_string +pure function join(str,sep,trm,left,right) result (string) + +!> M_strings::join(3f): append an array of character variables with specified separator into a single CHARACTER variable +!> +!>##NAME +!> join(3f) - [M_strings:EDITING] append CHARACTER variable array into +!> a single CHARACTER variable with specified separator +!> (LICENSE:PD) +!> +!>##SYNOPSIS +!> +!> pure function join(str,sep,trm,left,right) result (string) +!> +!> character(len=*),intent(in) :: str(:) +!> character(len=*),intent(in),optional :: sep +!> logical,intent(in),optional :: trm +!> character(len=*),intent(in),optional :: right +!> character(len=*),intent(in),optional :: left +!> character(len=:),allocatable :: string +!> +!>##DESCRIPTION +!> JOIN(3f) appends the elements of a CHARACTER array into a single +!> CHARACTER variable, with elements 1 to N joined from left to right. +!> By default each element is trimmed of trailing spaces and the +!> default separator is a null string. +!> +!>##OPTIONS +!> STR(:) array of CHARACTER variables to be joined +!> SEP separator string to place between each variable. defaults +!> to a null string. +!> LEFT string to place at left of each element +!> RIGHT string to place at right of each element +!> TRM option to trim each element of STR of trailing +!> spaces. Defaults to .TRUE. +!> +!>##RESULT +!> STRING CHARACTER variable composed of all of the elements of STR() +!> appended together with the optional separator SEP placed +!> between the elements and optional left and right elements. +!> +!>##EXAMPLE +!> +!> Sample program: +!> +!> program demo_join +!> use M_strings, only: join +!> implicit none +!> character(len=:),allocatable :: s(:) +!> character(len=:),allocatable :: out +!> integer :: i +!> s=[character(len=10) :: 'United',' we',' stand,', & +!> & ' divided',' we fall.'] +!> out=join(s) +!> write(*,'(a)') out +!> write(*,'(a)') join(s,trm=.false.) +!> write(*,'(a)') (join(s,trm=.false.,sep='|'),i=1,3) +!> write(*,'(a)') join(s,sep='<>') +!> write(*,'(a)') join(s,sep=';',left='[',right=']') +!> write(*,'(a)') join(s,left='[',right=']') +!> write(*,'(a)') join(s,left='>>') +!> end program demo_join +!> +!> Expected output: +!> +!> United we stand, divided we fall. +!> United we stand, divided we fall. +!> United | we | stand, | divided | we fall. | +!> United | we | stand, | divided | we fall. | +!> United | we | stand, | divided | we fall. | +!> United<> we<> stand,<> divided<> we fall.<> +!> [United];[ we];[ stand,];[ divided];[ we fall.]; +!> [United][ we][ stand,][ divided][ we fall.] +!> >>United>> we>> stand,>> divided>> we fall. +!> +!>##AUTHOR +!> John S. Urban +!> +!>##LICENSE +!> Public Domain + +character(len=*),intent(in) :: str(:) +character(len=*),intent(in),optional :: sep, right, left +logical,intent(in),optional :: trm +character(len=:),allocatable :: string +integer :: i +logical :: trm_local +character(len=:),allocatable :: sep_local, left_local, right_local + + if(present(sep))then ; sep_local=sep ; else ; sep_local='' ; endif + if(present(trm))then ; trm_local=trm ; else ; trm_local=.true. ; endif + if(present(left))then ; left_local=left ; else ; left_local='' ; endif + if(present(right))then ; right_local=right ; else ; right_local='' ; endif + + string='' + do i = 1,size(str) + if(trm_local)then + string=string//left_local//trim(str(i))//right_local//sep_local + else + string=string//left_local//str(i)//right_local//sep_local + endif + enddo +end function join + end module fpm_strings -- cgit v1.2.3 From 26065c995953ec2b8bb875e659877fc2b8352b60 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Fri, 25 Dec 2020 08:30:14 -0500 Subject: src/fpm_strings.f90 --- fpm/src/fpm_strings.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index 4c18b59..2430237 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -455,7 +455,6 @@ character(len=:),allocatable :: sep_local, left_local, right_local endif enddo end function join -======= pure integer function str_int_len(i) result(sz) ! Returns the length of the string representation of 'i' integer, intent(in) :: i -- cgit v1.2.3 From 4a10462f5a6ef27cb3040ee65a24bab351d524eb Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Sun, 27 Dec 2020 17:24:16 -0500 Subject: annotated fpm.toml So in for a pence, in for a pound. On the "new" subcommand if the "--full" parameter is supplied a fully annotated "fpm.tom" file is generated much like products like doxygen(1) produce. This allows a user to compose a complex package build more easily, without referring to external documentation to compose the manifest. --- fpm/src/fpm/cmd/new.f90 | 501 ++++++++++++++++++++++++++++++++++--------- fpm/src/fpm_command_line.f90 | 15 +- 2 files changed, 405 insertions(+), 111 deletions(-) diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index 52a5d42..c9d333e 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -107,59 +107,158 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) ! start building NAME/fpm.toml if(settings%with_full)then - tomlfile=[character(len=80) :: & - &'# Manifest root ',& - &' ',& - &'## Project Identification ',& - &'name = "'//bname//'"', & - &' # The project name (required) is how the project will be referred to. ',& - &' # It is used by another package using it as a dependency and as the ',& - &' # default name of the library built from src/. ',& - &' ',& - &'version = "0.1.0" ',& - &' # The project version number is a string. A recommended standardized way ',& - &' # to manage and specify versions is the Semantic Versioning scheme. ',& - &' ',& - &'license = "license" ',& - &' # Licensing information specified using a standard such as SPDX ',& - &' # identifiers are preferred (eg. "Apache-2.0 OR MIT" or "LGPL-3.0-or-later").',& - &' ',& - &'maintainer = "jane.doe@example.com" ',& - &' # Information on the project maintainer and means to reach out to them. ',& - &' ',& - &'author = "Jane Doe" ',& - &' # Information on the project author. ',& - &' ',& - &'copyright = "Copyright 2020 Jane Doe" ',& - &' # A statement clarifying the Copyright status of the project. ',& - &' ',& - &'#description = "A short project summary in plain text" ',& - &' # The description provides a short summary on the project. It should be ',& - &' # plain text and not use any markup formatting. ',& - &' ',& - &'#categories = ["fortran", "graphics"] ',& - &' # Categories associated with the project. Listing only one is preferred. ',& - &' ',& - &'#keywords = ["hdf5", "mpi"] ',& - &' # The keywords field is an array of strings describing the project. ',& - &' ',& - &'#homepage = "https://stdlib.fortran-lang.org" ',& - &' # URL to the webpage of the project. ',& - &' ',& - &'## TABLES ',& - &' ',& - &'## BUILD CONFIGURATION SECTION ',& - &'[build] ',& - &'# ',& - &'# Files will be searched for automatically (by default) in src/, app/, test/ ',& - &'# and example/. This can be turned off for app/, test, exampl ',& - &'auto-executables = true # Toggle automatic discovery of executables ',& - &'auto-examples = true # Toggle automatic discovery of example programs ',& - &'auto-tests = true # Toggle automatic discovery of test executables ',& - &'#link = ["blas", "lapack", "z", "X11"] # Linking against libraries ',& - &' ',& - &'## TARGETS ',& - &''] + tomlfile=[character(len=80) :: & + &' # This is your fpm(Fortran Package Manager) manifest file ',& + &' # ("fpm.toml"). It is heavily annotated to help guide you though ',& + &' # customizing a package build, although the defaults are sufficient ',& + &' # for many basic packages. ',& + &' # ',& + &' # The manifest file is not only used to provide metadata identifying ',& + &' # your project (so it can be used by others as a dependency). It can ',& + &' # specify where your library and program sources live, what the name ',& + &' # of the executable(s) will be, what files to build, dependencies on ',& + &' # other fpm packages, and what external libraries are required. ',& + &' # ',& + &' # The manifest format must conform to the TOML configuration file ',& + &' # standard. ',& + &' # ',& + &' # TOML files support flexible use of white-space and commenting of the ',& + &' # configuration data, but for clarity in this sample active directives ',& + &' # begin in column one. Inactive example directives are commented ',& + &' # out with a pound character ("#") but begin in column one as well. ',& + &' # Commentary begins with a pound character in column three. ',& + &' # ',& + &' # This file draws heavily upon the following references: ',& + &' # ',& + &' # The fpm home page at ',& + &' # https://github.com/fortran-lang/fpm ',& + &' # A complete list of keys and their attributes at ',& + &' # https://github.com/fortran-lang/fpm/blob/master/manifest-reference.md ',& + &' # examples of fpm project packaging at ',& + &' # https://github.com/fortran-lang/fpm/blob/master/PACKAGING.md ',& + &' # The Fortran TOML file interface and it''s references at ',& + &' # https://github.com/toml-f/toml-f ',& + &' # ',& + &' #----------------------- ',& + &' # project Identification ',& + &' #----------------------- ',& + &' # We begin with project metadata at the manifest root. This data is designed ',& + &' # to aid others when searching for the project in a repository and to ',& + &' # identify how and when to contact the package supporters. ',& + &' ',& + &'name = "'//settings%name//'"',& + &' # The project name (required) is how the project will be referred to. ',& + &' # The name is used by other packages using it as a dependency. It also ',& + &' # is used as the default name of any library built and the optional ',& + &' # default executable built from app/main.f90. It must conform to the rules ',& + &' # for a Fortran variable name. ',& + &' ',& + &'version = "0.1.0" ',& + &' # The project version number is a string. A recommended scheme for ',& + &' # specifying versions is the Semantic Versioning scheme. ',& + &' ',& + &'license = "license" ',& + &' # Licensing information specified using SPDX identifiers is preferred ',& + &' # (eg. "Apache-2.0 OR MIT" or "LGPL-3.0-or-later"). ',& + &' ',& + &'maintainer = "jane.doe@example.com" ',& + &' # Information on the project maintainer and means to reach out to them. ',& + &' ',& + &'author = "Jane Doe" ',& + &' # Information on the project author. ',& + &' ',& + &'copyright = "Copyright 2020 Jane Doe" ',& + &' # A statement clarifying the Copyright status of the project. ',& + &' ',& + &'#description = "A short project summary in plain text" ',& + &' # The description provides a short summary on the project. It should be ',& + &' # plain text and not use any markup formatting. ',& + &' ',& + &'#categories = ["fortran", "graphics"] ',& + &' # Categories associated with the project. Listing only one is preferred. ',& + &' ',& + &'#keywords = ["hdf5", "mpi"] ',& + &' # The keywords field is an array of strings describing the project. ',& + &' ',& + &'#homepage = "https://stdlib.fortran-lang.org" ',& + &' # URL to the webpage of the project. ',& + &' ',& + &' # ----------------------------------------- ',& + &' # We are done with identifying the project. ',& + &' # ----------------------------------------- ',& + &' # ',& + &' # Now lets start describing how the project should be built. ',& + &' # ',& + &' # Note that tables would go here but we will not be taling about them (much)!!',& + &' # ',& + &' # Tables are a way to explicitly specify large numbers of programs in ',& + &' # a compact format instead of individual per-program entries in the ',& + &' # [[executable]], [[test]], and [[example]] sections to follow but ',& + &' # will not be discussed further except for the following notes: ',& + &' # ',& + &' # + Tables must appear (here) before any sections are declared. Once a ',& + &' # section is specified in a TOML file everything afterwards must be ',& + &' # values for that section or the beginning of a new section. A simple ',& + &' # example looks like: ',& + &' ',& + &'#executable = [ ',& + &'# { name = "a-prog" }, ',& + &'# { name = "app-tool", source-dir = "tool" } ',& + &'# { name = "fpm-man", source-dir = "tool", main="fman.f90" } ',& + &'#] ',& + &' ',& + &' # + See the reference documents (at the beginning of this document) ',& + &' # for more information on tables if you have long lists of programs ',& + &' # to build and are not simply depending on auto-detection and building. ',& + &' # ',& + &' # Now lets begin the TOML sections (lines beginning with "[") ... ',& + &' # ',& + &' ',& + &'[install] # Options for the "install" subcommand ',& + &' ',& + &' # When you run the "install" subcommand only executables are installed by ',& + &' # default on the local system. Library projects that will be used outside of ',& + &' # "fpm" can set the "library" boolean to also allow installing the module ',& + &' # files and library archive. Without this being set to "true" an "install" ',& + &' # subcommand ignores parameters that specify library installation. ',& + &' ',& + &'library = false ',& + &' ',& + &'[build] # General Build Options ',& + &' ',& + &' ### Automatic target discovery ',& + &' # ',& + &' # Normally fpm recursively searches the app/, example/, and test/ directories ',& + &' # for program sources and builds them. To disable this automatic discovery of ',& + &' # program targets set the following to "false": ',& + &' ',& + &'#auto-executables = true ',& + &'#auto-examples = true ',& + &'#auto-tests = true ',& + &' ',& + &' ### Package-level External Library Links ',& + &' # ',& + &' # To declare link-time dependencies on external libraries a list of ',& + &' # native libraries can be specified with the "link" entry. You may ',& + &' # have one library name or a list of strings in case several ',& + &' # libraries should be linked. This list of library dependencies is ',& + &' # exported to dependent packages. You may have to alter your library ',& + &' # search-path to ensure the libraries can be accessed. Typically, ',& + &' # this is done with the LD_LIBRARY_PATH environment variable on ULS ',& + &' # (Unix-Like Systems). You only specify the core name of the library ',& + &' # (as is typical with most programming environments, where you ',& + &' # would specify "-lz" on your load command to link against the zlib ',& + &' # compression library even though the library file would typically be ',& + &' # a file called "libz.a" "or libz.so"). So to link against that library ',& + &' # you would specify: ',& + &' ',& + &'#link = "z" ',& + &' ',& + &' # Note in that in some cases the order of the libraries matters: ',& + &' ',& + &'#link = ["blas", "lapack"] ',& + &' ',& + &''] endif if(settings%with_bare)then @@ -168,8 +267,45 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) ! create next section of fpm.toml if(settings%with_full)then tomlfile=[character(len=80) :: tomlfile, & - &'[library] ', & - &'source-dir="src" ', & + &' ',& + &'[library] ',& + &' ',& + &' # You can change the name of the directory to search for your library ',& + &' # source from the default of "src/". Library targets are exported ',& + &' # and usable by other projects. ',& + &' ',& + &'source-dir="src" ',& + &' ',& + &' # this can be a list: ',& + &' ',& + &'#source-dir=["src", "src2"] ',& + &' ',& + &' # More complex libraries may organize their modules in subdirectories. ',& + &' # For modules in a top-level directory fpm requires (but does not ',& + &' # enforce) that: ',& + &' # ',& + &' # + The module has the same name as the source file. This is important. ',& + &' # + There should be only one module per file. ',& + &' # ',& + &' # These two requirements simplify the build process for fpm. As Fortran ',& + &' # compilers emit module files (.mod) with the same name as the module ',& + &' # itself (but not the source file, .f90), naming the module the same ',& + &' # as the source file allows fpm to: ',& + &' # ',& + &' # + Uniquely and exactly map a source file (.f90) to its object (.o) ',& + &' # and module (.mod) files. ',& + &' # + Avoid conflicts with modules of the same name that could appear ',& + &' # in dependency packages. ',& + &' # ',& + &' ### Multi-level library source ',& + &' # You can place your module source files in any levels of subdirectories ',& + &' # inside your source directory, but there are certain naming conventions ',& + &' # to be followed -- module names must contain the path components ',& + &' # of the directory that its source file is in. ',& + &' # ',& + &' # This rule applies generally to any number of nested directories and ',& + &' # modules. For example, src/a/b/c/d.f90 must define a module called a_b_c_d. ',& + &' # Again, this is not enforced but may be required in future releases. ',& &''] endif ! create placeholder module src/bname.f90 @@ -189,6 +325,160 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) & littlefile) endif + if(settings%with_full)then + tomlfile=[character(len=80) :: tomlfile ,& + &' ',& + &'[dependencies] ',& + &' ',& + &' # Inevitably, you will want to be able to include other packages in ',& + &' # a project. fpm makes this incredibly simple, by taking care of ',& + &' # fetching and compiling your dependencies for you. You just tell it ',& + &' # what your dependencies names are, and where to find them. ',& + &' # ',& + &' # If you are going to distribute your package only place dependencies ',& + &' # here someone using your package as a remote dependency needs built. ',& + &' # You can define dependencies just for developer executables in the ',& + &' # next section, or even for specific executables as we will see below ',& + &' # (Then fpm will still fetch and compile it when building your ',& + &' # developer executables, but users of your library will not have to). ',& + &' # ',& + &' ## GLOBAL DEPENDENCIES (exported with your project) ',& + &' # ',& + &' # Typically, dependencies are defined by specifying the project''s ',& + &' # git repository. ',& + &' # ',& + &' # You can be specific about which version of a dependency you would ',& + &' # like. By default the latest master master branch is used. You can ',& + &' # optionally specify a branch, a tag or a commit value. ',& + &' # ',& + &' # So here are several alternates for specifying a remote dependency (you ',& + &' # can have at most one of "branch", "rev" or "tag" present): ',& + &' ',& + &'#stdlib = { git = "https://github.com/LKedward/stdlib-fpm.git" } ',& + &'#stdlib = {git="https://github.com/LKedward/stdlib-fpm.git",branch = "master" },',& + &'#stdlib = {git="https://github.com/LKedward/stdlib-fpm.git", tag = "v0.1.0" }, ',& + &'#stdlib = {git="https://github.com/LKedward/stdlib-fpm.git", rev = "5a9b7a8" }. ',& + &' ',& + &' # There may be multiple packages listed: ',& + &' ',& + &'#M_strings = { git = "https://github.com/urbanjost/M_strings.git" } ',& + &'#M_time = { git = "https://github.com/urbanjost/M_time.git" } ',& + &' ',& + &' # ',& + &' # You can even specify the local path to another project if it is in ',& + &' # a sub-folder (If for example you have got another fpm package **in ',& + &' # the same repository**) like this: ',& + &' ',& + &'#M_strings = { path = "M_strings" } ',& + &' ',& + &' # If you specify paths outside of your repository (ie. paths with a ',& + &' # slash in them) things will not work for your users! ',& + &' # ',& + &' # For a more verbose layout use normal tables rather than inline tables ',& + &' # to specify dependencies: ',& + &' ',& + &'#[dependencies.toml-f] ',& + &'#git = "https://github.com/toml-f/toml-f" ',& + &'#rev = "2f5eaba864ff630ba0c3791126a3f811b6e437f3" ',& + &' ',& + &' # ',& + &' # Now you can use any modules from these libraries anywhere in your ',& + &' # code -- whether is in your library source or a program source. ',& + &' ',& + &'[dev-dependencies] ',& + &' ',& + &' ## Dependencies Only for Development ',& + &' # ',& + &' # You can specify dependencies your library or application does not ',& + &' # depend on in a similar way. The difference is that these will not ',& + &' # be exported as part of your project to those using it as a remote ',& + &' # dependency. ',& + &' # ',& + &' # Currently, like a global dependency it will still be available for ',& + &' # all codes. It is up to the developer to ensure that nothing except ',& + &' # developer test programs rely upon it. ',& + &' ',& + &'#M_msg = { git = "https://github.com/urbanjost/M_msg.git" } ',& + &'#M_verify = { git = "https://github.com/urbanjost/M_verify.git" } ',& + &''] + endif + if(settings%with_bare)then + elseif(settings%with_executable)then + ! create next section of fpm.toml + call mkdir(join_path(settings%name, 'app')) + ! create NAME/app or stop + if(settings%with_full)then + tomlfile=[character(len=80) :: tomlfile, & + &' #----------------------------------- ',& + &' ## Application-specific declarations ',& + &' #----------------------------------- ',& + &' # Now lets begin entries for the TOML tables (lines beginning with "[[") ',& + &' # that describe the program sources -- applications, tests, and examples. ',& + &' # ',& + &' # So configuration of individual applications(run with "fpm run") begins here.',& + &' # ',& + &' # + the "name" entry for the executable to be built must always ',& + &' # be specified. The name must satisfy the rules for a Fortran ',& + &' # variable name. ',& + &' # + The source directory for each executable can be adjusted by the ',& + &' # "source-dir" entry. ',& + &' # + The basename of the source file containing the program body can ',& + &' # be specified with the "main" entry. ',& + &' # + Executables can also specify their own external package and ',& + &' # library link dependencies. ',& + &' # ',& + &' # Currently, like a global dependency any external package dependency ',& + &' # will be available for all codes. It is up to the developer to ensure ',& + &' # that nothing except the application programs specified rely upon it. ',& + &' # ',& + &' # Note if your application needs to use a module internally, but you do not ',& + &' # intend to build it as a library to be used in other projects, you can ',& + &' # include the module in your program source file or directory as well. ',& + &' ',& + &'[[executable]] ',& + &'name="'//settings%name//'"',& + &'source-dir="app" ',& + &'main="main.f90" ',& + &' # ',& + &' # you may repeat this pattern to add additional explicit application ',& + &' # names and parameters. ',& + &' # ',& + &' # The following sample illustrates all accepted options, where "link" and ',& + &' # "executable.dependencies" keys are the same as the global external library ',& + &' # links and package dependencies described previously except they apply ',& + &' # only to this executable: ',& + &' ',& + &'#[[ executable ]] ',& + &'#name = "app-name" ',& + &'#source-dir = "prog" ',& + &'#main = "program.f90" ',& + &'#link = "z" ',& + &'#[executable.dependencies] ',& + &'#M_CLI = { git = "https://github.com/urbanjost/M_CLI.git" } ',& + &'#helloff = { git = "https://gitlab.com/everythingfunctional/helloff.git" } ',& + &'#M_path = { git = "https://github.com/urbanjost/M_path.git" } ',& + &''] + endif + + if(exists(bname//'/src/'))then + littlefile=[character(len=80) :: & + &'program main', & + &' use '//bname//', only: say_hello', & + &' implicit none', & + &'', & + &' call say_hello()', & + &'end program main'] + else + littlefile=[character(len=80) :: & + &'program main', & + &' implicit none', & + &'', & + &' print *, "hello from project '//bname//'"', & + &'end program main'] + endif + call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile) + endif + if(settings%with_bare)then elseif(settings%with_test)then @@ -197,10 +487,32 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) ! create next section of fpm.toml if(settings%with_full)then tomlfile=[character(len=80) :: tomlfile ,& - &'[[test]] ', & - &'name="runTests" ', & - &'source-dir="test" ', & - &'main="check.f90" ', & + &' ',& + &'[[test]] ',& + &' ',& + &' # The same declarations can be made for test programs, which are ',& + &' # executed with the "fpm test" command and are not build when your ',& + &' # package is used as a dependency by other packages. These are ',& + &' # typically unit tests of the package only used during package ',& + &' # development. ',& + &' ',& + &'name="runTests" ',& + &'source-dir="test" ',& + &'main="check.f90" ',& + &' ',& + &' # you may repeat this pattern to add additional explicit test program ',& + &' # parameters. The following example contains a sample of all accepted ',& + &' # options. ',& + &' ',& + &'#[[ test ]] ',& + &'#name = "tester" ',& + &'#source-dir="test" ',& + &'#main="tester.f90" ',& + &'#link = ["blas", "lapack"] ',& + &'#[test.dependencies] ',& + &'#M_CLI2 = { git = "https://github.com/urbanjost/M_CLI2.git" } ',& + &'#M_io = { git = "https://github.com/urbanjost/M_path.git" } ',& + &'#M_system= { git = "https://github.com/urbanjost/M_system.git" } ',& &''] endif @@ -222,10 +534,30 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) ! create next section of fpm.toml if(settings%with_full)then tomlfile=[character(len=80) :: tomlfile, & - &'[[example]] ', & - &'name="demo" ', & - &'source-dir="example" ', & - &'main="demo.f90" ', & + &' ',& + &'[[example]] ',& + &' ',& + &' # Example applications for a project are defined here. ',& + &' # These are run via "fpm run --example NAME" and like the ',& + &' # test applications, are not built when this package is used as a ',& + &' # dependency by other packages. ',& + &' ',& + &'name="demo" ',& + &'source-dir="example" ',& + &'main="demo.f90" ',& + &' ',& + &' # ',& + &' # you may add additional programs to the example table. The following ',& + &' # example contains a sample of all accepted options ',& + &' ',& + &'#[[ example ]] ',& + &'#name = "example-tool" ',& + &'#source-dir="example" ',& + &'#main="tool.f90" ',& + &'#link = "z" ',& + &'#[example.dependencies] ',& + &'#M_kracken95 = { git = "https://github.com/urbanjost/M_kracken95.git" } ',& + &'#datetime = {git = "https://github.com/wavebitscientific/datetime-fortran.git" }',& &''] endif @@ -239,49 +571,6 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) call warnwrite(join_path(settings%name, 'example/demo.f90'), littlefile) endif - if(settings%with_bare)then - elseif(settings%with_executable)then - ! create next section of fpm.toml - call mkdir(join_path(settings%name, 'app')) - ! create NAME/app or stop - if(settings%with_full)then - tomlfile=[character(len=80) :: tomlfile, & - &'[[executable]] ', & - &'name="'//bname//'" ', & - &'source-dir="app" ', & - &'main="main.f90" ', & - &''] - endif - - if(exists(bname//'/src/'))then - littlefile=[character(len=80) :: & - &'program main', & - &' use '//bname//', only: say_hello', & - &' implicit none', & - &'', & - &' call say_hello()', & - &'end program main'] - else - littlefile=[character(len=80) :: & - &'program main', & - &' implicit none', & - &'', & - &' print *, "hello from project '//bname//'"', & - &'end program main'] - endif - call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile) - endif - - if(settings%with_full)then - tomlfile=[character(len=80) :: tomlfile, & - &'[dependencies] ', & - &'#For a complete list of keys and their attributes see ', & - &'# ', & - &'# https://github.com/fortran-lang/fpm/blob/master/manifest-reference.md ', & - &'# ', & - &''] - endif - ! now that built it write NAME/fpm.toml if( allocated(tomlfile) )then call validate_toml_data(tomlfile) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index e569186..6e331ae 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -651,6 +651,7 @@ contains ' fpm build ', & ' fpm test ', & ' fpm run ', & + ' fpm run --example ', & ' fpm new --help ', & ' fpm run myprogram --release -- -x 10 -y 20 --title "my title" ', & ' fpm install --prefix ~/.local ', & @@ -864,7 +865,7 @@ contains ' ASCII alphanumeric characters and underscores, ', & ' starting with a letter. ', & ' ', & - ' The default is to create the src/, app/, and test/, ', & + ' The default is to create the src/, app/, example/ and test/ ', & ' directories. If any of the following options are specified ', & ' then only selected subdirectories are generated: ', & ' ', & @@ -878,19 +879,23 @@ contains ' --example create directory example/ and a placeholder program ', & ' for use with the subcommand "run --example". ', & ' ', & - ' So the default is equivalent to "fpm NAME --lib --app --test" ', & + ' So the default is equivalent to ',& + ' ', & + ' fpm NAME --lib --app --test --example ', & ' ', & ' --backfill By default the directory must not exist. If this ', & ' option is present the directory may pre-exist and ', & ' only subdirectories and files that do not ', & ' already exist will be created. For example, if you ', & ' previously entered "fpm new myname --lib" entering ', & - ' "fpm new myname --backfill" will create the missing ', & - ' app/ and test/ directories and programs. ', & + ' "fpm new myname --backfill" will create any missing ', & + ' app/, example/ and test/ directories and programs. ', & ' ', & ' --full By default a minimal manifest file ("fpm.toml") is ', & ' created that depends on auto-discovery. With this ', & ' option a much more extensive manifest sample is written. ', & + ' It is designed to facilitate creating projects that ', & + ' depend extensively on non-default build options. ', & ' ', & ' --bare A minimal manifest file ("fpm.toml") is created and ', & ' a ".gitignore" and "README.md" file is created but no ', & @@ -984,7 +989,7 @@ contains 'DESCRIPTION', & ' Subcommand to install fpm projects. Running install will export the', & ' current project to the selected prefix, this will by default install all', & - ' executables (test and examples are excluded) which are part of the projects.', & + ' executables (tests and examples are excluded) which are part of the projects.', & ' Libraries and module files are only installed for projects requiring the', & ' installation of those components in the package manifest.', & '', & -- cgit v1.2.3 From cbdfcafd59e2b2f67b21dd4ec02f897465bfbb57 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Sun, 27 Dec 2020 18:34:58 -0500 Subject: errata --- fpm/src/fpm/cmd/new.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index c9d333e..02064b2 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -189,7 +189,7 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &' # ',& &' # Now lets start describing how the project should be built. ',& &' # ',& - &' # Note that tables would go here but we will not be taling about them (much)!!',& + &' # Note tables would go here but we will not be talking about them (much)!!' ,& &' # ',& &' # Tables are a way to explicitly specify large numbers of programs in ',& &' # a compact format instead of individual per-program entries in the ',& -- cgit v1.2.3 From b199335b651885bd2133f0b71272ac985b8bee9d Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Sun, 27 Dec 2020 18:34:58 -0500 Subject: errata --- fpm/src/fpm/cmd/new.f90 | 33 +++++++++++++-------------------- 1 file changed, 13 insertions(+), 20 deletions(-) diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index c9d333e..7c16fa8 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -189,7 +189,7 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &' # ',& &' # Now lets start describing how the project should be built. ',& &' # ',& - &' # Note that tables would go here but we will not be taling about them (much)!!',& + &' # Note tables would go here but we will not be talking about them (much)!!' ,& &' # ',& &' # Tables are a way to explicitly specify large numbers of programs in ',& &' # a compact format instead of individual per-program entries in the ',& @@ -209,7 +209,7 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &' ',& &' # + See the reference documents (at the beginning of this document) ',& &' # for more information on tables if you have long lists of programs ',& - &' # to build and are not simply depending on auto-detection and building. ',& + &' # to build and are not simply depending on auto-detection. ',& &' # ',& &' # Now lets begin the TOML sections (lines beginning with "[") ... ',& &' # ',& @@ -254,10 +254,9 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &' ',& &'#link = "z" ',& &' ',& - &' # Note in that in some cases the order of the libraries matters: ',& + &' # Note that in some cases the order of the libraries matters: ',& &' ',& &'#link = ["blas", "lapack"] ',& - &' ',& &''] endif @@ -267,7 +266,6 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) ! create next section of fpm.toml if(settings%with_full)then tomlfile=[character(len=80) :: tomlfile, & - &' ',& &'[library] ',& &' ',& &' # You can change the name of the directory to search for your library ',& @@ -298,9 +296,9 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &' # in dependency packages. ',& &' # ',& &' ### Multi-level library source ',& - &' # You can place your module source files in any levels of subdirectories ',& - &' # inside your source directory, but there are certain naming conventions ',& - &' # to be followed -- module names must contain the path components ',& + &' # You can place your module source files in any number of levels of ',& + &' # subdirectories inside your source directory, but there are certain naming ',& + &' # conventions to be followed -- module names must contain the path components ',& &' # of the directory that its source file is in. ',& &' # ',& &' # This rule applies generally to any number of nested directories and ',& @@ -327,11 +325,10 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) if(settings%with_full)then tomlfile=[character(len=80) :: tomlfile ,& - &' ',& &'[dependencies] ',& &' ',& &' # Inevitably, you will want to be able to include other packages in ',& - &' # a project. fpm makes this incredibly simple, by taking care of ',& + &' # a project. Fpm makes this incredibly simple, by taking care of ',& &' # fetching and compiling your dependencies for you. You just tell it ',& &' # what your dependencies names are, and where to find them. ',& &' # ',& @@ -381,7 +378,6 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &'#git = "https://github.com/toml-f/toml-f" ',& &'#rev = "2f5eaba864ff630ba0c3791126a3f811b6e437f3" ',& &' ',& - &' # ',& &' # Now you can use any modules from these libraries anywhere in your ',& &' # code -- whether is in your library source or a program source. ',& &' ',& @@ -415,11 +411,12 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &' # Now lets begin entries for the TOML tables (lines beginning with "[[") ',& &' # that describe the program sources -- applications, tests, and examples. ',& &' # ',& - &' # So configuration of individual applications(run with "fpm run") begins here.',& + &' # First we will configuration individual applications run with "fpm run". .',& &' # ',& &' # + the "name" entry for the executable to be built must always ',& &' # be specified. The name must satisfy the rules for a Fortran ',& - &' # variable name. ',& + &' # variable name. This will be the name of the binary installed by ',& + &' # the "install" subcommand and used on the "run" subcommand. ',& &' # + The source directory for each executable can be adjusted by the ',& &' # "source-dir" entry. ',& &' # + The basename of the source file containing the program body can ',& @@ -439,11 +436,9 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &'name="'//settings%name//'"',& &'source-dir="app" ',& &'main="main.f90" ',& - &' # ',& - &' # you may repeat this pattern to add additional explicit application ',& - &' # names and parameters. ',& - &' # ',& - &' # The following sample illustrates all accepted options, where "link" and ',& + &' ',& + &' # You may repeat this pattern to define additional applications. For instance,',& + &' # the following sample illustrates all accepted options, where "link" and ',& &' # "executable.dependencies" keys are the same as the global external library ',& &' # links and package dependencies described previously except they apply ',& &' # only to this executable: ',& @@ -487,7 +482,6 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) ! create next section of fpm.toml if(settings%with_full)then tomlfile=[character(len=80) :: tomlfile ,& - &' ',& &'[[test]] ',& &' ',& &' # The same declarations can be made for test programs, which are ',& @@ -534,7 +528,6 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) ! create next section of fpm.toml if(settings%with_full)then tomlfile=[character(len=80) :: tomlfile, & - &' ',& &'[[example]] ',& &' ',& &' # Example applications for a project are defined here. ',& -- cgit v1.2.3 From a690743d07737dde983e6cb02f6ef6d6aa717762 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Sun, 27 Dec 2020 20:05:28 -0500 Subject: errata --- fpm/src/fpm_command_line.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 6e331ae..c314183 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -849,7 +849,7 @@ contains ' demo.f90 ', & ' ', & ' Using this file structure is highly encouraged, particularly for ', & - ' small packages primarily intended to be used as dependendencies. ', & + ' small packages primarily intended to be used as dependencies. ', & ' ', & ' If you find this restrictive and need to customize the package ', & ' structure you will find using the --full switch creates a ', & -- cgit v1.2.3 From 43d13460036df1ba1e520a5bc5936693264bef07 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Sun, 27 Dec 2020 20:05:28 -0500 Subject: errata --- fpm/src/fpm/cmd/new.f90 | 8 ++++---- fpm/src/fpm_command_line.f90 | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index 15c1dbe..a5647b3 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -245,9 +245,9 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &' # have one library name or a list of strings in case several ',& &' # libraries should be linked. This list of library dependencies is ',& &' # exported to dependent packages. You may have to alter your library ',& - &' # search-path to ensure the libraries can be accessed. Typically, ',& + &' # search-path to ensure the libraries can be accessed. Typically, ',& &' # this is done with the LD_LIBRARY_PATH environment variable on ULS ',& - &' # (Unix-Like Systems). You only specify the core name of the library ',& + &' # (Unix-Like Systems). You only specify the core name of the library ',& &' # (as is typical with most programming environments, where you ',& &' # would specify "-lz" on your load command to link against the zlib ',& &' # compression library even though the library file would typically be ',& @@ -413,7 +413,7 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &' # Now lets begin entries for the TOML tables (lines beginning with "[[") ',& &' # that describe the program sources -- applications, tests, and examples. ',& &' # ',& - &' # First we will configuration individual applications run with "fpm run". .',& + &' # First we will configuration individual applications run with "fpm run". ',& &' # ',& &' # + the "name" entry for the executable to be built must always ',& &' # be specified. The name must satisfy the rules for a Fortran ',& @@ -488,7 +488,7 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &' ',& &' # The same declarations can be made for test programs, which are ',& &' # executed with the "fpm test" command and are not build when your ',& - &' # package is used as a dependency by other packages. These are ',& + &' # package is used as a dependency by other packages. These are ',& &' # typically unit tests of the package only used during package ',& &' # development. ',& &' ',& diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 6e331ae..c314183 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -849,7 +849,7 @@ contains ' demo.f90 ', & ' ', & ' Using this file structure is highly encouraged, particularly for ', & - ' small packages primarily intended to be used as dependendencies. ', & + ' small packages primarily intended to be used as dependencies. ', & ' ', & ' If you find this restrictive and need to customize the package ', & ' structure you will find using the --full switch creates a ', & -- cgit v1.2.3 From 77c27e7fe0ab1088c3eb124f7fbf317ac13453e7 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Thu, 31 Dec 2020 15:37:47 -0500 Subject: return fpm.toml to using basename --- fpm/src/fpm/cmd/new.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index a5647b3..a1e25da 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -146,7 +146,7 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &' # to aid others when searching for the project in a repository and to ',& &' # identify how and when to contact the package supporters. ',& &' ',& - &'name = "'//settings%name//'"',& + &'name = "'//bname//'"',& &' # The project name (required) is how the project will be referred to. ',& &' # The name is used by other packages using it as a dependency. It also ',& &' # is used as the default name of any library built and the optional ',& @@ -435,7 +435,7 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &' # include the module in your program source file or directory as well. ',& &' ',& &'[[executable]] ',& - &'name="'//settings%name//'"',& + &'name="'//bname//'"',& &'source-dir="app" ',& &'main="main.f90" ',& &' ',& -- cgit v1.2.3 From b3e3d83b79833da7941ef8d690d799838a607da4 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Sun, 31 Jan 2021 11:56:00 -0500 Subject: for "new" subcommand example/ is only created explicitly by --example or --full --- fpm/src/fpm_command_line.f90 | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index c314183..c3cd94d 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -263,15 +263,14 @@ contains & with_test=lget('test'), & & with_example=lget('example'), & & verbose=lget('verbose') ) - else + else ! default if no specific directories are requested cmd_settings=fpm_new_settings(& & backfill=lget('backfill') , & & name=name, & & with_executable=.true., & & with_lib=.true., & & with_test=.true., & - & with_example=.true., & - !*!& with_example=lget('full'), & + & with_example=lget('full'), & & with_full=lget('full'), & & with_bare=lget('bare'), & & verbose=lget('verbose') ) @@ -834,7 +833,7 @@ contains ' o adds a ".gitignore" file for ignoring the build/ directory ', & ' (where fpm-generated output will be placed) ', & ' ', & - ' The basic default file structure is ', & + ' The default file structure (that will be automatically scanned) is ', & ' ', & ' NAME/ ', & ' fpm.toml ', & @@ -865,9 +864,9 @@ contains ' ASCII alphanumeric characters and underscores, ', & ' starting with a letter. ', & ' ', & - ' The default is to create the src/, app/, example/ and test/ ', & - ' directories. If any of the following options are specified ', & - ' then only selected subdirectories are generated: ', & + ' The default is to create the src/, app/, and test/ directories. ', & + ' If any of the following options are specified then only the ', & + ' selected subdirectories are generated: ', & ' ', & ' --lib,--src create directory src/ and a placeholder module ', & ' named "NAME.f90" for use with subcommand "build". ', & @@ -878,22 +877,24 @@ contains ' "--lib" it really does not have anything to test. ', & ' --example create directory example/ and a placeholder program ', & ' for use with the subcommand "run --example". ', & + ' It is only created by default if "--full is" specified. ', & ' ', & ' So the default is equivalent to ',& ' ', & - ' fpm NAME --lib --app --test --example ', & + ' fpm NAME --lib --app --test ', & ' ', & ' --backfill By default the directory must not exist. If this ', & ' option is present the directory may pre-exist and ', & ' only subdirectories and files that do not ', & ' already exist will be created. For example, if you ', & ' previously entered "fpm new myname --lib" entering ', & - ' "fpm new myname --backfill" will create any missing ', & - ' app/, example/ and test/ directories and programs. ', & + ' "fpm new myname -full --backfill" will create any missing', & + ' app/, example/, and test/ directories and programs. ', & ' ', & ' --full By default a minimal manifest file ("fpm.toml") is ', & ' created that depends on auto-discovery. With this ', & - ' option a much more extensive manifest sample is written. ', & + ' option a much more extensive manifest sample is written ', & + ' and the example/ directory is created and populated. ', & ' It is designed to facilitate creating projects that ', & ' depend extensively on non-default build options. ', & ' ', & @@ -914,6 +915,11 @@ contains ' fpm run # run example application program(s) ', & ' fpm test # run example test program(s) ', & ' fpm run --example # run example program(s) ', & + ' ', & + ' fpm new A --full # create example/ and an annotated fpm.toml as well', & + ' fpm new A --bare # create no directories ', & + ' create any missing files in current directory ', & + ' fpm new `pwd` --full --backfill ', & '' ] help_test=[character(len=80) :: & 'NAME ', & -- cgit v1.2.3 From bc9fa943c5f954bbdbbdda9280fc558948ce9bbd Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Sun, 31 Jan 2021 15:51:29 -0500 Subject: rebased --- CONTRIBUTING.md | 2 +- fpm/src/fpm/cmd/new.f90 | 10 +++++----- fpm/src/fpm_command_line.f90 | 11 ++++------- fpm/src/fpm_filesystem.f90 | 18 +++++++++++++----- fpm/src/fpm_source_parsing.f90 | 4 ++-- fpm/src/fpm_strings.f90 | 36 +++++++++++++++++++++++++++++++++--- fpm/test/fpm_test/main.f90 | 26 +++++++++++++------------- fpm/test/new_test/new_test.f90 | 14 +++++++------- 8 files changed, 78 insertions(+), 43 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index b74aeda..2cc1ffa 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -115,7 +115,7 @@ open an issue and we’ll discuss it. If you have never created a pull request before, welcome :tada:. You can learn how from -[this great tutorial](https://egghead.io/series/how-to-contribute-to-an-open-source-project-on-github). +[this great tutorial](https://app.egghead.io/courses/how-to-contribute-to-an-open-source-project-on-github). Don’t know where to start? You can start by looking through the list of diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index a1e25da..d0cf60c 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -55,7 +55,7 @@ module fpm_cmd_new use fpm_command_line, only : fpm_new_settings use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS -use fpm_filesystem, only : join_path, exists, basename, mkdir, is_dir +use fpm_filesystem, only : join_path, exists, basename, mkdir, is_dir, to_fortran_name use fpm_filesystem, only : fileopen, fileclose, filewrite, warnwrite use fpm_strings, only : join use,intrinsic :: iso_fortran_env, only : stderr=>error_unit @@ -71,7 +71,7 @@ integer,parameter :: tfc = selected_char_kind('DEFAULT') character(len=:,kind=tfc),allocatable :: bname ! baeename of NAME character(len=:,kind=tfc),allocatable :: tomlfile(:) character(len=:,kind=tfc),allocatable :: littlefile(:) - + !> TOP DIRECTORY NAME PROCESSING !> see if requested new directory already exists and process appropriately if(exists(settings%name) .and. .not.settings%backfill )then @@ -310,7 +310,7 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) endif ! create placeholder module src/bname.f90 littlefile=[character(len=80) :: & - &'module '//bname, & + &'module '//to_fortran_name(bname), & &' implicit none', & &' private', & &'', & @@ -319,7 +319,7 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &' subroutine say_hello', & &' print *, "Hello, '//bname//'!"', & &' end subroutine say_hello', & - &'end module '//bname] + &'end module '//to_fortran_name(bname)] ! create NAME/src/NAME.f90 call warnwrite(join_path(settings%name, 'src', bname//'.f90'),& & littlefile) @@ -460,7 +460,7 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) if(exists(bname//'/src/'))then littlefile=[character(len=80) :: & &'program main', & - &' use '//bname//', only: say_hello', & + &' use '//to_fortran_name(bname)//', only: say_hello', & &' implicit none', & &'', & &' call say_hello()', & diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index c3cd94d..cfa6cb9 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -28,7 +28,7 @@ use fpm_environment, only : get_os_type, get_env, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified use fpm_strings, only : lower, split -use fpm_filesystem, only : basename, canon_path +use fpm_filesystem, only : basename, canon_path, to_fortran_name use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & & stderr=>error_unit @@ -231,13 +231,10 @@ contains end select !*! canon_path is not converting ".", etc. name=canon_path(name) - if( .not.is_fortran_name(basename(name)) )then + if( .not.is_fortran_name(to_fortran_name(basename(name))) )then write(stderr,'(g0)') [ character(len=72) :: & - & 'the new directory basename must be an allowed ', & - & ' Fortran name. It must be composed of 1 to 63 ASCII', & - & ' characters and start with a letter and be composed', & - & ' entirely of alphanumeric characters [a-zA-Z0-9]', & - & ' and underscores.'] + & ' the fpm project name must be made of up to 63 ASCII letters,', & + & ' numbers, underscores, or hyphens, and start with a letter.'] stop 4 endif diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index 7f1cbf5..5811cd4 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -3,11 +3,11 @@ use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, use fpm_environment, only: get_os_type, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD - use fpm_strings, only: f_string, string_t, split + use fpm_strings, only: f_string, replace, string_t, split implicit none private public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, read_lines, list_files, env_variable, & - mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file + mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file, to_fortran_name public :: fileopen, fileclose, filewrite, warnwrite integer, parameter :: LINE_BUFFER_LEN = 1000 @@ -147,8 +147,6 @@ function dirname(path) result (dir) character(*), intent(in) :: path character(:), allocatable :: dir - character(:), allocatable :: file_parts(:) - dir = path(1:scan(path,'/\',back=.true.)) end function dirname @@ -486,7 +484,7 @@ subroutine fileopen(filename,lun,ier) character(len=*),intent(in) :: filename integer,intent(out) :: lun integer,intent(out),optional :: ier -integer :: i, ios +integer :: ios character(len=256) :: message message=' ' @@ -562,4 +560,14 @@ character(len=256) :: message end subroutine filewrite +pure function to_fortran_name(string) result(res) + ! Returns string with special characters replaced with an underscore. + ! For now, only a hyphen is treated as a special character, but this can be + ! expanded to other characters if needed. + character(*), intent(in) :: string + character(len(string)) :: res + character, parameter :: SPECIAL_CHARACTERS(*) = ['-'] + res = replace(string, SPECIAL_CHARACTERS, '_') +end function to_fortran_name + end module fpm_filesystem diff --git a/fpm/src/fpm_source_parsing.f90 b/fpm/src/fpm_source_parsing.f90 index f81555d..33b8400 100644 --- a/fpm/src/fpm_source_parsing.f90 +++ b/fpm/src/fpm_source_parsing.f90 @@ -16,7 +16,7 @@ !> module fpm_source_parsing use fpm_error, only: error_t, file_parse_error, fatal_error -use fpm_strings, only: string_t, string_cat, split, lower, str_ends_with, fnv_1a +use fpm_strings, only: string_t, string_cat, len_trim, split, lower, str_ends_with, fnv_1a use fpm_model, only: srcfile_t, & FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & @@ -476,4 +476,4 @@ function split_n(string,delims,n,stat) result(substring) end function split_n -end module fpm_source_parsing \ No newline at end of file +end module fpm_source_parsing diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index 2430237..2b036d1 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -4,13 +4,17 @@ implicit none private public :: f_string, lower, split, str_ends_with, string_t -public :: string_array_contains, string_cat, operator(.in.), fnv_1a -public :: resize, str, join +public :: string_array_contains, string_cat, len_trim, operator(.in.), fnv_1a +public :: replace, resize, str, join type string_t character(len=:), allocatable :: s end type +interface len_trim + module procedure :: string_len_trim +end interface len_trim + interface resize module procedure :: resize_string end interface @@ -177,7 +181,7 @@ function string_cat(strings,delim) result(cat) character(*), intent(in), optional :: delim character(:), allocatable :: cat - integer :: i,n + integer :: i character(:), allocatable :: delim_str if (size(strings) < 1) then @@ -200,6 +204,18 @@ function string_cat(strings,delim) result(cat) end function string_cat +!> Determine total trimmed length of `string_t` array +pure function string_len_trim(strings) result(n) + type(string_t), intent(in) :: strings(:) + integer :: i, n + + n = 0 + do i=1,size(strings) + n = n + len_trim(strings(i)%s) + end do + +end function string_len_trim + subroutine split(input_line,array,delimiters,order,nulls) ! parse string on delimiter characters and store tokens into an allocatable array" ! Author: John S. Urban @@ -318,6 +334,20 @@ subroutine split(input_line,array,delimiters,order,nulls) enddo end subroutine split +pure function replace(string, charset, target_char) result(res) + ! Returns string with characters in charset replaced with target_char. + character(*), intent(in) :: string + character, intent(in) :: charset(:), target_char + character(len(string)) :: res + integer :: n + res = string + do n = 1, len(string) + if (any(string(n:n) == charset)) then + res(n:n) = target_char + end if + end do +end function replace + subroutine resize_string(list, n) !> Instance of the array to be resized type(string_t), allocatable, intent(inout) :: list(:) diff --git a/fpm/test/fpm_test/main.f90 b/fpm/test/fpm_test/main.f90 index a7f4979..e1b9d1e 100644 --- a/fpm/test/fpm_test/main.f90 +++ b/fpm/test/fpm_test/main.f90 @@ -14,12 +14,12 @@ program fpm_testing implicit none integer :: stat, is character(len=:), allocatable :: suite_name, test_name - type(testsuite_t), allocatable :: testsuite(:) + type(testsuite_t), allocatable :: suite(:) character(len=*), parameter :: fmt = '("#", *(1x, a))' stat = 0 - testsuite = [ & + suite = [ & & new_testsuite("fpm_toml", collect_toml), & & new_testsuite("fpm_manifest", collect_manifest), & & new_testsuite("fpm_source_parsing", collect_source_parsing), & @@ -34,29 +34,29 @@ program fpm_testing 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 + is = select_suite(suite, suite_name) + if (is > 0 .and. is <= size(suite)) 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) + write(error_unit, fmt) "Suite:", suite(is)%name + call run_selected(suite(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) + write(error_unit, fmt) "Testing:", suite(is)%name + call run_testsuite(suite(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 + do is = 1, size(suite) + write(error_unit, fmt) "-", suite(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) + do is = 1, size(suite) + write(error_unit, fmt) "Testing:", suite(is)%name + call run_testsuite(suite(is)%collect, error_unit, stat) end do end if diff --git a/fpm/test/new_test/new_test.f90 b/fpm/test/new_test/new_test.f90 index 22cf113..c284002 100644 --- a/fpm/test/new_test/new_test.f90 +++ b/fpm/test/new_test/new_test.f90 @@ -13,7 +13,7 @@ character(len=*),parameter :: scr = 'fpm_scratch_' character(len=*),parameter :: cmds(*) = [character(len=80) :: & ! run a variety of "fpm new" variations and verify expected files are generated ' new', & -' new no-no', & +' new name-with-hyphens', & ' new '//scr//'A', & ' new '//scr//'B --lib', & ' new '//scr//'C --app', & @@ -64,7 +64,7 @@ logical :: IS_OS_WINDOWS if( is_dir(trim(directories(i))) ) then write(*,*)'ERROR:',trim( directories(i) ),' already exists' write(*,*)' you must remove scratch directories before performing this test' - write(*,'(*(g0:,1x))')'directories:',(trim(directories(j)),j=1,size(directories)),'no-no' + write(*,'(*(g0:,1x))')'directories:',(trim(directories(j)),j=1,size(directories)),'name-with-hyphens' stop endif enddo @@ -76,12 +76,12 @@ logical :: IS_OS_WINDOWS write(*,'(*(g0))')'CMD=',trim(cmds(i)),' EXITSTAT=',estat,' CMDSTAT=',cstat,' MESSAGE=',trim(message) enddo - if( is_dir('no-no') ) then - tally=[tally,.false.] - write(*,*)'ERROR: directory no-no/ exists' - else + if( is_dir('name-with-hyphens') ) then tally=[tally,.true.] - endif + else + write(*,*)'ERROR: directory name-with-hyphens/ exists' + tally=[tally,.false.] + endif ! assuming hidden files in .git and .gitignore are ignored for now TESTS: do i=1,size(directories) -- cgit v1.2.3 From 712d5edc3903921633829b984326de61310aea39 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Sun, 31 Jan 2021 15:57:21 -0500 Subject: space --- fpm/src/fpm/cmd/new.f90 | 2 +- fpm/src/fpm_source_parsing.f90 | 24 ++++++++++++------------ 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index d0cf60c..5149bea 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -71,7 +71,7 @@ integer,parameter :: tfc = selected_char_kind('DEFAULT') character(len=:,kind=tfc),allocatable :: bname ! baeename of NAME character(len=:,kind=tfc),allocatable :: tomlfile(:) character(len=:,kind=tfc),allocatable :: littlefile(:) - + !> TOP DIRECTORY NAME PROCESSING !> see if requested new directory already exists and process appropriately if(exists(settings%name) .and. .not.settings%backfill )then diff --git a/fpm/src/fpm_source_parsing.f90 b/fpm/src/fpm_source_parsing.f90 index 33b8400..fc0b629 100644 --- a/fpm/src/fpm_source_parsing.f90 +++ b/fpm/src/fpm_source_parsing.f90 @@ -6,8 +6,8 @@ !> !> Both functions additionally calculate and store a file digest (hash) which !> is used by the backend ([[fpm_backend]]) to skip compilation of unmodified sources. -!> -!> Both functions return an instance of the [[srcfile_t]] type. +!> +!> Both functions return an instance of the [[srcfile_t]] type. !> !> For more information, please read the documentation for each function: !> @@ -38,7 +38,7 @@ character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & contains !> Parsing of free-form fortran source files -!> +!> !> The following statements are recognised and parsed: !> !> - `Module`/`submodule`/`program` declaration @@ -171,7 +171,7 @@ function parse_f_source(f_filename,error) result(f_source) if (index(adjustl(file_lines(i)%s(ic+7:)),'"') == 1 .or. & index(adjustl(file_lines(i)%s(ic+7:)),"'") == 1 ) then - + n_include = n_include + 1 if (pass == 2) then @@ -264,7 +264,7 @@ function parse_f_source(f_filename,error) result(f_source) if (index(temp_string,':') > 0) then temp_string = temp_string(index(temp_string,':')+1:) - + end if if (.not.validate_name(temp_string)) then @@ -288,7 +288,7 @@ function parse_f_source(f_filename,error) result(f_source) temp_string = lower(split_n(file_lines(i)%s,n=2,delims=' ',stat=stat)) if (stat == 0) then - + if (scan(temp_string,'=(')>0 ) then ! Ignore: ! program =* @@ -343,7 +343,7 @@ function parse_f_source(f_filename,error) result(f_source) (name(i:i) >= '0' .and. name(i:i) <= '9').or. & (lower(name(i:i)) >= 'a' .and. lower(name(i:i)) <= 'z').or. & name(i:i) == '_') ) then - + valid = .false. return end if @@ -359,7 +359,7 @@ end function parse_f_source !> Parsing of c source files -!> +!> !> The following statements are recognised and parsed: !> !> - `#include` preprocessor statement @@ -396,9 +396,9 @@ function parse_c_source(c_filename,error) result(c_source) c_source%unit_type = FPM_UNIT_UNKNOWN return end if - + c_source%digest = fnv_1a(file_lines) - + do pass = 1,2 n_include = 0 file_loop: do i=1,size(file_lines) @@ -406,7 +406,7 @@ function parse_c_source(c_filename,error) result(c_source) ! Process 'INCLUDE' statements if (index(adjustl(lower(file_lines(i)%s)),'#include') == 1 .and. & index(file_lines(i)%s,'"') > 0) then - + n_include = n_include + 1 if (pass == 2) then @@ -440,7 +440,7 @@ end function parse_c_source !> n=0 will return the last item !> n=-1 will return the penultimate item etc. !> -!> stat = 1 on return if the index +!> stat = 1 on return if the index !> is not found !> function split_n(string,delims,n,stat) result(substring) -- cgit v1.2.3 From 188aa747a7e009b3afb18e16c924ea8cfa37fa17 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Sun, 31 Jan 2021 17:57:07 -0500 Subject: correct github changes --- fpm/src/fpm_filesystem.f90 | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index ea3d9d3..5811cd4 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -8,7 +8,7 @@ use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, private public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, read_lines, list_files, env_variable, & mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file, to_fortran_name - public :: fileopen, fileclose, filewrite, warn + public :: fileopen, fileclose, filewrite, warnwrite integer, parameter :: LINE_BUFFER_LEN = 1000 @@ -570,15 +570,4 @@ pure function to_fortran_name(string) result(res) res = replace(string, SPECIAL_CHARACTERS, '_') end function to_fortran_name -pure function to_fortran_name(string) result(res) - ! Returns string with special characters replaced with an underscore. - ! For now, only a hyphen is treated as a special character, but this can be - ! expanded to other characters if needed. - character(*), intent(in) :: string - character(len(string)) :: res - character, parameter :: SPECIAL_CHARACTERS(*) = ['-'] - res = replace(string, SPECIAL_CHARACTERS, '_') -end function to_fortran_name - - end module fpm_filesystem -- cgit v1.2.3