diff options
| -rw-r--r-- | CONTRIBUTING.md | 122 | ||||
| -rw-r--r-- | PACKAGING.md | 351 | ||||
| -rw-r--r-- | README.md | 75 | ||||
| -rw-r--r-- | bootstrap/src/Fpm.hs | 14 | ||||
| -rw-r--r-- | fpm/fpm.toml | 2 | ||||
| -rw-r--r-- | fpm/src/fpm.f90 | 73 | ||||
| -rw-r--r-- | fpm/src/fpm/error.f90 | 70 | ||||
| -rw-r--r-- | fpm/src/fpm/manifest/dependency.f90 | 10 | ||||
| -rw-r--r-- | fpm/src/fpm/manifest/executable.f90 | 5 | ||||
| -rw-r--r-- | fpm/src/fpm/manifest/library.f90 | 2 | ||||
| -rw-r--r-- | fpm/src/fpm/manifest/package.f90 | 5 | ||||
| -rw-r--r-- | fpm/src/fpm/manifest/test.f90 | 3 | ||||
| -rw-r--r-- | fpm/src/fpm/toml.f90 | 7 | ||||
| -rw-r--r-- | fpm/src/fpm_backend.f90 | 6 | ||||
| -rw-r--r-- | fpm/src/fpm_command_line.f90 | 49 | ||||
| -rw-r--r-- | fpm/src/fpm_environment.f90 | 152 | ||||
| -rw-r--r-- | fpm/src/fpm_filesystem.f90 | 90 | ||||
| -rw-r--r-- | fpm/src/fpm_model.f90 | 87 | ||||
| -rw-r--r-- | fpm/src/fpm_sources.f90 | 255 | ||||
| -rw-r--r-- | fpm/src/fpm_strings.f90 | 19 | ||||
| -rw-r--r-- | fpm/test/main.f90 | 9 | ||||
| -rw-r--r-- | fpm/test/test_manifest.f90 | 505 | ||||
| -rw-r--r-- | fpm/test/test_source_parsing.f90 | 621 | ||||
| -rw-r--r-- | fpm/test/testsuite.f90 | 34 |
24 files changed, 2042 insertions, 524 deletions
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 0000000..9a1f5a3 --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,122 @@ +# Contributing to the Fortran Package Manager + +Thank you for considering contributing to the Fortran Package Manager (*fpm*). +Please review and follow these guidelines to make the contribution process +simple and effective for all involved. It will help communicate that you +respect the time of the community developers. In return, the community will +help address your problem, evaluate changes, and guide you through your pull +requests. + +By contributing to *fpm*, you certify that you own or are allowed to share the +content of your contribution under the +[fpm license](https://github.com/fortran-lang/fpm/blob/master/LICENSE). + +* [Style](#style) +* [Reporting a bug](#reporting-a-bug) +* [Suggesting a feature](#suggesting-a-feature) +* [Workflow](#workflow) +* [General guidelines](#general-guidelines) +* [For new contributors](#for-new-contributors) + +## Style + +Please follow the +[Fortran stdlib style guide](https://github.com/fortran-lang/stdlib/blob/master/STYLE_GUIDE.md) +for any Fortran code that you contribute. +This allows us to focus on substance rather than style. + +## Reporting a bug + +A bug is a *demonstrable problem* caused by the code in this repository. +Good bug reports are extremely valuable to us—thank you! + +Before opening a bug report: + +1. Check if the issue has already been reported + ([issues](https://github.com/fortran-lang/fpm/issues)). +2. Check if it is still an issue or it has been fixed? + Try to reproduce it with the latest version from the master branch. +3. Isolate the problem and create a minimal test case. + +A good bug report should include all information needed to reproduce the bug. +Please be as detailed as possible: + +1. Which version of *fpm* are you using? Please be specific. +2. What are the steps to reproduce the issue? +3. What is the expected outcome? +4. What happens instead? + +This information will help the community diagnose the issue quickly and with +minimal back-and-forth. + +## Suggesting a feature + +Before suggesting a new feature, take a moment to find out if it fits the scope +of the project, or if it has already been discussed. It is up to you to provide +a strong argument to convince the community of the benefits of this feature. +Please provide as much detail and context as possible. If applicable, include a +mocked-up snippet of what the output or behavior would look like with this +feature implemented. “Crazy”, out-of-the-box ideas are especially welcome. +It’s quite possible that we are not considering an unusually creative solution. + +## Workflow + +*fpm* is a community project. There is no one single person making final +decisions. This is the workflow that we follow: + +1. Open a [new issue](https://github.com/fortran-lang/fpm/issues/new) to + describe a bug or propose a new feature. + Refer to the earlier sections on how to write a good bug report or feature + request. +2. Discuss with the community and reach majority consensus about what should be + done about the bug or feature request. + We define “majority” loosely as 80%. + This means that at least 4 of 5 people engaged in the discussion should be + able to agree on the next step. + This allows us to have the community mostly agree while not getting stuck if + one person disagrees. + At this stage, the scope of the fix/feature, its behavior, and API if + applicable should be defined. + Only when you have community concensus on these items you should proceed to + writing code and opening a PR. + **When actively working on code towards a PR, please assign yourself to the + issue on GitHub.** + This is good collaborative practice to avoid duplicated effort and also + inform others what you are currently working on. +3. Open a new Pull Request (PR) with your contribution. + The body of the PR should at least include a bullet-point summary of the + changes, and a detailed description is encouraged. + If the PR completely addresses the issue you opened in step 1, include in + the PR description the following line: `Fixes #<issue-number>`. +4. Request reviewers to your PR. + For small bug fixes or documentation improvements, 1 to 2 reviewers is + sufficient. + For implementation of bigger features, request 3 to 4 or more reviewers. + Ideally, request reviewers that participated in step 2. +5. If your PR implements a feature that adds or changes the behavior of *fpm*, + your PR must also include appropriate changes to the documentation. + +This workflow can evolve and change over time as we learn how best to work +together. If you have an idea on how to improve the workflow itself, please +open an issue and we’ll discuss it. + +## General guidelines + +* A PR should implement *only one* feature or bug fix. +* Do not commit changes to files that are irrelevant to your feature or bug fix. +* Smaller PRs are better than large PRs, and will lead to a shorter review and + merge cycle +* Add tests for your feature or bug fix to be sure that it stays functional and useful +* Be open to constructive criticism and requests for improving your code. +* Again, please follow the + [Fortran stdlib style guide](https://github.com/fortran-lang/stdlib/blob/master/STYLE_GUIDE.md). + +## For new contributors + +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). + +Don’t know where to start? +You can start by looking through the list of +[open issues](https://github.com/fortran-lang/fpm/issues). diff --git a/PACKAGING.md b/PACKAGING.md index 941f1b0..f5f28e3 100644 --- a/PACKAGING.md +++ b/PACKAGING.md @@ -1,9 +1,9 @@ # Preparing your package for FPM -This document describes how you need to organize your application or library -for it to successfully build with the Fortran Package Manager (FPM). +This document describes how you need to organize your application or library for +it to successfully build with the Fortran Package Manager (*fpm*). -* [What kind of package can FPM build?](#what-kind-of-package-can-fpm-build) +* [What kind of package can fpm build?](#what-kind-of-package-can-fpm-build) * [Example package layouts](#example-package-layouts) - [Single program](#single-program) - [Single-module library](#single-module-library) @@ -15,27 +15,27 @@ for it to successfully build with the Fortran Package Manager (FPM). - [Adding dependencies](#adding-dependencies) - [Custom build scripts](#custom-build-scripts) -## What kind of package can FPM build? +## What kind of package can fpm build? -You can use FPM to build: +You can use *fpm* to build: * Applications (program only) * Libraries (modules only) * Combination of the two (programs and modules combined) -Let's look at some examples of different kinds of package layouts that you can -use with FPM. +Let’s look at some examples of different kinds of package layouts that you can +use with *fpm*. ## Example package layouts -This section describes some example package layouts that you can build with FPM. -You can use them to model the layout of your own package. +This section describes some example package layouts that you can build with +*fpm*. You can use them to model the layout of your own package. ### Single program -Let's start with the simplest package imaginable--a single program without -dependencies or modules. -Here's what the layout of the top-level directory looks like: +Let’s start with the simplest package imaginable—a single program without +dependencies or modules. Here’s what the layout of the top-level directory +looks like: ``` . @@ -44,22 +44,20 @@ Here's what the layout of the top-level directory looks like: └── fpm.toml ``` -We have one source file (`main.f90`) in one directory (`app`). -Its contents are: +We have one source file (`main.f90`) in one directory (`app`). Its contents +are: ```fortran -program hello - print *, 'Hello, World!' -end program hello +program main + print *, 'Hello, World!' +end program main ``` This program prints the usual greeting to the standard output, and nothing more. - -There's another important file in the top-level directory, `fpm.toml`. -This is FPM's configuration file specific to your package. -It includes all the data that FPM needs to build your app. -In our simple case, it looks like this: +There’s another important file in the top-level directory, `fpm.toml`. This is +*fpm*’s configuration file specific to your package. It includes all the data +that *fpm* needs to build your app. In our simple case, it looks like this: ```toml name = "hello" @@ -71,18 +69,18 @@ copyright = "2020 Jane Programmer" ``` The preamble includes some metadata, such as `license`, `author`, and similar, -that you may have seen in other package manager configuration files. -The one option that matters here right now is: +that you may have seen in other package manager configuration files. The one +option that matters here right now is: ```toml name = "hello" ``` -This line specifies the name of your package, which determines the name of -the executable file of your program. -In this example, our program executable, once built, will be called `hello`. +This line specifies the name of your package, which determines the name of the +executable file of your program. In this example, our program executable, once +built, will be called `hello`. -Let's now build this program using FPM: +Let’s now build this program using *fpm*: ``` $ fpm build @@ -91,7 +89,7 @@ $ fpm build ``` On the first line, we ran `fpm build` to compile and link the application. -The latter two lines are emitted by FPM, and indicate which command was +The latter two lines are emitted by *fpm*, and indicate which command was executed at each build step (`gfortran`), and which files have been output by it: object file `main.o`, and executable `hello`. @@ -102,7 +100,7 @@ $ fpm run Hello, World! ``` -If your application needs to use a module internally, but you don't intend +If your application needs to use a module internally, but you don’t intend to build it as a library to be used in other projects, you can include the module in your program source file as well. For example: @@ -110,18 +108,17 @@ For example: ```fortran $ cat app/main.f90 module math_constants - real, parameter :: pi = 4 * atan(1.) + real, parameter :: pi = 4 * atan(1.) end module math_constants - -program hello - use math_constants, only: pi - print *, 'Hello, World!' - print *, 'pi = ', pi -end program hello +program main + use math_constants, only: pi + print *, 'Hello, World!' + print *, 'pi = ', pi +end program main ``` -Now run this using `fpm run`: +Now, run this using `fpm run`: ``` $ fpm run @@ -131,20 +128,18 @@ $ fpm run pi = 3.14159274 ``` -Notice that you can run `fpm run`, and if the package hasn't been built yet, -`fpm build` will run automatically for you. -This is true if the source files have been updated since the last build. -Thus, if you want to run your application, you can skip the `fpm build` step, -and go straight to `fpm run`. +Notice that you can run `fpm run`, and if the package hasn’t been built yet, +`fpm build` will run automatically for you. This is true if the source files +have been updated since the last build. Thus, if you want to run your +application, you can skip the `fpm build` step, and go straight to `fpm run`. Although we have named our program `hello`, which is the same name as the -package name in `fpm.toml`, you can name it anything you want as long as it's +package name in `fpm.toml`, you can name it anything you want as long as it’s permitted by the language. -In this last example, our source file defined a `math_constants` module -inside the same source file as the main program. -Let's see how we can define an FPM package that makes this module available -as a library. +In this last example, our source file defined a `math_constants` module inside +the same source file as the main program. Let’s see how we can define an *fpm* +package that makes this module available as a library. ### Single-module library @@ -157,13 +152,13 @@ The package layout for this example looks like this: └── math_constants.f90 ``` -In this example we'll build a simple math constants library that exports +In this example we’ll build a simple math constants library that exports the number pi as a parameter: ```fortran $ cat src/math_constants.f90 module math_constants - real, parameter :: pi = 4 * atan(1.) + real, parameter :: pi = 4 * atan(1.) end module math_constants ``` @@ -178,21 +173,21 @@ $ fpm build ar: creating build/debug/library/math_constants.a ``` -Based on the output of `fpm build`, FPM first ran `gfortran` to emit the +Based on the output of `fpm build`, *fpm* first ran `gfortran` to emit the binary object (`math_constants.o`) and module (`math_constants.mod`) files. Then it ran `ar` to create a static library archive `math_constants.a`. `build/debug/library` is thus both your include and library path, should you want to compile and link an exteranl program with this library. -For modules in the top-level (`src`) directory, FPM requires that: +For modules in the top-level (`src`) directory, *fpm* requires that: * The module has the same name as the source file. * There is 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: +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. @@ -202,17 +197,16 @@ packages (more on this in a bit). Since this is a library without executable programs, `fpm run` here does nothing. -In this example, our library is made of only one module. -However, most real-world libraries are likely to use multiple modules. -Let's see how you can package your multi-module library. +In this example, our library is made of only one module. However, most +real-world libraries are likely to use multiple modules. Let’s see how you can +package your multi-module library. ### Multi-module library -In this example, we'll use another module to define a 64-bit real kind +In this example, we’ll use another module to define a 64-bit real kind parameter and make it available in `math_constants` to define `pi` with -higher precision. -To make this exercise worthwhile, we'll define another math constant, -Euler's number. +higher precision. To make this exercise worthwhile, we’ll define another math +constant, Euler’s number. Our package layout looks like this: @@ -224,20 +218,20 @@ Our package layout looks like this: └── type_kinds.f90 ``` -and our source file contents are: +And our source file contents are: ```fortran $ cat src/math_constants.f90 module math_constants - use type_kinds, only: rk - real(rk), parameter :: pi = 4 * atan(1._rk) - real(rk), parameter :: e = exp(1._rk) + use type_kinds, only: rk + real(rk), parameter :: pi = 4 * atan(1._rk) + real(rk), parameter :: e = exp(1._rk) end module math_constants $ cat src/type_kinds.f90 module type_kinds - use iso_fortran_env, only: real64 - integer, parameter :: rk = real64 + use iso_fortran_env, only: real64 + integer, parameter :: rk = real64 end module type_kinds ``` @@ -264,7 +258,7 @@ $ ls build/debug/library/ math_constants.a math_constants.mod math_constants.o type_kinds.mod type_kinds.o ``` -and the static library includes all the object files: +And the static library includes all the object files: ``` $ nm build/debug/library/math_constants.a @@ -276,18 +270,17 @@ type_kinds.o: The takeaways from this example are that: -* FPM automatically scanned the `src` directory for any source files. +* *fpm* automatically scanned the `src` directory for any source files. * It also resolved the dependency order between different modules. ### Application and library -Let's now combine the two previous examples into one: -We'll build the math constants library _and_ an executable program that uses -it. -We'll use this program as a demo, and to verify that defining higher-precision -constants from the previous example actually worked. +Let’s now combine the two previous examples into one: We’ll build the math +constants library *and* an executable program that uses it. We’ll use this +program as a demo, and to verify that defining higher-precision constants from +the previous example actually worked. -Here's the package layout for your application + library package: +Here’s the package layout for your application + library package: ``` . @@ -303,15 +296,15 @@ Our `fpm.toml` remains unchanged and our executable program source file is: ```fortran $ cat app/main.f90 -program demo - use math_constants, only: e, pi - print *, 'math_constants library demo' - print *, 'pi = ', pi - print *, 'e = ', e -end program demo +program main + use math_constants, only: e, pi + print *, 'math_constants library demo' + print *, 'pi = ', pi + print *, 'e = ', e +end program main ``` -Let's go straight to running the demo program: +Let’s go straight to running the demo program: ``` $ fpm run @@ -326,10 +319,10 @@ ar: creating build/debug/library/math_constants.a e = 2.7182818284590451 ``` -The FPM build + run process works as expected, and our program correctly outputs -higher-precision constants. +The *fpm* build + run process works as expected, and our program correctly +outputs higher-precision constants. -So far we covered how FPM builds: +So far we covered how *fpm* builds: * A single program * A single-module library @@ -337,14 +330,13 @@ So far we covered how FPM builds: * A program and a library However, all our modules so far have been organized in the top level source -directory. -More complex libraries may organize their modules in subdirectories. -Let's see how we can build this with FPM. +directory. More complex libraries may organize their modules in subdirectories. +Let’s see how we can build this with *fpm*. ### Multi-level library -In this example, we'll define our library as a collection of modules, -two of which are defined in a subdirectory: +In this example, we’ll define our library as a collection of modules, two of +which are defined in a subdirectory: ``` . @@ -367,44 +359,43 @@ The rest of the source files are: ```fortran $ cat src/math_constants.f90 module math_constants - use math_constants_fundamental, only: e, pi - use math_constants_derived, only: half_pi, two_pi + use math_constants_fundamental, only: e, pi + use math_constants_derived, only: half_pi, two_pi end module math_constants $ cat src/math_constants/fundamental.f90 module math_constants_fundamental - use type_kinds, only: rk - real(rk), parameter :: pi = 4 * atan(1._rk) - real(rk), parameter :: e = exp(1._rk) + use type_kinds, only: rk + real(rk), parameter :: pi = 4 * atan(1._rk) + real(rk), parameter :: e = exp(1._rk) end module math_constants_fundamental $ cat src/math_constants/derived.f90 module math_constants_derived - use math_constants_fundamental, only: pi - use type_kinds, only: rk - real(rk), parameter :: two_pi = 2 * pi - real(rk), parameter :: half_pi = pi / 2 + use math_constants_fundamental, only: pi + use type_kinds, only: rk + real(rk), parameter :: two_pi = 2 * pi + real(rk), parameter :: half_pi = pi / 2 end module math_constants_derived $ cat app/main.f90 -program demo - use math_constants, only: e, pi, half_pi, two_pi - print *, 'math_constants library demo' - print *, 'pi = ', pi - print *, '2*pi = ', two_pi - print *, 'pi/2 = ', half_pi - print *, 'e = ', e -end program demo +program main + use math_constants, only: e, pi, half_pi, two_pi + print *, 'math_constants library demo' + print *, 'pi = ', pi + print *, '2*pi = ', two_pi + print *, 'pi/2 = ', half_pi + print *, 'e = ', e +end program main ``` -Our top-level `math_constants` module now doesn't define the constants, -but imports them from the two modules in the subdirectory. -Constants `e` and `pi` we define in the `math_constants_fundamental` module, -and `two_pi` and `half_pi` in the `math_constants_derived` module. -From the main program, we access all the constants from the top-level -module `math_constants`. +Our top-level `math_constants` module now doesn’t define the constants, but +imports them from the two modules in the subdirectory. Constants `e` and `pi` +we define in the `math_constants_fundamental` module, and `two_pi` and `half_pi` +in the `math_constants_derived` module. From the main program, we access all +the constants from the top-level module `math_constants`. -Let's build and run this package: +Let’s build and run this package: ``` $ fpm run @@ -423,19 +414,17 @@ ar: creating build/debug/library/math_constants.a e = 2.7182818284590451 ``` -Again, FPM built and run the package as expected. +Again, *fpm* built and run the package as expected. -Recall from an earlier example that FPM required the modules in the top-level -`src` directory to be named the same as their source file. -This is why `src/math_constants.f90` defines `module math_constants`. +Recall from an earlier example that *fpm* required the modules in the top-level +`src` directory to be named the same as their source file. This is why +`src/math_constants.f90` defines `module math_constants`. -For modules defined in subdirectories, there's an additional requirement: -module name must contain the path components of the directory that its -source file is in. -In our case, `src/math_constants/fundamental.f90` defines -the `math_constants_fundamental` module. -Likewise, `src/math_constants/derived.f90` defines -the `math_constants_derived` module. +For modules defined in subdirectories, there’s an additional requirement: module +name must contain the path components of the directory that its source file is +in. In our case, `src/math_constants/fundamental.f90` defines the +`math_constants_fundamental` module. Likewise, `src/math_constants/derived.f90` +defines the `math_constants_derived` module. 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`. @@ -448,12 +437,12 @@ Takeaways from this example are that: ### Be more explicit -So far we've let FPM use its defaults to determine the layout of our package. +So far we’ve let *fpm* use its defaults to determine the layout of our package. It determined where our library sources would live, what the name of the executable will be, and some other things. But we can be more explicit about it, and make some changes to those things. -Let's look at what the `fpm.toml` file from our last example would look like if +Let’s look at what the `fpm.toml` file from our last example would look like if we specified everything. ```toml @@ -474,17 +463,18 @@ main="main.f90" ``` You can see that by making these explicit in the `fpm.toml` we are able to -change many of the settings that FPM used by default. We can change the folders -where our sources are stored, we can change the name of our executable, and we -can change the name of the file our program is defined in. +change many of the settings that *fpm* used by default. We can change the +folders where our sources are stored, we can change the name of our executable, +and we can change the name of the file our program is defined in. ### Add some tests -FPM also provides support for unit testing. By default, FPM looks for a program -in `test/main.f90` which it will compile and execute with the command `fpm test`. -The tests are treated pretty much exactly like the executables. Let's define -one explicitly in our `fpm.toml` file. We'll make sure that our definition of -`pi` satisfies the property `sin(pi) == 0.0`. Here's the `fpm.toml` file, +*fpm* also provides support for unit testing. By default, *fpm* looks for a +program in `test/main.f90` which it will compile and execute with the command +`fpm test`. The tests are treated pretty much exactly like the executables. +Let’s define one explicitly in our `fpm.toml` file. We’ll make sure that our +definition of `pi` satisfies the property `sin(pi) == 0.0`. Here’s the +`fpm.toml` file: ```toml name = "math_constants" @@ -511,11 +501,10 @@ main="main.f90" where the contents of the `main.f90` file are ```fortran -program tests - use math_constants, only: pi - - print *, "sin(pi) = ", sin(pi) -end program tests +program main + use math_constants, only: pi + print *, "sin(pi) = ", sin(pi) +end program main ``` With this setup, we can run our tests. @@ -535,12 +524,12 @@ ar: creating build/debug/library/math_constants.a sin(pi) = 1.2246467991473532E-016 ``` -### Adding Dependencies +### Adding dependencies -Inevitably you'll want to be able to include other libraries in your project. +Inevitably, you’ll want to be able to include other libraries in your project. fpm makes this incredibly simple, by taking care of fetching and compiling your dependencies for you. You just tell it what your dependencies are, and where to -find them. Let's add a dependency to our library. Now our `fpm.toml` file looks +find them. Let’s add a dependency to our library. Now our `fpm.toml` file looks like this: ```toml @@ -572,19 +561,19 @@ Now you can use any modules from this library anywhere in your code. Just like this: ```fortran -program demo - use helloff, only: create_greeting - use math_constants, only: e, pi, half_pi, two_pi - print *, 'math_constants library demo' - print *, 'pi = ', pi - print *, '2*pi = ', two_pi - print *, 'pi/2 = ', half_pi - print *, 'e = ', e - print *, create_greeting("fpm") -end program demo +program main + use helloff, only: create_greeting + use math_constants, only: e, pi, half_pi, two_pi + print *, 'math_constants library demo' + print *, 'pi = ', pi + print *, '2*pi = ', two_pi + print *, 'pi/2 = ', half_pi + print *, 'e = ', e + print *, create_greeting("fpm") +end program main ``` -And now `fpm run` will output the following: +And now, `fpm run` will output the following: ``` math_constants library demo @@ -596,10 +585,10 @@ And now `fpm run` will output the following: ``` Additionally, any users of your library will now automatically depend on your -dependencies too. So if you don't need that depedency for the library, like in +dependencies too. So if you don’t need that depedency for the library, like in the above example, then you can specify it for the specific executable like below. Then fpm will still fetch and compile it when building your executable, -but users of your library won't have to. +but users of your library won’t have to. ```toml name = "math_constants" @@ -619,7 +608,6 @@ main="main.f90" [executable.dependencies] helloff = { git = "https://gitlab.com/everythingfunctional/helloff.git" } - [[test]] name="runTests" source-dir="test" @@ -627,9 +615,9 @@ main="main.f90" ``` You can also specify dependencies for your tests in a similar way, with -`[test.dependencies]` instead of `[executable.dependencies]`. There's also +`[test.dependencies]` instead of `[executable.dependencies]`. There’s also another option for test dependencies. The below example makes the dependencies -available for all the tests, but again your users won't depend on these. +available for all the tests, but again your users won’t depend on these. ```toml name = "math_constants" @@ -656,20 +644,23 @@ source-dir="test" main="main.f90" ``` -You can also be specific about which version of a dependency you'd like. You can -specify a branch to use like `helloff = { git = "https://gitlab.com/everythingfunctional/helloff.git", branch = "master" }`, -or a tag like `helloff = { git = "https://gitlab.com/everythingfunctional/helloff.git", tag = "v1.2.3" }`, -or even a specific commit like `helloff = { git = "https://gitlab.com/everythingfunctional/helloff.git", rev = "a1b2c3" }`. -You can even specify the path to another folder, if for example you've got another -fpm package in the same repository. Like this: `helloff = { path = "helloff" }`. -Note that you should *not* specify paths outside of your repository, or things -won't work for your users. +You can also be specific about which version of a dependency you’d like. You can +specify a branch to use like +`helloff = { git = "https://gitlab.com/everythingfunctional/helloff.git", branch = "master" }`, +or a tag like +`helloff = { git = "https://gitlab.com/everythingfunctional/helloff.git", tag = "v1.2.3" }`, +or even a specific commit like +`helloff = { git = "https://gitlab.com/everythingfunctional/helloff.git", rev = "a1b2c3" }`. +You can even specify the path to another folder, if for example you’ve got +another fpm package in the same repository. Like this: +`helloff = { path = "helloff" }`. Note that you should *not* specify paths +outside of your repository, or things won’t work for your users. -### Custom Build Scripts +### Custom build scripts If there is something special about your library that makes fpm unable to build -it, you can provide your own build script. fpm will then simply call your -build script to build the library. +it, you can provide your own build script. fpm will then simply call your build +script to build the library. To specify a build script to be used, put it in the library section of your `fpm.toml` file, like: @@ -680,15 +671,15 @@ source-dir="src" build-script="my_build_script" ``` -fpm will set the following environment variables to specify some parameters to -the build script. +*fpm* will set the following environment variables to specify some parameters to +the build script: -* `FC` - The Fortran compiler to be used -* `FFLAGS` - The flags that should be passed to the Fortran compiler -* `BUILD_DIR` - Where the compiled files should be placed -* `INCLUDE_DIRS` - The folders where any dependencies can be found, space seperated. - It is then the responsibility of the build script to generate the appropriate - include flags. +* `FC` – The Fortran compiler to be used. +* `FFLAGS` – The flags that should be passed to the Fortran compiler. +* `BUILD_DIR` – Where the compiled files should be placed. +* `INCLUDE_DIRS` – The folders where any dependencies can be found, space seperated. +It is then the responsibility of the build script to generate the appropriate +include flags. Additionally, script will be called with the name of the archive (`*.a` file) that should be produced as the command line argument. @@ -1,69 +1,80 @@ # Fortran Package Manager -This is the repository of the Fortran Package Manager (fpm). -If you are looking for _fpm--packaging made simple_ instead, see +This is the repository of the Fortran Package Manager (*fpm*). If you are +looking for *fpm – packaging made simple* instead, see [jordansissel/fpm](https://github.com/jordansissel/fpm). -Fortran Package Manager is an early prototype. -You can use it to build and package your Fortran projects, as -well as to include supported Fortran dependency projects. -As a prototype, changes to fpm's behavior and inputs may occur as development continues. -Please follow the [issues](https://github.com/fortran-lang/fpm/issues) -to contribute and/or stay up to date with the development. -As the prototype matures and we enter production, we will do our best to stay backwards compatible. +Fortran Package Manager is an early prototype. You can use it to build and +package your Fortran projects, as well as to include supported Fortran +dependency projects. As a prototype, changes to *fpm*’s behavior and inputs may +occur as development continues. Please follow the +[issues](https://github.com/fortran-lang/fpm/issues) to contribute and/or stay +up to date with the development. As the prototype matures and we enter +production, we will do our best to stay backwards compatible. + +To report a bug report or suggest a feature, please read our +[contributor guidelines](CONTRIBUTING.md). ## Getting started ### Install Haskell -To install **Haskell Stack**, follow these [instructions](https://docs.haskellstack.org/en/stable/install_and_upgrade/), -users without superuser (admin) permissions should follow the [manual installation](https://docs.haskellstack.org/en/stable/install_and_upgrade/#manual-download_2) procedure. +To install **Haskell Stack**, follow these +[instructions](https://docs.haskellstack.org/en/stable/install_and_upgrade/), +users without superuser (admin) permissions should follow the +[manual installation](https://docs.haskellstack.org/en/stable/install_and_upgrade/#manual-download_2) +procedure. ### Download this repository ```bash -git clone https://github.com/fortran-lang/fpm -cd fpm +$ git clone https://github.com/fortran-lang/fpm +$ cd fpm/ ``` -### Build and Test fpm +### Build and test fpm + +Bootstrap *fpm* using: -Bootstrap fpm using: ```bash -cd bootstrap -stack build +$ cd bootstrap/ +$ stack build ``` + To test: + ```bash -stack test +$ stack test ``` + To install: + ```bash -stack install +$ stack install ``` -On Linux, the above command installs `fpm` to `${HOME}/.local/bin`. +On Linux, the above command installs `fpm` to `${HOME}/.local/bin/`. ### Creating a new project -Creating a new fpm project is as simple as running the command `fpm new project_name`. -This will create a new folder in your current directory with the following contents -and initialized as a git repository. +Creating a new *fpm* project is as simple as running the command +`fpm new project_name`. This will create a new folder in your current directory +with the following contents and initialized as a git repository. -* `fpm.toml` with your project's name and some default standard meta-data -* `README.md` with your project's name +* `fpm.toml` – with your project’s name and some default standard meta-data +* `README.md` – with your project’s name * `.gitgnore` -* `src/project_name.f90` with a simple hello world subroutine -* `app/main.f90` (if `--with-executable` flag used) a program that calls the subroutine -* `test/main.f90` (if `--with-test` flag used) an empty test program +* `src/project_name.f90` – with a simple hello world subroutine +* `app/main.f90` (if `--with-executable` flag used) – a program that calls the subroutine +* `test/main.f90` (if `--with-test` flag used) – an empty test program ### Building your Fortran project with fpm -fpm understands the basic commands: +*fpm* understands the basic commands: -* `fpm build` - build your library, executables and tests -* `fpm run` - run executables -* `fpm test`- run tests +* `fpm build` – build your library, executables and tests +* `fpm run` – run executables +* `fpm test` – run tests The command `fpm run` can optionally accept the name of the specific executable to run, as can `fpm test`; like `fpm run specifc_executable`. Command line diff --git a/bootstrap/src/Fpm.hs b/bootstrap/src/Fpm.hs index fdd83d9..d9de668 100644 --- a/bootstrap/src/Fpm.hs +++ b/bootstrap/src/Fpm.hs @@ -617,19 +617,23 @@ fetchDependency name version = do undefined GitVersion versionSpec -> do system - ("git clone " ++ gitVersionSpecUrl versionSpec ++ " " ++ clonePath) + ("git init " ++ clonePath) case gitVersionSpecRef versionSpec of - Just ref -> withCurrentDirectory clonePath $ do + Just ref -> do system - ( "git checkout " + ("git -C " ++ clonePath ++ " fetch " ++ gitVersionSpecUrl versionSpec ++ " " ++ (case ref of Tag tag -> tag Branch branch -> branch Commit commit -> commit ) ) - return (name, clonePath) - Nothing -> return (name, clonePath) + Nothing -> do + system + ("git -C " ++ clonePath ++ " fetch " ++ gitVersionSpecUrl versionSpec) + system + ("git -C " ++ clonePath ++ " checkout -qf FETCH_HEAD") + return (name, clonePath) PathVersion versionSpec -> return (name, pathVersionSpecPath versionSpec) {- diff --git a/fpm/fpm.toml b/fpm/fpm.toml index b39d881..d29994a 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -8,7 +8,7 @@ copyright = "2020 fpm contributors" [dependencies] [dependencies.toml-f] git = "https://github.com/toml-f/toml-f" -rev = "290ba87671ab593e7bd51599e1d80ea736b3cd36" +tag = "v0.2" [[test]] name = "fpm-test" diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 1bd4c7f..b57a713 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -4,10 +4,12 @@ use fpm_strings, only: string_t, str_ends_with use fpm_backend, only: build_package use fpm_command_line, only: fpm_build_settings use fpm_environment, only: run, get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS -use fpm_filesystem, only: number_of_rows, list_files, exists -use fpm_model, only: build_model, fpm_model_t -use fpm_manifest, only : get_package_data, default_executable, default_library, & - & package_t +use fpm_filesystem, only: join_path, number_of_rows, list_files, exists +use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t +use fpm_sources, only: add_executable_sources, add_sources_from_dir, & + resolve_module_dependencies +use fpm_manifest, only : get_package_data, default_executable, & + default_library, package_t use fpm_error, only : error_t implicit none private @@ -16,15 +18,66 @@ public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test contains +subroutine build_model(model, settings, package, error) + ! Constructs a valid fpm model from command line settings and toml manifest + ! + type(fpm_model_t), intent(out) :: model + type(fpm_build_settings), intent(in) :: settings + type(package_t), intent(in) :: package + type(error_t), allocatable, intent(out) :: error + + model%package_name = package%name + + ! #TODO: Choose flags and output directory based on cli settings & manifest inputs + model%fortran_compiler = 'gfortran' + model%output_directory = 'build/gfortran_debug' + model%fortran_compile_flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g '// & + '-fbounds-check -fcheck-array-temporaries -fbacktrace '// & + '-J'//join_path(model%output_directory,model%package_name) + model%link_flags = '' + + ! Add sources from executable directories + if (allocated(package%executable)) then + + call add_executable_sources(model%sources, package%executable, & + is_test=.false., error=error) + + if (allocated(error)) then + return + end if + + end if + if (allocated(package%test)) then + + call add_executable_sources(model%sources, package%test, & + is_test=.true., error=error) + + if (allocated(error)) then + return + end if + + end if + + if (allocated(package%library)) then + + call add_sources_from_dir(model%sources,package%library%source_dir, & + error=error) + + if (allocated(error)) then + return + end if + + end if + + call resolve_module_dependencies(model%sources) + +end subroutine build_model subroutine cmd_build(settings) type(fpm_build_settings), intent(in) :: settings type(package_t) :: package type(fpm_model_t) :: model type(error_t), allocatable :: error -type(string_t), allocatable :: files(:) -character(:), allocatable :: basename, linking -integer :: i, n call get_package_data(package, "fpm.toml", error) if (allocated(error)) then print '(a)', error%message @@ -48,7 +101,11 @@ if (.not.(allocated(package%library) .or. allocated(package%executable))) then error stop 1 end if -call build_model(model, settings, package) +call build_model(model, settings, package, error) +if (allocated(error)) then + print '(a)', error%message + error stop 1 +end if call build_package(model) diff --git a/fpm/src/fpm/error.f90 b/fpm/src/fpm/error.f90 index aebd7e4..e69ff1e 100644 --- a/fpm/src/fpm/error.f90 +++ b/fpm/src/fpm/error.f90 @@ -5,6 +5,7 @@ module fpm_error public :: error_t public :: fatal_error, syntax_error, file_not_found_error + public :: file_parse_error !> Data type defining an error @@ -55,4 +56,73 @@ contains end subroutine file_not_found_error + !> Error created when file parsing fails + subroutine file_parse_error(error, file_name, message, line_num, & + line_string, line_col) + + !> Instance of the error data + type(error_t), allocatable, intent(out) :: error + + !> Name of file + character(len=*), intent(in) :: file_name + + !> Parse error message + character(len=*), intent(in) :: message + + !> Line number of parse error + integer, intent(in), optional :: line_num + + !> Line context string + character(len=*), intent(in), optional :: line_string + + !> Line context column + integer, intent(in), optional :: line_col + + character(50) :: temp_string + + allocate(error) + error%message = 'Parse error: '//message//new_line('a') + + error%message = error%message//file_name + + if (present(line_num)) then + + write(temp_string,'(I0)') line_num + + error%message = error%message//':'//trim(temp_string) + + end if + + if (present(line_col)) then + + if (line_col > 0) then + + write(temp_string,'(I0)') line_col + error%message = error%message//':'//trim(temp_string) + + end if + + end if + + if (present(line_string)) then + + error%message = error%message//new_line('a') + error%message = error%message//' | '//line_string + + if (present(line_col)) then + + if (line_col > 0) then + + error%message = error%message//new_line('a') + error%message = error%message//' | '//repeat(' ',line_col-1)//'^' + + end if + + end if + + end if + + end subroutine file_parse_error + + end module fpm_error diff --git a/fpm/src/fpm/manifest/dependency.f90 b/fpm/src/fpm/manifest/dependency.f90 index 8a3d879..599d43a 100644 --- a/fpm/src/fpm/manifest/dependency.f90 +++ b/fpm/src/fpm/manifest/dependency.f90 @@ -94,7 +94,7 @@ contains end if if (.not.allocated(self%git)) then - call get_value(table, "revision", obj) + call get_value(table, "rev", obj) if (allocated(obj)) then self%git = git_target_revision(url, obj) end if @@ -120,9 +120,10 @@ contains character(len=:), allocatable :: name type(toml_key), allocatable :: list(:) - logical :: url_present, git_target_present + logical :: url_present, git_target_present, has_path integer :: ikey + has_path = .false. url_present = .false. git_target_present = .false. @@ -146,6 +147,7 @@ contains exit end if url_present = .true. + has_path = list(ikey)%key == 'path' case("branch", "rev", "tag") if (git_target_present) then @@ -163,7 +165,7 @@ contains return end if - if (.not.url_present .and. git_target_present) then + if (has_path .and. git_target_present) then call syntax_error(error, "Dependency "//name//" uses a local path, therefore no git identifiers are allowed") end if @@ -182,7 +184,7 @@ contains !> Error handling type(error_t), allocatable, intent(out) :: error - class(toml_table), pointer :: node + type(toml_table), pointer :: node type(toml_key), allocatable :: list(:) integer :: idep, stat diff --git a/fpm/src/fpm/manifest/executable.f90 b/fpm/src/fpm/manifest/executable.f90 index f706001..6675519 100644 --- a/fpm/src/fpm/manifest/executable.f90 +++ b/fpm/src/fpm/manifest/executable.f90 @@ -57,7 +57,7 @@ contains !> Error handling type(error_t), allocatable, intent(out) :: error - class(toml_table), pointer :: child + type(toml_table), pointer :: child call check(table, error) if (allocated(error)) return @@ -104,7 +104,7 @@ contains do ikey = 1, size(list) select case(list(ikey)%key) case default - call syntax_error(error, "Key "//list(ikey)%key//" is not allowed executable entry") + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed as executable entry") exit case("name") @@ -115,6 +115,7 @@ contains end select end do + if (allocated(error)) return if (.not.name_present) then call syntax_error(error, "Executable name is not provided, please add a name entry") diff --git a/fpm/src/fpm/manifest/library.f90 b/fpm/src/fpm/manifest/library.f90 index 40e5e92..7a79a2a 100644 --- a/fpm/src/fpm/manifest/library.f90 +++ b/fpm/src/fpm/manifest/library.f90 @@ -77,7 +77,7 @@ contains do ikey = 1, size(list) select case(list(ikey)%key) case default - call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in package file") + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in library") exit case("source-dir", "build-script") diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90 index 4c2c14a..dff81e5 100644 --- a/fpm/src/fpm/manifest/package.f90 +++ b/fpm/src/fpm/manifest/package.f90 @@ -85,8 +85,8 @@ contains !> Error handling type(error_t), allocatable, intent(out) :: error - class(toml_table), pointer :: child, node - class(toml_array), pointer :: children + type(toml_table), pointer :: child, node + type(toml_array), pointer :: children integer :: ii, nn, stat call check(table, error) @@ -184,6 +184,7 @@ contains name_present = .true. case("version", "license", "author", "maintainer", "copyright", & + & "description", "keywords", "categories", "homepage", & & "dependencies", "dev-dependencies", "test", "executable", & & "library") continue diff --git a/fpm/src/fpm/manifest/test.f90 b/fpm/src/fpm/manifest/test.f90 index a6c6f64..de4c847 100644 --- a/fpm/src/fpm/manifest/test.f90 +++ b/fpm/src/fpm/manifest/test.f90 @@ -50,7 +50,7 @@ contains !> Error handling type(error_t), allocatable, intent(out) :: error - class(toml_table), pointer :: child + type(toml_table), pointer :: child call check(table, error) if (allocated(error)) return @@ -108,6 +108,7 @@ contains end select end do + if (allocated(error)) return if (.not.name_present) then call syntax_error(error, "Test name is not provided, please add a name entry") diff --git a/fpm/src/fpm/toml.f90 b/fpm/src/fpm/toml.f90 index 183278d..e2445c4 100644 --- a/fpm/src/fpm/toml.f90 +++ b/fpm/src/fpm/toml.f90 @@ -14,14 +14,13 @@ module fpm_toml use fpm_error, only : error_t, fatal_error, file_not_found_error use tomlf, only : toml_table, toml_array, toml_key, toml_stat, get_value, & - & toml_parse, toml_error - use tomlf_type, only : new_table, len + & set_value, toml_parse, toml_error, new_table, add_table, add_array, len implicit none private public :: read_package_file - public :: toml_table, toml_array, toml_key, toml_stat, get_value - public :: new_table, len + public :: toml_table, toml_array, toml_key, toml_stat, get_value, set_value + public :: new_table, add_table, add_array, len contains diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index d8bfd44..62fd242 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -4,9 +4,9 @@ module fpm_backend use fpm_environment, only: run use fpm_filesystem, only: basename, join_path, exists, mkdir -use fpm_model, only: fpm_model_t -use fpm_sources, only: srcfile_t, FPM_UNIT_MODULE, FPM_UNIT_SUBMODULE, & - FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM +use fpm_model, only: fpm_model_t, srcfile_t, FPM_UNIT_MODULE, & + FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & + FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM use fpm_strings, only: split implicit none diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 5e9daee..406b58e 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -1,8 +1,9 @@ module fpm_command_line - use fpm_environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS - + use fpm_environment, only: get_os_type, & + OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & + OS_CYGWIN, OS_SOLARIS, OS_FREEBSD implicit none - + private public :: fpm_cmd_settings, & fpm_build_settings, & @@ -10,7 +11,7 @@ module fpm_command_line fpm_new_settings, & fpm_run_settings, & fpm_test_settings, & - get_command_line_settings + get_command_line_settings type, abstract :: fpm_cmd_settings end type @@ -62,24 +63,40 @@ contains end subroutine subroutine print_help() - print *, "fpm - A Fortran package manager and build system" + print *, 'fpm - A Fortran package manager and build system' + select case (get_os_type()) + case (OS_UNKNOWN) + print *, 'OS Type: Unknown' + case (OS_LINUX) - print *, "OS Type: Linux" + print *, 'OS Type: Linux' + case (OS_MACOS) - print *, "OS Type: macOS" + print *, 'OS Type: macOS' + case (OS_WINDOWS) - print *, "OS Type: Windows" + print *, 'OS Type: Windows' + + case (OS_CYGWIN) + print *, 'OS Type: Cygwin' + + case (OS_SOLARIS) + print *, 'OS Type: Solaris' + + case (OS_FREEBSD) + print *, 'OS Type: FreeBSD' end select + print * - print *, "Usage:" - print *, " fpm [COMMAND]" + print *, 'Usage:' + print *, ' fpm [COMMAND]' print * - print *, "Valid fpm commands are:" - print *, " build Compile the current package" - print *, " install Install a Fortran binary or library (not implemented)" - print *, " new Create a new Fortran package (not implemented)" - print *, " run Run a binary of the local package (not implemented)" - print *, " test Run the tests (not implemented)" + print *, 'Valid fpm commands are:' + print *, ' build Compile the current package' + print *, ' install Install a Fortran binary or library (not implemented)' + print *, ' new Create a new Fortran package (not implemented)' + print *, ' run Run a binary of the local package (not implemented)' + print *, ' test Run the tests (not implemented)' end subroutine end module fpm_command_line diff --git a/fpm/src/fpm_environment.f90 b/fpm/src/fpm_environment.f90 index 9ac42ac..553aa8b 100644 --- a/fpm/src/fpm_environment.f90 +++ b/fpm/src/fpm_environment.f90 @@ -1,67 +1,117 @@ module fpm_environment implicit none private - public :: get_os_type, run - public :: OS_LINUX, OS_MACOS, OS_WINDOWS - - integer, parameter :: OS_LINUX = 1 - integer, parameter :: OS_MACOS = 2 - integer, parameter :: OS_WINDOWS = 3 + public :: get_os_type + public :: run + integer, parameter, public :: OS_UNKNOWN = 0 + integer, parameter, public :: OS_LINUX = 1 + integer, parameter, public :: OS_MACOS = 2 + integer, parameter, public :: OS_WINDOWS = 3 + integer, parameter, public :: OS_CYGWIN = 4 + integer, parameter, public :: OS_SOLARIS = 5 + integer, parameter, public :: OS_FREEBSD = 6 contains integer function get_os_type() result(r) - ! Determine the OS type - ! - ! Returns one of OS_LINUX, OS_MACOS, OS_WINDOWS. - ! - ! Currently we use the $HOME and $HOMEPATH environment variables to determine - ! the OS type. That is not 100% accurate in all cases, but it seems to be good - ! enough for now. See the following issue for a more robust solution: - ! - ! https://github.com/fortran-lang/fpm/issues/144 - ! - character(len=100) :: val - integer stat - ! Only Windows define $HOMEPATH by default and we test its value to improve the - ! chances of it working even if a user defines $HOMEPATH on Linux or macOS. - call get_environment_variable("HOMEPATH", val, status=stat) - if (stat == 0 .and. val(1:7) == "\Users\") then - r = OS_WINDOWS - return - end if - - ! We assume that $HOME=/home/... is Linux, $HOME=/Users/... is macOS, otherwise - ! we assume Linux. This is only a heuristic and can easily fail. - call get_environment_variable("HOME", val, status=stat) - if (stat == 1) then - print *, "$HOME does not exist" - error stop - end if - if (stat /= 0) then - print *, "get_environment_variable() failed" - error stop - end if - if (val(1:6) == "/home/") then - r = OS_LINUX - else if (val(1:7) == "/Users/") then - r = OS_MACOS - else - ! This will happen on HPC systems that typically do not use either /home nor - ! /Users for $HOME. Those systems are typically Linux, so for now we simply - ! set Linux here. - r = OS_LINUX - end if - end function + !! Determine the OS type + !! + !! Returns one of OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, OS_CYGWIN, + !! OS_SOLARIS, OS_FREEBSD. + !! + !! At first, the environment variable `OS` is checked, which is usually + !! found on Windows. Then, `OSTYPE` is read in and compared with common + !! names. If this fails too, check the existence of files that can be + !! found on specific system types only. + !! + !! Returns OS_UNKNOWN if the operating system cannot be determined. + character(len=32) :: val + integer :: length, rc + logical :: file_exists + + r = OS_UNKNOWN + + ! Check environment variable `OS`. + call get_environment_variable('OS', val, length, rc) + + if (rc == 0 .and. length > 0 .and. index(val, 'Windows_NT') > 0) then + r = OS_WINDOWS + return + end if + + ! Check environment variable `OSTYPE`. + call get_environment_variable('OSTYPE', val, length, rc) + + if (rc == 0 .and. length > 0) then + ! Linux + if (index(val, 'linux') > 0) then + r = OS_LINUX + return + end if + + ! macOS + if (index(val, 'darwin') > 0) then + r = OS_MACOS + return + end if + + ! Windows, MSYS, MinGW, Git Bash + if (index(val, 'win') > 0 .or. index(val, 'msys') > 0) then + r = OS_WINDOWS + return + end if + + ! Cygwin + if (index(val, 'cygwin') > 0) then + r = OS_CYGWIN + return + end if + + ! Solaris, OpenIndiana, ... + if (index(val, 'SunOS') > 0 .or. index(val, 'solaris') > 0) then + r = OS_SOLARIS + return + end if + + ! FreeBSD + if (index(val, 'FreeBSD') > 0 .or. index(val, 'freebsd') > 0) then + r = OS_FREEBSD + return + end if + end if + + ! Linux + inquire (file='/etc/os-release', exist=file_exists) + + if (file_exists) then + r = OS_LINUX + return + end if + + ! macOS + inquire (file='/usr/bin/sw_vers', exist=file_exists) + + if (file_exists) then + r = OS_MACOS + return + end if + + ! FreeBSD + inquire (file='/bin/freebsd-version', exist=file_exists) + + if (file_exists) then + r = OS_FREEBSD + return + end if + end function get_os_type subroutine run(cmd) character(len=*), intent(in) :: cmd integer :: stat - print *, "+ ", cmd + print *, '+ ', cmd call execute_command_line(cmd, exitstat=stat) if (stat /= 0) then - print *, "Command failed" + print *, 'Command failed' error stop end if end subroutine run - end module fpm_environment diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index d035e31..488a202 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -1,13 +1,14 @@ module fpm_filesystem -use fpm_environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS -use fpm_strings, only: f_string, string_t, split -implicit none + 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 + implicit none + private + public :: basename, join_path, number_of_rows, read_lines, list_files, & + mkdir, exists, get_temp_filename, windows_path -private -public :: basename, join_path, number_of_rows, read_lines, list_files,& - mkdir, exists, get_temp_filename, windows_path - -integer, parameter :: LINE_BUFFER_LEN = 1000 + integer, parameter :: LINE_BUFFER_LEN = 1000 contains @@ -34,7 +35,7 @@ function basename(path,suffix) result (base) else call split(path,file_parts,delimiters='\/.') base = trim(file_parts(size(file_parts)-1)) - end if + end if end function basename @@ -45,7 +46,7 @@ logical function is_dir(dir) select case (get_os_type()) - case (OS_LINUX,OS_MACOS) + case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD) call execute_command_line("test -d " // dir , exitstat=stat) case (OS_WINDOWS) @@ -59,19 +60,18 @@ end function is_dir function join_path(a1,a2,a3,a4,a5) result(path) - ! Construct path by joining strings with os file separator + ! Construct path by joining strings with os file separator ! - character(*), intent(in) :: a1, a2 - character(*), intent(in), optional :: a3,a4,a5 - character(:), allocatable :: path - - character(1) :: filesep + character(len=*), intent(in) :: a1, a2 + character(len=*), intent(in), optional :: a3, a4, a5 + character(len=:), allocatable :: path + character(len=1) :: filesep select case (get_os_type()) - case (OS_LINUX,OS_MACOS) - filesep = '/' - case (OS_WINDOWS) - filesep = '\' + case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD) + filesep = '/' + case (OS_WINDOWS) + filesep = '\' end select path = a1 // filesep // a2 @@ -129,23 +129,23 @@ function read_lines(fh) result(lines) end function read_lines subroutine mkdir(dir) - character(*), intent(in) :: dir - - integer :: stat + character(len=*), intent(in) :: dir + integer :: stat select case (get_os_type()) - case (OS_LINUX,OS_MACOS) - call execute_command_line("mkdir -p " // dir , exitstat=stat) - write(*,*) "mkdir -p " // dir - case (OS_WINDOWS) - call execute_command_line("mkdir " // windows_path(dir), exitstat=stat) - write(*,*) "mkdir " // windows_path(dir) + case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD) + call execute_command_line('mkdir -p ' // dir, exitstat=stat) + write (*, '(2a)') 'mkdir -p ' // dir + + case (OS_WINDOWS) + call execute_command_line("mkdir " // windows_path(dir), exitstat=stat) + write (*, '(2a)') 'mkdir ' // windows_path(dir) end select + if (stat /= 0) then - print *, "execute_command_line() failed" + print *, 'execute_command_line() failed' error stop end if - end subroutine mkdir @@ -161,29 +161,27 @@ recursive subroutine list_files(dir, files, recurse) ! Using `inquire` / exists on directories works with gfortran, but not ifort if (.not. exists(dir)) then - allocate(files(0)) + allocate (files(0)) return end if - allocate(temp_file, source = get_temp_filename() ) + allocate (temp_file, source=get_temp_filename()) select case (get_os_type()) - case (OS_LINUX) - call execute_command_line("ls " // dir // " > "//temp_file, & - exitstat=stat) - case (OS_MACOS) - call execute_command_line("ls " // dir // " > "//temp_file, & + case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD) + call execute_command_line('ls ' // dir // ' > ' // temp_file, & exitstat=stat) case (OS_WINDOWS) - call execute_command_line("dir /b " // windows_path(dir) // " > "//temp_file, & + call execute_command_line('dir /b ' // windows_path(dir) // ' > ' // temp_file, & exitstat=stat) end select + if (stat /= 0) then - print *, "execute_command_line() failed" + print *, 'execute_command_line() failed' error stop end if - open(newunit=fh, file=temp_file, status="old") + open (newunit=fh, file=temp_file, status='old') files = read_lines(fh) close(fh,status="delete") @@ -263,11 +261,15 @@ function windows_path(path) result(winpath) ! character(*), intent(in) :: path character(:), allocatable :: winpath - + + integer :: idx + winpath = path - do while(index(winpath,'/') > 0) - winpath(index(winpath,'/'):index(winpath,'/')) = '\' + idx = index(winpath,'/') + do while(idx > 0) + winpath(idx:idx) = '\' + idx = index(winpath,'/') end do end function windows_path diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 0387dfb..702ba6f 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -1,19 +1,51 @@ module fpm_model - ! Definition and validation of the backend model - -use fpm_command_line, only: fpm_build_settings -use fpm_filesystem, only: exists, join_path -use fpm_manifest, only: package_t, default_library, default_executable -use fpm_manifest_executable, only: executable_t -use fpm_sources, only: resolve_module_dependencies, add_sources_from_dir, & - add_executable_sources, srcfile_t use fpm_strings, only: string_t - implicit none private -public :: build_model, fpm_model_t +public :: srcfile_ptr, srcfile_t, fpm_model_t + +public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & + FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & + FPM_UNIT_CHEADER + +integer, parameter :: FPM_UNIT_UNKNOWN = -1 +integer, parameter :: FPM_UNIT_PROGRAM = 1 +integer, parameter :: FPM_UNIT_MODULE = 2 +integer, parameter :: FPM_UNIT_SUBMODULE = 3 +integer, parameter :: FPM_UNIT_SUBPROGRAM = 4 +integer, parameter :: FPM_UNIT_CSOURCE = 5 +integer, parameter :: FPM_UNIT_CHEADER = 6 + +type srcfile_ptr + ! For constructing arrays of src_file pointers + type(srcfile_t), pointer :: ptr => null() +end type srcfile_ptr + +type srcfile_t + ! Type for encapsulating a source file + ! and it's metadata + character(:), allocatable :: file_name + ! File path relative to cwd + character(:), allocatable :: exe_name + ! Name of executable for FPM_UNIT_PROGRAM + logical :: is_test = .false. + ! Is executable a test? + type(string_t), allocatable :: modules_provided(:) + ! Modules provided by this source file (lowerstring) + integer :: unit_type = FPM_UNIT_UNKNOWN + ! Type of program unit + type(string_t), allocatable :: modules_used(:) + ! Modules USEd by this source file (lowerstring) + type(string_t), allocatable :: include_dependencies(:) + ! Files INCLUDEd by this source file + type(srcfile_ptr), allocatable :: file_dependencies(:) + ! Resolved source file dependencies + + logical :: built = .false. + logical :: touched = .false. +end type srcfile_t type :: fpm_model_t character(:), allocatable :: package_name @@ -30,39 +62,4 @@ type :: fpm_model_t ! Base directory for build end type fpm_model_t -contains - -subroutine build_model(model, settings, package) - ! Constructs a valid fpm model from command line settings and toml manifest - ! - type(fpm_model_t), intent(out) :: model - type(fpm_build_settings), intent(in) :: settings - type(package_t), intent(in) :: package - - model%package_name = package%name - - ! #TODO: Choose flags and output directory based on cli settings & manifest inputs - model%fortran_compiler = 'gfortran' - model%output_directory = 'build/gfortran_debug' - model%fortran_compile_flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g '// & - '-fbounds-check -fcheck-array-temporaries -fbacktrace '// & - '-J'//join_path(model%output_directory,model%package_name) - model%link_flags = '' - - ! Add sources from executable directories - if (allocated(package%executable)) then - call add_executable_sources(model%sources, package%executable,is_test=.false.) - end if - if (allocated(package%test)) then - call add_executable_sources(model%sources, package%test,is_test=.true.) - end if - - if (allocated(package%library)) then - call add_sources_from_dir(model%sources,package%library%source_dir) - end if - - call resolve_module_dependencies(model%sources) - -end subroutine build_model - end module fpm_model diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index fb02758..a9e9bd6 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -1,66 +1,34 @@ module fpm_sources +use fpm_error, only: error_t, file_parse_error +use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t, & + FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & + FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & + FPM_UNIT_CSOURCE, FPM_UNIT_CHEADER use fpm_filesystem, only: basename, read_lines, list_files -use fpm_strings, only: lower, split, str_ends_with, string_t +use fpm_strings, only: lower, split, str_ends_with, string_t, operator(.in.) use fpm_manifest_executable, only: executable_t implicit none private -public :: srcfile_ptr, srcfile_t -public :: add_sources_from_dir, add_executable_sources, resolve_module_dependencies -public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & - FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & - FPM_UNIT_CHEADER - -integer, parameter :: FPM_UNIT_UNKNOWN = -1 -integer, parameter :: FPM_UNIT_PROGRAM = 1 -integer, parameter :: FPM_UNIT_MODULE = 2 -integer, parameter :: FPM_UNIT_SUBMODULE = 3 -integer, parameter :: FPM_UNIT_SUBPROGRAM = 4 -integer, parameter :: FPM_UNIT_CSOURCE = 5 -integer, parameter :: FPM_UNIT_CHEADER = 6 +public :: add_sources_from_dir, add_executable_sources +public :: parse_f_source, parse_c_source, resolve_module_dependencies character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & ['iso_c_binding ', & - 'iso_fortran_env'] - -type srcfile_ptr - ! For constructing arrays of src_file pointers - type(srcfile_t), pointer :: ptr => null() -end type srcfile_ptr - -type srcfile_t - ! Type for encapsulating a source file - ! and it's metadata - character(:), allocatable :: file_name - ! File path relative to cwd - character(:), allocatable :: exe_name - ! Name of executable for FPM_UNIT_PROGRAM - logical :: is_test = .false. - ! Is executable a test? - type(string_t), allocatable :: modules_provided(:) - ! Modules provided by this source file (lowerstring) - integer :: unit_type = FPM_UNIT_UNKNOWN - ! Type of program unit - type(string_t), allocatable :: modules_used(:) - ! Modules USEd by this source file (lowerstring) - type(string_t), allocatable :: include_dependencies(:) - ! Files INCLUDEd by this source file - type(srcfile_ptr), allocatable :: file_dependencies(:) - ! Resolved source file dependencies - - logical :: built = .false. - logical :: touched = .false. -end type srcfile_t - + 'iso_fortran_env', & + 'ieee_arithmetic', & + 'ieee_exceptions', & + 'ieee_features '] contains -subroutine add_sources_from_dir(sources,directory,with_executables) +subroutine add_sources_from_dir(sources,directory,with_executables,error) ! Enumerate sources in a directory ! type(srcfile_t), allocatable, intent(inout), target :: sources(:) character(*), intent(in) :: directory logical, intent(in), optional :: with_executables + type(error_t), allocatable, intent(out) :: error integer :: i, j logical, allocatable :: is_source(:), exclude_source(:) @@ -82,18 +50,30 @@ subroutine add_sources_from_dir(sources,directory,with_executables) do i = 1, size(src_file_names) if (str_ends_with(lower(src_file_names(i)%s), ".f90")) then - dir_sources(i) = parse_f_source(src_file_names(i)%s) + + dir_sources(i) = parse_f_source(src_file_names(i)%s, error) + + if (allocated(error)) then + return + end if + end if if (str_ends_with(lower(src_file_names(i)%s), ".c") .or. & str_ends_with(lower(src_file_names(i)%s), ".h")) then - dir_sources(i) = parse_c_source(src_file_names(i)%s) + + dir_sources(i) = parse_c_source(src_file_names(i)%s,error) + + if (allocated(error)) then + return + end if + end if ! Exclude executables unless specified otherwise exclude_source(i) = (dir_sources(i)%unit_type == FPM_UNIT_PROGRAM) if (dir_sources(i)%unit_type == FPM_UNIT_PROGRAM .and. & - present(with_executables)) then + & present(with_executables)) then if (with_executables) then exclude_source(i) = .false. @@ -113,13 +93,14 @@ subroutine add_sources_from_dir(sources,directory,with_executables) end subroutine add_sources_from_dir -subroutine add_executable_sources(sources,executables,is_test) +subroutine add_executable_sources(sources,executables,is_test,error) ! Add sources from executable directories specified in manifest ! Only allow executables that are explicitly specified in manifest ! type(srcfile_t), allocatable, intent(inout), target :: sources(:) - class(executable_t), intent(in), optional :: executables(:) + class(executable_t), intent(in) :: executables(:) logical, intent(in) :: is_test + type(error_t), allocatable, intent(out) :: error integer :: i, j @@ -130,8 +111,14 @@ subroutine add_executable_sources(sources,executables,is_test) call get_executable_source_dirs(exe_dirs,executables) do i=1,size(exe_dirs) + call add_sources_from_dir(dir_sources,exe_dirs(i)%s, & - with_executables=.true.) + with_executables=.true.,error=error) + + if (allocated(error)) then + return + end if + end do allocate(exclude_source(size(dir_sources))) @@ -170,12 +157,11 @@ subroutine get_executable_source_dirs(exe_dirs,executables) type(string_t) :: dirs_temp(size(executables)) - integer :: i, j, n + integer :: i, n n = 0 do i=1,size(executables) - if (.not.any([(dirs_temp(j)%s==executables(i)%source_dir, & - j=1,n)])) then + if (.not.(executables(i)%source_dir .in. dirs_temp)) then n = n + 1 dirs_temp(n)%s = executables(i)%source_dir @@ -192,16 +178,17 @@ subroutine get_executable_source_dirs(exe_dirs,executables) end subroutine get_executable_source_dirs -function parse_f_source(f_filename) result(f_source) +function parse_f_source(f_filename,error) result(f_source) ! Rudimentary scan of Fortran source file and ! extract program unit name and use/include dependencies ! character(*), intent(in) :: f_filename type(srcfile_t) :: f_source + type(error_t), allocatable, intent(out) :: error + integer :: stat integer :: fh, n_use, n_include, n_mod, i, j, ic, pass type(string_t), allocatable :: file_lines(:) - character(:), allocatable :: line_parts(:) character(:), allocatable :: temp_string, mod_name f_source%file_name = f_filename @@ -234,16 +221,34 @@ function parse_f_source(f_filename) result(f_source) if (index(file_lines(i)%s,'::') > 0) then - call split(file_lines(i)%s,line_parts,delimiters=':') - temp_string = line_parts(2) - call split(temp_string,line_parts,delimiters=' ,') - mod_name = trim(lower(line_parts(1))) + temp_string = split_n(file_lines(i)%s,delims=':',n=2,stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find used module name',i, & + file_lines(i)%s,index(file_lines(i)%s,'::')) + return + end if + + mod_name = split_n(temp_string,delims=' ,',n=1,stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find used module name',i, & + file_lines(i)%s) + return + end if + mod_name = lower(mod_name) else - call split(file_lines(i)%s,line_parts,delimiters=' ,') - mod_name = trim(lower(line_parts(2))) - + mod_name = split_n(file_lines(i)%s,n=2,delims=' ,',stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find used module name',i, & + file_lines(i)%s) + return + end if + mod_name = lower(mod_name) + end if if (.not.validate_name(mod_name)) then @@ -271,8 +276,14 @@ function parse_f_source(f_filename) result(f_source) n_include = n_include + 1 if (pass == 2) then - call split(file_lines(i)%s,line_parts,delimiters="'"//'"') - f_source%include_dependencies(n_include)%s = line_parts(2) + f_source%include_dependencies(n_include)%s = & + & split_n(file_lines(i)%s,n=2,delims="'"//'"',stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find include file name',i, & + file_lines(i)%s) + return + end if end if end if @@ -280,12 +291,26 @@ function parse_f_source(f_filename) result(f_source) ! Extract name of module if is module if (index(adjustl(lower(file_lines(i)%s)),'module ') == 1) then - call split(file_lines(i)%s,line_parts,delimiters=' ') + mod_name = lower(split_n(file_lines(i)%s,n=2,delims=' ',stat=stat)) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find module name',i, & + file_lines(i)%s) + return + end if - mod_name = adjustl(trim(lower(line_parts(2)))) + if (mod_name == 'procedure' .or. & + mod_name == 'subroutine' .or. & + mod_name == 'function') then + ! Ignore these cases + cycle + end if if (.not.validate_name(mod_name)) then - cycle + call file_parse_error(error,f_filename, & + 'empty or invalid name for module',i, & + file_lines(i)%s) + return end if n_mod = n_mod + 1 @@ -301,7 +326,13 @@ function parse_f_source(f_filename) result(f_source) ! Extract name of submodule if is submodule if (index(adjustl(lower(file_lines(i)%s)),'submodule') == 1) then - call split(file_lines(i)%s,line_parts,delimiters=' ()') + temp_string = split_n(file_lines(i)%s,n=2,delims='()',stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to get submodule ancestry',i, & + file_lines(i)%s) + return + end if f_source%unit_type = FPM_UNIT_SUBMODULE @@ -309,24 +340,29 @@ function parse_f_source(f_filename) result(f_source) if (pass == 2) then - if (index(line_parts(2),':') > 0) then - - line_parts(2) = line_parts(2)(index(line_parts(2),':')+1:) + if (index(temp_string,':') > 0) then + temp_string = temp_string(index(temp_string,':')+1:) + end if - f_source%modules_used(n_use)%s = adjustl(trim(lower(line_parts(2)))) + f_source%modules_used(n_use)%s = lower(temp_string) + + if (.not.validate_name(temp_string)) then + call file_parse_error(error,f_filename, & + 'empty or invalid name for submodule parent',i, & + file_lines(i)%s, index(file_lines(i)%s,temp_string)) + return + end if end if end if - ! Extract name of program if is program + ! Detect if is program if (f_source%unit_type == FPM_UNIT_UNKNOWN .and. & index(adjustl(lower(file_lines(i)%s)),'program') == 1) then - call split(file_lines(i)%s,line_parts,delimiters=' ') - f_source%unit_type = FPM_UNIT_PROGRAM end if @@ -354,10 +390,7 @@ function parse_f_source(f_filename) result(f_source) integer :: i - if (trim(lower(name)) == 'procedure' .or. & - trim(lower(name)) == 'subroutine' .or. & - trim(lower(name)) == 'function') then - + if (len_trim(name) < 1) then valid = .false. return end if @@ -390,16 +423,16 @@ function parse_f_source(f_filename) result(f_source) end function parse_f_source -function parse_c_source(c_filename) result(c_source) +function parse_c_source(c_filename,error) result(c_source) ! Rudimentary scan of c source file and ! extract include dependencies ! character(*), intent(in) :: c_filename type(srcfile_t) :: c_source + type(error_t), allocatable, intent(out) :: error - integer :: fh, n_include, i, pass + integer :: fh, n_include, i, pass, stat type(string_t), allocatable :: file_lines(:) - character(:), allocatable :: line_parts(:) c_source%file_name = c_filename @@ -431,8 +464,16 @@ function parse_c_source(c_filename) result(c_source) n_include = n_include + 1 if (pass == 2) then - call split(file_lines(i)%s,line_parts,delimiters='"') - c_source%include_dependencies(n_include)%s = line_parts(2) + + c_source%include_dependencies(n_include)%s = & + & split_n(file_lines(i)%s,n=2,delims='"',stat=stat) + if (stat /= 0) then + call file_parse_error(error,c_filename, & + 'unable to get c include file',i, & + file_lines(i)%s,index(file_lines(i)%s,'"')) + return + end if + end if end if @@ -448,6 +489,48 @@ function parse_c_source(c_filename) result(c_source) end function parse_c_source +function split_n(string,delims,n,stat) result(substring) + ! Split a string on one or more delimeters + ! and return the nth substring if it exists + ! + ! n=0 will return the last item + ! n=-1 will return the penultimate item etc. + ! + ! stat = 1 on return if the index + ! is not found + ! + character(*), intent(in) :: string + character(*), intent(in) :: delims + integer, intent(in) :: n + integer, intent(out) :: stat + character(:), allocatable :: substring + + integer :: i + character(:), allocatable :: string_parts(:) + + call split(string,string_parts,delims) + + if (n<1) then + i = size(string_parts) + n + if (i < 1) then + stat = 1 + return + end if + else + i = n + end if + + if (i>size(string_parts)) then + stat = 1 + return + end if + + substring = trim(string_parts(i)) + stat = 0 + +end function split_n + + subroutine resolve_module_dependencies(sources) ! After enumerating all source files: resolve file dependencies ! by searching on module names diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index dd18f09..a6511c9 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -3,11 +3,16 @@ implicit none private public :: f_string, lower, split, str_ends_with, string_t +public :: string_array_contains, operator(.in.) type string_t character(len=:), allocatable :: s end type +interface operator(.in.) + module procedure string_array_contains +end interface + contains logical function str_ends_with(s, e) result(r) @@ -76,6 +81,20 @@ elemental pure function lower(str,begin,end) result (string) end function lower +logical function string_array_contains(search_string,array) + ! Check if array of string_t contains a particular string + ! + character(*), intent(in) :: search_string + type(string_t), intent(in) :: array(:) + + integer :: i + + string_array_contains = any([(array(i)%s==search_string, & + i=1,size(array))]) + +end function string_array_contains + + subroutine split(input_line,array,delimiters,order,nulls) ! parse string on delimiter characters and store tokens into an allocatable array" ! Author: John S. Urban diff --git a/fpm/test/main.f90 b/fpm/test/main.f90 index 19bcdb6..f9d0941 100644 --- a/fpm/test/main.f90 +++ b/fpm/test/main.f90 @@ -4,6 +4,7 @@ program fpm_testing use testsuite, only : run_testsuite use test_toml, only : collect_toml use test_manifest, only : collect_manifest + use test_source_parsing, only : collect_source_parsing implicit none integer :: stat character(len=*), parameter :: fmt = '("#", *(1x, a))' @@ -24,4 +25,12 @@ program fpm_testing error stop 1 end if + write(error_unit, fmt) "Testing:", "fpm_sources (parsing)" + call run_testsuite(collect_source_parsing, error_unit, stat) + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "tests failed!" + error stop 1 + end if + end program fpm_testing diff --git a/fpm/test/test_manifest.f90 b/fpm/test/test_manifest.f90 index 223b346..d2dc891 100644 --- a/fpm/test/test_manifest.f90 +++ b/fpm/test/test_manifest.f90 @@ -1,6 +1,7 @@ !> Define tests for the `fpm_manifest` modules module test_manifest - use testsuite, only : new_unittest, unittest_t, error_t, test_failed + use testsuite, only : new_unittest, unittest_t, error_t, test_failed, & + & check_string use fpm_manifest implicit none private @@ -23,11 +24,30 @@ contains & new_unittest("default-library", test_default_library), & & new_unittest("default-executable", test_default_executable), & & new_unittest("dependency-empty", test_dependency_empty, should_fail=.true.), & + & new_unittest("dependency-pathtag", test_dependency_pathtag, should_fail=.true.), & + & new_unittest("dependency-gitpath", test_dependency_gitpath, should_fail=.true.), & + & new_unittest("dependency-nourl", test_dependency_nourl, should_fail=.true.), & + & new_unittest("dependency-gitconflict", test_dependency_gitconflict, should_fail=.true.), & + & new_unittest("dependency-wrongkey", test_dependency_wrongkey, should_fail=.true.), & & new_unittest("dependencies-empty", test_dependencies_empty), & + & new_unittest("dependencies-typeerror", test_dependencies_typeerror, should_fail=.true.), & & new_unittest("executable-empty", test_executable_empty, should_fail=.true.), & + & new_unittest("executable-typeerror", test_executable_typeerror, should_fail=.true.), & + & new_unittest("executable-noname", test_executable_noname, should_fail=.true.), & + & new_unittest("executable-wrongkey", test_executable_wrongkey, should_fail=.true.), & & new_unittest("library-empty", test_library_empty), & + & new_unittest("library-wrongkey", test_library_wrongkey, should_fail=.true.), & + & new_unittest("package-simple", test_package_simple), & & new_unittest("package-empty", test_package_empty, should_fail=.true.), & - & new_unittest("test-empty", test_test_empty, should_fail=.true.)] + & new_unittest("package-typeerror", test_package_typeerror, should_fail=.true.), & + & new_unittest("package-noname", test_package_noname, should_fail=.true.), & + & new_unittest("package-wrongexe", test_package_wrongexe, should_fail=.true.), & + & new_unittest("package-wrongtest", test_package_wrongtest, should_fail=.true.), & + & new_unittest("test-simple", test_test_simple), & + & new_unittest("test-empty", test_test_empty, should_fail=.true.), & + & new_unittest("test-typeerror", test_test_typeerror, should_fail=.true.), & + & new_unittest("test-noname", test_test_noname, should_fail=.true.), & + & new_unittest("test-wrongkey", test_test_wrongkey, should_fail=.true.)] end subroutine collect_manifest @@ -143,16 +163,9 @@ contains allocate(package%library) call default_library(package%library) - if (.not.allocated(package%library%source_dir)) then - call test_failed(error, "Default library source-dir is not set") - return - end if - - if (package%library%source_dir /= "src") then - call test_failed(error, "Default library source-dir is "// & - & package%library%source_dir//" but should be src") - return - end if + call check_string(error, package%library%source_dir, "src", & + & "Default library source-dir") + if (allocated(error)) return end subroutine test_default_library @@ -169,22 +182,13 @@ contains allocate(package%executable(1)) call default_executable(package%executable(1), name) - if (.not.allocated(package%executable(1)%source_dir)) then - call test_failed(error, "Default executable source-dir is not set") - return - end if - - if (package%executable(1)%source_dir /= "app") then - call test_failed(error, "Default executable source-dir is "// & - & package%executable(1)%source_dir//" but should be app") - return - end if + call check_string(error, package%executable(1)%source_dir, "app", & + & "Default executable source-dir") + if (allocated(error)) return - if (package%executable(1)%name /= name) then - call test_failed(error, "Default executable name is "// & - & package%executable(1)%name//" but should be "//name) - return - end if + call check_string(error, package%executable(1)%name, name, & + & "Default executable name") + if (allocated(error)) return end subroutine test_default_executable @@ -208,6 +212,115 @@ contains end subroutine test_dependency_empty + !> Try to create a dependency with conflicting entries + subroutine test_dependency_pathtag(error) + use fpm_manifest_dependency + use fpm_toml, only : new_table, toml_table, set_value + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + integer :: stat + type(dependency_t) :: dependency + + call new_table(table) + table%key = 'example' + call set_value(table, 'path', '"package"', stat) + call set_value(table, 'tag', '"v20.1"', stat) + + call new_dependency(dependency, table, error) + + end subroutine test_dependency_pathtag + + + !> Try to create a dependency with conflicting entries + subroutine test_dependency_nourl(error) + use fpm_manifest_dependency + use fpm_toml, only : new_table, toml_table, set_value + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + integer :: stat + type(dependency_t) :: dependency + + call new_table(table) + table%key = 'example' + call set_value(table, 'tag', '"v20.1"', stat) + + call new_dependency(dependency, table, error) + + end subroutine test_dependency_nourl + + + !> Try to create a dependency with conflicting entries + subroutine test_dependency_gitpath(error) + use fpm_manifest_dependency + use fpm_toml, only : new_table, toml_table, set_value + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + integer :: stat + type(dependency_t) :: dependency + + call new_table(table) + table%key = 'example' + call set_value(table, 'path', '"package"', stat) + call set_value(table, 'git', '"https://gitea.com/fortran-lang/pack"', stat) + + call new_dependency(dependency, table, error) + + end subroutine test_dependency_gitpath + + + !> Try to create a dependency with conflicting entries + subroutine test_dependency_gitconflict(error) + use fpm_manifest_dependency + use fpm_toml, only : new_table, toml_table, set_value + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + integer :: stat + type(dependency_t) :: dependency + + call new_table(table) + table%key = 'example' + call set_value(table, 'git', '"https://gitea.com/fortran-lang/pack"', stat) + call set_value(table, 'branch', '"latest"', stat) + call set_value(table, 'tag', '"v20.1"', stat) + + call new_dependency(dependency, table, error) + + end subroutine test_dependency_gitconflict + + + !> Try to create a dependency with conflicting entries + subroutine test_dependency_wrongkey(error) + use fpm_manifest_dependency + use fpm_toml, only : new_table, toml_table, set_value + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + integer :: stat + type(dependency_t) :: dependency + + call new_table(table) + table%key = 'example' + call set_value(table, 'not-available', '"anywhere"', stat) + + call new_dependency(dependency, table, error) + + end subroutine test_dependency_wrongkey + + !> Dependency tables can be empty subroutine test_dependencies_empty(error) use fpm_manifest_dependency @@ -231,6 +344,27 @@ contains end subroutine test_dependencies_empty + !> Add a dependency as an array, which is not supported + subroutine test_dependencies_typeerror(error) + use fpm_manifest_dependency + use fpm_toml, only : new_table, add_array, toml_table, toml_array + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_array), pointer :: children + integer :: stat + type(dependency_t), allocatable :: dependencies(:) + + call new_table(table) + call add_array(table, 'dep1', children, stat) + + call new_dependencies(dependencies, table, error) + + end subroutine test_dependencies_typeerror + + !> Executables cannot be created from empty tables subroutine test_executable_empty(error) use fpm_manifest_executable @@ -249,6 +383,69 @@ contains end subroutine test_executable_empty + !> Pass a wrong TOML type to the name field of the executable + subroutine test_executable_typeerror(error) + use fpm_manifest_executable + use fpm_toml, only : new_table, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(executable_t) :: executable + + call new_table(table) + call add_table(table, 'name', child, stat) + + call new_executable(executable, table, error) + + end subroutine test_executable_typeerror + + + !> Pass a TOML table with insufficient entries to the executable constructor + subroutine test_executable_noname(error) + use fpm_manifest_executable + use fpm_toml, only : new_table, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(executable_t) :: executable + + call new_table(table) + call add_table(table, 'dependencies', child, stat) + + call new_executable(executable, table, error) + + end subroutine test_executable_noname + + + !> Pass a TOML table with not allowed keys + subroutine test_executable_wrongkey(error) + use fpm_manifest_executable + use fpm_toml, only : new_table, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(executable_t) :: executable + + call new_table(table) + call add_table(table, 'wrong-field', child, stat) + + call new_executable(executable, table, error) + + end subroutine test_executable_wrongkey + + !> Libraries can be created from empty tables subroutine test_library_empty(error) use fpm_manifest_library @@ -265,20 +462,73 @@ contains call new_library(library, table, error) if (allocated(error)) return - if (.not.allocated(library%source_dir)) then - call test_failed(error, "Default library source-dir is not set") - return - end if - - if (library%source_dir /= "src") then - call test_failed(error, "Default library source-dir is "// & - & library%source_dir//" but should be src") - return - end if + call check_string(error, library%source_dir, "src", & + & "Default library source-dir") + if (allocated(error)) return end subroutine test_library_empty + !> Pass a TOML table with not allowed keys + subroutine test_library_wrongkey(error) + use fpm_manifest_library + use fpm_toml, only : new_table, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(library_t) :: library + + call new_table(table) + call add_table(table, 'not-allowed', child, stat) + + call new_library(library, table, error) + + end subroutine test_library_wrongkey + + + !> Packages cannot be created from empty tables + subroutine test_package_simple(error) + use fpm_manifest_package + use fpm_toml, only : new_table, add_table, add_array, set_value, & + & toml_table, toml_array + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child, child2 + type(toml_array), pointer :: children + integer :: stat + type(package_t) :: package + + call new_table(table) + call set_value(table, 'name', '"example"', stat) + call set_value(table, 'license', '"MIT"', stat) + call add_table(table, 'dev-dependencies', child, stat) + call add_table(child, 'pkg1', child2, stat) + call set_value(child2, 'git', '"https://github.com/fortran-lang/pkg1"', stat) + call add_table(child, 'pkg2', child2) + call set_value(child2, 'git', '"https://gitlab.com/fortran-lang/pkg2"', stat) + call set_value(child2, 'branch', '"devel"', stat) + call add_table(child, 'pkg3', child2) + call set_value(child2, 'git', '"https://bitbucket.org/fortran-lang/pkg3"', stat) + call set_value(child2, 'rev', '"9fceb02d0ae598e95dc970b74767f19372d61af8"', stat) + call add_table(child, 'pkg4', child2) + call set_value(child2, 'git', '"https://gitea.com/fortran-lang/pkg4"', stat) + call set_value(child2, 'tag', '"v1.8.5-rc3"', stat) + call add_array(table, 'test', children, stat) + call add_table(children, child, stat) + call set_value(child, 'name', '"tester"', stat) + + call new_package(package, table, error) + + end subroutine test_package_simple + + !> Packages cannot be created from empty tables subroutine test_package_empty(error) use fpm_manifest_package @@ -297,6 +547,124 @@ contains end subroutine test_package_empty + !> Create an array in the package name, which should cause an error + subroutine test_package_typeerror(error) + use fpm_manifest_package + use fpm_toml, only : new_table, add_array, toml_table, toml_array + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_array), pointer :: child + integer :: stat + type(package_t) :: package + + call new_table(table) + call add_array(table, "name", child, stat) + + call new_package(package, table, error) + + end subroutine test_package_typeerror + + + !> Try to create a new package without a name field + subroutine test_package_noname(error) + use fpm_manifest_package + use fpm_toml, only : new_table, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(package_t) :: package + + call new_table(table) + call add_table(table, "library", child, stat) + call add_table(table, "dev-dependencies", child, stat) + call add_table(table, "dependencies", child, stat) + + call new_package(package, table, error) + + end subroutine test_package_noname + + + !> Try to read executables from a mixed type array + subroutine test_package_wrongexe(error) + use fpm_manifest_package + use fpm_toml, only : new_table, set_value, add_array, toml_table, toml_array + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_array), pointer :: children, children2 + integer :: stat + type(package_t) :: package + + call new_table(table) + call set_value(table, 'name', '"example"', stat) + call add_array(table, 'executable', children, stat) + call add_array(children, children2, stat) + + call new_package(package, table, error) + + end subroutine test_package_wrongexe + + + !> Try to read tests from a mixed type array + subroutine test_package_wrongtest(error) + use fpm_manifest_package + use fpm_toml, only : new_table, set_value, add_array, toml_table, toml_array + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_array), pointer :: children, children2 + integer :: stat + type(package_t) :: package + + call new_table(table) + call set_value(table, 'name', '"example"', stat) + call add_array(table, 'test', children, stat) + call add_array(children, children2, stat) + + call new_package(package, table, error) + + end subroutine test_package_wrongtest + + + !> Tests cannot be created from empty tables + subroutine test_test_simple(error) + use fpm_manifest_test + use fpm_toml, only : new_table, set_value, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(test_t) :: test + + call new_table(table) + call set_value(table, 'name', '"example"', stat) + call set_value(table, 'source-dir', '"tests"', stat) + call set_value(table, 'main', '"tester.f90"', stat) + call add_table(table, 'dependencies', child, stat) + + call new_test(test, table, error) + if (allocated(error)) return + + call check_string(error, test%main, "tester.f90", "Test main") + if (allocated(error)) return + + end subroutine test_test_simple + + !> Tests cannot be created from empty tables subroutine test_test_empty(error) use fpm_manifest_test @@ -315,4 +683,67 @@ contains end subroutine test_test_empty + !> Pass a wrong TOML type to the name field of the test + subroutine test_test_typeerror(error) + use fpm_manifest_test + use fpm_toml, only : new_table, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(test_t) :: test + + call new_table(table) + call add_table(table, 'name', child, stat) + + call new_test(test, table, error) + + end subroutine test_test_typeerror + + + !> Pass a TOML table with insufficient entries to the test constructor + subroutine test_test_noname(error) + use fpm_manifest_test + use fpm_toml, only : new_table, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(test_t) :: test + + call new_table(table) + call add_table(table, 'dependencies', child, stat) + + call new_test(test, table, error) + + end subroutine test_test_noname + + + !> Pass a TOML table with not allowed keys + subroutine test_test_wrongkey(error) + use fpm_manifest_test + use fpm_toml, only : new_table, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(test_t) :: test + + call new_table(table) + call add_table(table, 'not-supported', child, stat) + + call new_test(test, table, error) + + end subroutine test_test_wrongkey + + end module test_manifest diff --git a/fpm/test/test_source_parsing.f90 b/fpm/test/test_source_parsing.f90 new file mode 100644 index 0000000..c55a206 --- /dev/null +++ b/fpm/test/test_source_parsing.f90 @@ -0,0 +1,621 @@ +!> Define tests for the `fpm_sources` module (parsing routines) +module test_source_parsing + use testsuite, only : new_unittest, unittest_t, error_t, test_failed + use fpm_filesystem, only: get_temp_filename + use fpm_sources, only: parse_f_source, parse_c_source + use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & + FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE + use fpm_strings, only: operator(.in.) + implicit none + private + + public :: collect_source_parsing + +contains + + + !> Collect all exported unit tests + subroutine collect_source_parsing(testsuite) + + !> Collection of tests + type(unittest_t), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + & new_unittest("modules-used", test_modules_used), & + & new_unittest("intrinsic-modules-used", test_intrinsic_modules_used), & + & new_unittest("include-stmt", test_include_stmt), & + & new_unittest("module", test_module), & + & new_unittest("submodule", test_submodule), & + & new_unittest("submodule-ancestor", test_submodule_ancestor), & + & new_unittest("subprogram", test_subprogram), & + & new_unittest("csource", test_csource), & + & new_unittest("invalid-use-stmt", & + test_invalid_use_stmt, should_fail=.true.), & + & new_unittest("invalid-include-stmt", & + test_invalid_include_stmt, should_fail=.true.), & + & new_unittest("invalid-module", & + test_invalid_module, should_fail=.true.), & + & new_unittest("invalid-submodule", & + test_invalid_submodule, should_fail=.true.) & + ] + + end subroutine collect_source_parsing + + + !> Check parsing of module 'USE' statements + subroutine test_modules_used(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'program test', & + & ' use module_one', & + & ' use :: module_two', & + & ' use module_three, only: a, b, c', & + & ' use :: module_four, only: a => b', & + & '! use module_not_used', & + & ' implicit none', & + & 'end program test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (f_source%unit_type /= FPM_UNIT_PROGRAM) then + call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_PROGRAM') + return + end if + + if (size(f_source%modules_provided) /= 0) then + call test_failed(error,'Unexpected modules_provided - expecting zero') + return + end if + + if (size(f_source%modules_used) /= 4) then + call test_failed(error,'Incorrect number of modules_used - expecting four') + return + end if + + if (.not.('module_one' .in. f_source%modules_used)) then + call test_failed(error,'Missing module in modules_used') + return + end if + + if (.not.('module_two' .in. f_source%modules_used)) then + call test_failed(error,'Missing module in modules_used') + return + end if + + if (.not.('module_three' .in. f_source%modules_used)) then + call test_failed(error,'Missing module in modules_used') + return + end if + + if (.not.('module_four' .in. f_source%modules_used)) then + call test_failed(error,'Missing module in modules_used') + return + end if + + if ('module_not_used' .in. f_source%modules_used) then + call test_failed(error,'Commented module found in modules_used') + return + end if + + end subroutine test_modules_used + + + !> Check that intrinsic modules are properly ignore + subroutine test_intrinsic_modules_used(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'program test', & + & ' use iso_c_binding', & + & ' use iso_fortran_env', & + & ' use ieee_arithmetic', & + & ' use ieee_exceptions', & + & ' use ieee_features', & + & ' implicit none', & + & 'end program test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (size(f_source%modules_provided) /= 0) then + call test_failed(error,'Unexpected modules_provided - expecting zero') + return + end if + + if (size(f_source%modules_used) /= 0) then + call test_failed(error,'Incorrect number of modules_used - expecting zero') + return + end if + + if ('iso_c_binding' .in. f_source%modules_used) then + call test_failed(error,'Intrinsic module found in modules_used') + return + end if + + if ('iso_fortran_env' .in. f_source%modules_used) then + call test_failed(error,'Intrinsic module found in modules_used') + return + end if + + if ('ieee_arithmetic' .in. f_source%modules_used) then + call test_failed(error,'Intrinsic module found in modules_used') + return + end if + + if ('ieee_exceptions' .in. f_source%modules_used) then + call test_failed(error,'Intrinsic module found in modules_used') + return + end if + + if ('ieee_features' .in. f_source%modules_used) then + call test_failed(error,'Intrinsic module found in modules_used') + return + end if + + end subroutine test_intrinsic_modules_used + + + !> Check parsing of include statements + subroutine test_include_stmt(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'program test', & + & ' implicit none', & + & ' include "included_file.f90"', & + & ' contains ', & + & ' include "second_include.f90"', & + & 'end program test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (size(f_source%modules_provided) /= 0) then + call test_failed(error,'Unexpected modules_provided - expecting zero') + return + end if + + if (size(f_source%modules_used) /= 0) then + call test_failed(error,'Incorrect number of modules_used - expecting zero') + return + end if + + if (size(f_source%include_dependencies) /= 2) then + call test_failed(error,'Incorrect number of include_dependencies - expecting two') + return + end if + + if (.not.('included_file.f90' .in. f_source%include_dependencies)) then + call test_failed(error,'Missing include file in include_dependencies') + return + end if + + if (.not.('second_include.f90' .in. f_source%include_dependencies)) then + call test_failed(error,'Missing include file in include_dependencies') + return + end if + + end subroutine test_include_stmt + + + !> Try to parse fortran module + subroutine test_module(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'module my_mod', & + & 'use module_one', & + & 'interface', & + & ' module subroutine f()', & + & 'end interface', & + & 'contains', & + & 'module procedure f()', & + & 'end procedure f', & + & 'end submodule test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (f_source%unit_type /= FPM_UNIT_MODULE) then + call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_MODULE') + return + end if + + if (size(f_source%modules_provided) /= 1) then + call test_failed(error,'Unexpected modules_provided - expecting one') + return + end if + + if (size(f_source%modules_used) /= 1) then + call test_failed(error,'Incorrect number of modules_used - expecting one') + return + end if + + if (.not.('my_mod' .in. f_source%modules_provided)) then + call test_failed(error,'Missing module in modules_provided') + return + end if + + if (.not.('module_one' .in. f_source%modules_used)) then + call test_failed(error,'Missing parent module in modules_used') + return + end if + + end subroutine test_module + + + !> Try to parse fortran submodule for ancestry + subroutine test_submodule(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'submodule (parent) :: child', & + & 'use module_one', & + & 'end submodule test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (f_source%unit_type /= FPM_UNIT_SUBMODULE) then + call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_SUBMODULE') + return + end if + + if (size(f_source%modules_provided) /= 0) then + call test_failed(error,'Unexpected modules_provided - expecting zero') + return + end if + + if (size(f_source%modules_used) /= 2) then + call test_failed(error,'Incorrect number of modules_used - expecting two') + return + end if + + if (.not.('module_one' .in. f_source%modules_used)) then + call test_failed(error,'Missing module in modules_used') + return + end if + + if (.not.('parent' .in. f_source%modules_used)) then + call test_failed(error,'Missing parent module in modules_used') + return + end if + + end subroutine test_submodule + + + !> Try to parse fortran multi-level submodule for ancestry + subroutine test_submodule_ancestor(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'submodule (ancestor:parent) :: child', & + & 'use module_one', & + & 'end submodule test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (f_source%unit_type /= FPM_UNIT_SUBMODULE) then + call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_SUBMODULE') + return + end if + + if (size(f_source%modules_provided) /= 0) then + call test_failed(error,'Unexpected modules_provided - expecting zero') + return + end if + + if (size(f_source%modules_used) /= 2) then + call test_failed(error,'Incorrect number of modules_used - expecting two') + return + end if + + if (.not.('module_one' .in. f_source%modules_used)) then + call test_failed(error,'Missing module in modules_used') + return + end if + + if (.not.('parent' .in. f_source%modules_used)) then + call test_failed(error,'Missing parent module in modules_used') + return + end if + + end subroutine test_submodule_ancestor + + + !> Try to parse standard fortran sub-program (non-module) source + subroutine test_subprogram(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'subroutine my_sub(a)', & + & ' use module_one', & + & ' integer, intent(in) :: a', & + & 'end subroutine my_sub' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (f_source%unit_type /= FPM_UNIT_SUBPROGRAM) then + call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_SUBPROGRAM') + return + end if + + if (size(f_source%modules_provided) /= 0) then + call test_failed(error,'Unexpected modules_provided - expecting zero') + return + end if + + if (size(f_source%modules_used) /= 1) then + call test_failed(error,'Incorrect number of modules_used - expecting one') + return + end if + + if (.not.('module_one' .in. f_source%modules_used)) then + call test_failed(error,'Missing module in modules_used') + return + end if + + end subroutine test_subprogram + + + !> Try to parse standard c source for includes + subroutine test_csource(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + temp_file = temp_file//'.c' + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & '#include "proto.h"', & + & 'void c_func(int a) {', & + & ' #include "function_body.c"', & + & ' return', & + & '}' + close(unit) + + f_source = parse_c_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (f_source%unit_type /= FPM_UNIT_CSOURCE) then + call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_CSOURCE') + return + end if + + if (size(f_source%modules_provided) /= 0) then + call test_failed(error,'Unexpected modules_provided - expecting zero') + return + end if + + if (size(f_source%modules_used) /= 0) then + call test_failed(error,'Incorrect number of modules_used - expecting zero') + return + end if + + if (size(f_source%include_dependencies) /= 2) then + call test_failed(error,'Incorrect number of include_dependencies - expecting two') + return + end if + + if (.not.('proto.h' .in. f_source%include_dependencies)) then + call test_failed(error,'Missing file in include_dependencies') + return + end if + + if (.not.('function_body.c' .in. f_source%include_dependencies)) then + call test_failed(error,'Missing file in include_dependencies') + return + end if + + end subroutine test_csource + + + !> Try to parse fortran program with invalid use statement + subroutine test_invalid_use_stmt(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'program test', & + & 'use module_one', & + & 'use :: ', & + & 'end program test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + end subroutine test_invalid_use_stmt + + + !> Try to parse fortran program with invalid use statement + subroutine test_invalid_include_stmt(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'program test', & + & ' include "', & + & 'end program test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + end subroutine test_invalid_include_stmt + + + !> Try to parse incorrect fortran module syntax + subroutine test_invalid_module(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'module :: my_mod', & + & 'end module test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + write(*,*) '"',f_source%modules_used(1)%s,'"' + + end subroutine test_invalid_module + + + !> Try to parse incorrect fortran submodule syntax + subroutine test_invalid_submodule(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'submodule :: child', & + & 'end submodule test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + write(*,*) '"',f_source%modules_used(1)%s,'"' + + end subroutine test_invalid_submodule + + + +end module test_source_parsing diff --git a/fpm/test/testsuite.f90 b/fpm/test/testsuite.f90 index bd0d415..9b69032 100644 --- a/fpm/test/testsuite.f90 +++ b/fpm/test/testsuite.f90 @@ -5,6 +5,7 @@ module testsuite private public :: run_testsuite, new_unittest, test_failed + public :: check_string public :: unittest_t, error_t @@ -73,7 +74,8 @@ contains call collect(testsuite) do ii = 1, size(testsuite) - write(unit, '("#", *(1x, a))') "Starting", testsuite(ii)%name, "..." + write(unit, '("#", 3(1x, a), 1x, "(", i0, "/", i0, ")")') & + & "Starting", testsuite(ii)%name, "...", ii, size(testsuite) call testsuite(ii)%test(error) if (allocated(error) .neqv. testsuite(ii)%should_fail) then if (testsuite(ii)%should_fail) then @@ -90,7 +92,7 @@ contains end if end if if (allocated(error)) then - write(unit, '(a)') error%message + write(unit, fmt) "Message:", error%message end if end do @@ -119,4 +121,32 @@ contains end function new_unittest + !> Check a deferred length character variable against a reference value + subroutine check_string(error, actual, expected, name) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Actual string value + character(len=:), allocatable, intent(in) :: actual + + !> Expected string value + character(len=*), intent(in) :: expected + + !> Name of the string to check + character(len=*), intent(in) :: name + + if (.not.allocated(actual)) then + call test_failed(error, name//" is not set correctly") + return + end if + + if (actual /= expected) then + call test_failed(error, name//" is "//actual// & + & " but should be "//expected) + end if + + end subroutine check_string + + end module testsuite |