diff options
| -rw-r--r-- | fpm/src/fpm/cmd/new.f90 | 663 | ||||
| -rw-r--r-- | fpm/src/fpm_command_line.f90 | 127 | ||||
| -rw-r--r-- | fpm/src/fpm_filesystem.f90 | 141 | ||||
| -rw-r--r-- | fpm/src/fpm_source_parsing.f90 | 26 | ||||
| -rw-r--r-- | fpm/src/fpm_strings.f90 | 125 | ||||
| -rw-r--r-- | fpm/test/help_test/help_test.f90 | 19 | ||||
| -rw-r--r-- | fpm/test/new_test/new_test.f90 | 20 |
7 files changed, 917 insertions, 204 deletions
diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index 9f2aa4b..5149bea 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -1,8 +1,63 @@ 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 separate 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 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 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 implicit none private @@ -12,16 +67,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 :: littlefile(:) -character(len=8) :: date - - call date_and_time(DATE=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(:) + !> 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.' + & '<ERROR>',settings%name,'already exists.' write(stderr,'(*(g0,1x))')& & ' perhaps you wanted to add --backfill ?' return @@ -29,14 +84,14 @@ 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.' + & '<ERROR>',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(). @@ -51,23 +106,208 @@ 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%with_lib)then + if(settings%with_full)then + 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 = "'//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 ',& + &' # 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 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 ',& + &' # [[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" } ',& + &'#] ',& + &' ',& + &' # This would be in lieue of the [[executable]] section found later in this ',& + &' # configuration file. ',& + &' # + 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. ',& + &' # ',& + &' # 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 that in some cases the order of the libraries matters: ',& + &' ',& + &'#link = ["blas", "lapack"] ',& + &''] + endif + + if(settings%with_bare)then + elseif(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%with_full)then + tomlfile=[character(len=80) :: tomlfile, & + &'[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 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 ',& + &' # 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 littlefile=[character(len=80) :: & &'module '//to_fortran_name(bname), & @@ -85,43 +325,142 @@ character(len=8) :: date & littlefile) endif - if(settings%with_test)then - - ! 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="main.f90" ', & + 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" } ',& &''] - - littlefile=[character(len=80) :: & - &'program main', & - &'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) 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 - message=[character(len=80) :: message, & - &'[[executable]] ', & - &'name="'//bname//'" ', & - &'source-dir="app" ', & - &'main="main.f90" ', & - &''] + 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. ',& + &' # ',& + &' # 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. 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 ',& + &' # 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="'//bname//'"',& + &'source-dir="app" ',& + &'main="main.f90" ',& + &' ',& + &' # 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: ',& + &' ',& + &'#[[ 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 '//to_fortran_name(bname)//', only: say_hello', & + &' use '//to_fortran_name(bname)//', only: say_hello', & &' implicit none', & &'', & &' call say_hello()', & @@ -137,72 +476,176 @@ character(len=8) :: date call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile) endif + 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%with_full)then + tomlfile=[character(len=80) :: tomlfile ,& + &'[[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_io.git" } ',& + &'#M_system= { git = "https://github.com/urbanjost/M_system.git" } ',& + &''] + endif + + littlefile=[character(len=80) :: & + &'program check', & + &'implicit none', & + &'', & + &'print *, "Put some tests in here!"', & + &'end program check'] + ! create NAME/test/check.f90 + call warnwrite(join_path(settings%name, 'test/check.f90'), littlefile) + endif + + 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%with_full)then + tomlfile=[character(len=80) :: tomlfile, & + &'[[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 + + 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 + ! now that built it write NAME/fpm.toml - call warnwrite(join_path(settings%name, 'fpm.toml'), message) + 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 warnwrite(fname,data) -character(len=*),intent(in) :: fname -character(len=*),intent(in) :: data(:) +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 - if(.not.exists(fname))then - call filewrite(fname,data) - else - write(stderr,'(*(g0,1x))')'INFO: ',fname,& - & 'already exists. Not overwriting' + 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 warnwrite - -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 - - 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* error:',filename,trim(message) - error stop 1 - endif - ! 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* error:',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) - error stop 2 - endif -end subroutine filewrite +end subroutine create_verified_basic_manifest + + +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 end subroutine cmd_new diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index b7b5c2e..0217154 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -54,6 +54,9 @@ 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 :: with_full=.false. + logical :: with_bare=.false. logical :: backfill=.true. end type @@ -91,7 +94,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(:) @@ -135,10 +138,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 @@ -206,21 +209,24 @@ contains & --lib F & & --app F & & --test F & - & --backfill F& - & --verbose F',& + & --example F & + & --backfill F & + & --full F & + & --bare F & + & --verbose:V F',& & help_new, version_text) select case(size(unnamed)) case(1) write(stderr,'(*(g0,/))')'<ERROR> directory name required' write(stderr,'(*(7x,g0,/))') & - & '<USAGE> fpm new NAME [--lib|--src] [--app] [--test] [--backfill]' + & '<USAGE> fpm new NAME [[--lib|--src] [--app] [--test] [--example]]|[--full|--bare] [--backfill]' stop 1 case(2) name=trim(unnamed(2)) case default write(stderr,'(g0)')'<ERROR> only one directory name allowed' write(stderr,'(7x,g0)') & - & '<USAGE> fpm new NAME [--lib|--src] [--app] [--test] [--backfill]' + & '<USAGE> fpm new NAME [[--lib|--src] [--app] [--test] [--example]]| [--full|--bare] [--backfill]' stop 2 end select !*! canon_path is not converting ".", etc. @@ -233,22 +239,37 @@ contains endif 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','bare'])) & + & .and.lget('full') )then + write(stderr,'(*(a))')& + &'<ERROR> --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))')& + &'<ERROR> --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, & & with_executable=lget('app'), & & with_lib=any([lget('lib'),lget('src')]), & & 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=lget('full'), & + & with_full=lget('full'), & + & with_bare=lget('bare'), & & verbose=lget('verbose') ) endif @@ -412,7 +433,7 @@ contains if(val_compiler.eq.'') then val_compiler='gfortran' endif - + val_build=trim(merge('release','debug ',lget('release'))) end subroutine check_build_vals @@ -476,7 +497,8 @@ contains ' ', & ' build [--compiler COMPILER_NAME] [--release] [--list] ', & ' help [NAME(s)] ', & - ' new NAME [--lib|--src] [--app] [--test] [--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] ', & @@ -588,14 +610,17 @@ 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]]| ', & + ' [--full|--bare][--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)', & @@ -622,6 +647,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 ', & @@ -730,6 +756,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. ', & ' ', & @@ -789,8 +816,8 @@ 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]]| ', & + ' [--full|--bare][--backfill] ', & ' fpm new --help|--version ', & ' ', & 'DESCRIPTION ', & @@ -803,7 +830,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 ', & @@ -813,7 +840,17 @@ contains ' app/ ', & ' main.f90 ', & ' test/ ', & - ' main.f90 ', & + ' check.f90 ', & + ' example/ ', & + ' demo.f90 ', & + ' ', & + ' Using this file structure is highly encouraged, particularly for ', & + ' 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 ', & + ' 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. ', & @@ -823,9 +860,9 @@ contains ' must be made of up to 63 ASCII letters, digits, underscores, ', & ' or hyphens, and start with a letter. ', & ' ', & - ' The default is to create all of the src/, app/, 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". ', & @@ -834,16 +871,32 @@ 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". ', & + ' It is only created by default if "--full is" specified. ', & + ' ', & + ' So the default is equivalent to ',& ' ', & - ' So the default is equivalent to "fpm NAME --lib --app --test". ', & + ' 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 the missing ', & - ' app/ 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 ', & + ' and the example/ directory is created and populated. ', & + ' 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 ', & + ' directories or sample Fortran is generated. ', & ' ', & ' --help print this help and exit ', & ' --version print program version information and exit ', & @@ -855,8 +908,14 @@ 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) ', & + ' ', & + ' 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 ', & @@ -932,7 +991,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.', & '', & diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index 7ed99dc..ea3d9d3 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, to_fortran_name + public :: fileopen, fileclose, filewrite, warn 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 @@ -145,30 +147,28 @@ 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 -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 +315,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 +347,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 +389,7 @@ function windows_path(path) result(winpath) winpath(idx:idx) = '\' idx = index(winpath,'/') end do - + end function windows_path @@ -408,7 +408,7 @@ function unix_path(path) result(nixpath) nixpath(idx:idx) = '/' idx = index(nixpath,'\') end do - + end function unix_path @@ -464,6 +464,111 @@ 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))')'<INFO> ',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 :: 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))')& + & '<ERROR> *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))')'<ERROR> *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))')& + & '<ERROR> *filewrite*:',filename,trim(message) + stop 4 + endif + enddo + endif + ! close file + call fileclose(lun) + +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 pure function to_fortran_name(string) result(res) ! Returns string with special characters replaced with an underscore. diff --git a/fpm/src/fpm_source_parsing.f90 b/fpm/src/fpm_source_parsing.f90 index db271ed..76cb560 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) @@ -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 7d42d22..2b036d1 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -5,7 +5,7 @@ implicit none private public :: f_string, lower, split, str_ends_with, string_t public :: string_array_contains, string_cat, len_trim, operator(.in.), fnv_1a -public :: replace, resize, str +public :: replace, resize, str, join type string_t character(len=:), allocatable :: s @@ -56,7 +56,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) @@ -84,11 +84,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 @@ -111,7 +111,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 @@ -174,14 +174,14 @@ 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(:) character(*), intent(in), optional :: delim character(:), allocatable :: cat - integer :: i,n + integer :: i character(:), allocatable :: delim_str if (size(strings) < 1) then @@ -199,12 +199,11 @@ 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 - !> Determine total trimmed length of `string_t` array pure function string_len_trim(strings) result(n) type(string_t), intent(in) :: strings(:) @@ -222,7 +221,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 @@ -231,7 +230,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 @@ -248,7 +247,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 @@ -384,6 +383,108 @@ 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 pure integer function str_int_len(i) result(sz) ! Returns the length of the string representation of 'i' integer, intent(in) :: i 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 0637f0a..4ff00c3 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 @@ -77,6 +78,7 @@ logical :: IS_OS_WINDOWS if( is_dir('name-with-hyphens') ) then tally=[tally,.true.] + else write(*,*)'ERROR: directory name-with-hyphens/ exists' tally=[tally,.false.] @@ -91,23 +93,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 @@ -146,7 +150,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 |