├── .github └── workflows │ ├── intel.yml │ └── msys2.yml ├── .gitignore ├── LICENSE ├── README.md ├── README_zh.md ├── fpm.toml ├── meson.build ├── src └── argparse-f.f90 └── test └── check.f90 /.github/workflows/intel.yml: -------------------------------------------------------------------------------- 1 | name: intel 2 | 3 | on: [push, pull_request] 4 | 5 | jobs: 6 | intel-build: 7 | runs-on: ${{ matrix.os }} 8 | strategy: 9 | fail-fast: false 10 | matrix: 11 | os: [ubuntu-latest] 12 | 13 | env: 14 | FC: ifort 15 | 16 | steps: 17 | - name: Checkout code 18 | uses: actions/checkout@v3 19 | 20 | - uses: actions/setup-python@v1 21 | with: 22 | python-version: '3.x' 23 | 24 | - name: Add Intel repository 25 | run: | 26 | wget https://apt.repos.intel.com/intel-gpg-keys/GPG-PUB-KEY-INTEL-SW-PRODUCTS.PUB 27 | sudo apt-key add GPG-PUB-KEY-INTEL-SW-PRODUCTS.PUB 28 | rm GPG-PUB-KEY-INTEL-SW-PRODUCTS.PUB 29 | echo "deb https://apt.repos.intel.com/oneapi all main" | sudo tee /etc/apt/sources.list.d/oneAPI.list 30 | sudo apt-get update 31 | 32 | - name: Install Intel oneAPI compiler (ifx) 33 | run: | 34 | sudo apt-get install intel-oneapi-compiler-fortran-2024.1 35 | source /opt/intel/oneapi/setvars.sh 36 | printenv >> $GITHUB_ENV 37 | export FC=ifx 38 | echo FC=$FC>>$GITHUB_ENV 39 | 40 | - name: Install meson 41 | run: pip3 install meson ninja 42 | 43 | - name: meson build 44 | run: | 45 | meson setup _build 46 | meson test -C _build 47 | 48 | - name: catch build fail 49 | run: cat _build/meson-logs/meson-log.txt 50 | if: ${{ failure() }} 51 | -------------------------------------------------------------------------------- /.github/workflows/msys2.yml: -------------------------------------------------------------------------------- 1 | name: msys2 2 | 3 | on: [push, pull_request] 4 | 5 | jobs: 6 | msys2-build: 7 | runs-on: windows-latest 8 | defaults: 9 | run: 10 | shell: msys2 {0} 11 | 12 | steps: 13 | - uses: actions/checkout@v3 14 | - uses: msys2/setup-msys2@v2 15 | with: 16 | msystem: MINGW64 17 | path-type: inherit 18 | install: | 19 | mingw-w64-x86_64-gcc-fortran 20 | mingw-w64-x86_64-fpm 21 | mingw-w64-x86_64-meson 22 | mingw-w64-x86_64-ninja 23 | 24 | - name: fpm test 25 | run: | 26 | fpm test 27 | fpm test -- -? 28 | fpm test -- -v 29 | 30 | - name: meson test 31 | run: | 32 | meson setup _build 33 | meson test -C _build 34 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | build/ 2 | _build/ 3 | .vscode/ 4 | *.mod 5 | *.exe 6 | *.obj 7 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 0382 and argparse-f's contributors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # argparse-f 2 | 3 | Modern Fortran command line parser, implemented with OOP. 4 | 5 | ## Example 6 | ```fortran 7 | program test 8 | use iso_fortran_env, only: stdout => output_unit 9 | use argparse 10 | implicit none 11 | character(len=10), parameter :: program_name = "qcalc" 12 | type(argparser) :: args 13 | args = argparser("A quantum physics calculation program.") 14 | call args%set_program_name(program_name) 15 | call args%add_help_option() 16 | call args%add_sc_option("-v", "--version", "show version info", show_version_info) 17 | call args%add_option_logical("-o", "--openmp", "use openmp or not") ! logical option has no default 18 | call args%add_option_logical("-m", "--mpi", "use mpi or not") 19 | call args%add_option_integer("-t", "--thread", "thread number,\nit is valid only if openmp is set", 1) 20 | call args%add_option_integer("-p", "--process", "process number,\nit is valid only if mpi is set", 1) 21 | call args%add_option_string("", "--chemical", "chemical formula", "H2O") ! short name can be empty 22 | call args%add_named_argument_string("input", "initialize file") 23 | call args%add_named_argument_string("output", "output file") 24 | call args%parse() 25 | 26 | if (args%has_option("--openmp")) then 27 | print '(A,I2,A)', "openmp is used, and we use ", args%get_option_integer("-t"), " threads" 28 | end if 29 | if (args%has_option("--mpi")) then 30 | print '(A,I2,A)', "mpi is used, and we use ", args%get_option_integer("-p"), " processes" 31 | end if 32 | print '(A,A)', "the calculated chemical is ", trim(args%get_option_string("--chemical")) 33 | print '(A,A)', "the input file is ", trim(args%get_argument_string("input")) 34 | print '(A,A)', "the output file is ", trim(args%get_argument_string("output")) 35 | 36 | ! you can also print the cached `args` into INI file 37 | ! print '(/,A)', "All of the options and arguments are shown below" 38 | ! call args%print_as_ini(stdout, .true.) 39 | contains 40 | subroutine show_version_info 41 | print "(A)", trim(program_name)//" version 0.1.0" 42 | end subroutine show_version_info 43 | end program test 44 | ``` 45 | Compile it as `qclac`, and use it like: 46 | ```bash 47 | > qclac -? 48 | usage: qcalc [options] [=input] [=output] 49 | 50 | A quantum physics calculation program. 51 | 52 | options: 53 | -?, --help show this help message 54 | -v, --version show version info 55 | -o, --openmp use openmp or not 56 | -m, --mpi use mpi or not 57 | -t, --thread (integer [=1]) thread number, 58 | it is valid only if openmp is set 59 | -p, --process (integer [=1]) process number, 60 | it is valid only if mpi is set 61 | --chemical (string [=H2O]) chemical formula 62 | 63 | named arguments: 64 | input (string) initialize file 65 | output (string) output file 66 | > qclac -om -t 16 input=input.txt output=out.bin 67 | openmp is used, and we use 16 threads 68 | mpi is used, and we use 1 processes 69 | the calculated chemical is H2O 70 | the input file is input.txt 71 | the output file is out.bin 72 | ``` 73 | 74 | ## Usage 75 | 76 | The simple way to use this package is copy the file `src/argparse-f.f90` into your project. Or you can use [fpm](https://fpm.fortran-lang.org/en/index.html) 77 | ```toml 78 | [dependencies] 79 | argparse-f = { git="https://github.com/0382/argparse-f.git" } 80 | ``` 81 | 82 | In addition, `argparse-f` also supports the [Meson](https://mesonbuild.com/) build system. 83 | 84 | ## Parse rules 85 | 86 | In this package, command line arguments are classified into two kinds: `option` and `argument`. 87 | 88 | ### `option` 89 | 90 | As the name suggests, `option` is optional. It cantains two types: normal option and short curcuit option. 91 | 92 | #### normal options 93 | 94 | You can add normal options like this 95 | ```fortran 96 | call args%add_option_integer("-t", "--thread", "thread number", 1) 97 | ``` 98 | 99 | The first dummy argument means `short_name` of the option, and it can be empty. If it is not empty, then it must be `-` followed by **single character**. The second dummy argument means `long_name` of the option, and it **cannot** be empty, it must start with `--`. The third dummy argument means help message, and the last one is the default value of the option. 100 | 101 | In this version, normal option support five data types: `logical, integer, real, real(kind=8), character(len=*)` (add `real(8)` option method is `add_option_double`, and add `character(len=*)` option method is `add_option_string`). 102 | 103 | `add_option_logical` function does not need the default value. Because, if you set the option in command line, the value is `.true.`, otherwise the value is `.false.`, for example: 104 | ```bash 105 | ls -l 106 | ``` 107 | them `-l` option is set to `.true.`. To add the other four data types' options, you must give the default value, in case if one do not set the option, it use the default value. In command line, you should set the option like this: 108 | ```bash 109 | greet --name Alice --age 24 110 | ``` 111 | then the `--name` option is set to `Alice` and `--age` option is set to `24`. 112 | 113 | #### short circuit options 114 | 115 | You can add short circuit options like this: 116 | ```fortran 117 | call args%add_sc_option("-v", "--version", "show version info", show_version_info) 118 | contains 119 | subroutine show_version_info 120 | print "(A)", trim(program_name)//" version 0.1.0" 121 | end subroutine show_version_info 122 | ``` 123 | 124 | A short circuit option must be `logical` type, and you should give a callback subroutine. The callback subroutine cannot have dummy arguments. Short circuit options are searched first, for example 125 | ```bash 126 | git --help 127 | gcc -v 128 | ``` 129 | The corresponding callback subroutine is called immediately as long as the program searched the first short circuit option, and then the program `stop`. 130 | 131 | ### argument 132 | 133 | `argument` is opposited to `option`. You must set its value in command line. If not, the program will stop with error. `argument` also contains two types: position argument and named argument. 134 | 135 | In this version, `argument` supports `integer, real, real(kind=8), character(len=*)` data types. It does not support `logical` type, you should use `option` instead. 136 | #### position argument 137 | 138 | Position argument is got with position, for exmple 139 | ```bash 140 | ffplay video.mp4 141 | ``` 142 | The `video.mp4` is the first (and only) position argument. If you do not give the argument, the `ffplay` will exit with error. 143 | 144 | Add position argument like this: 145 | ```fortran 146 | call args%add_argument_string("input", "initialize file") 147 | ``` 148 | The first dummy argument is `name` of the argumet, and the second is the help message. 149 | 150 | #### named argument 151 | 152 | The named argument is defined by myself, it is designed for my work. It is used like this: 153 | ```bash 154 | greet name=Alice age=24 155 | ``` 156 | It is tedious comparing with position argument, so it should not be used in a common command line program. But it is useful in a big project, and you run program with a shell script. In this case, the named argument make the script more readable. 157 | 158 | Add named argument like this: 159 | ```fortran 160 | call args%add_named_argument_string("input", "initialize file") 161 | ``` 162 | 163 | ## Get results 164 | 165 | ### option 166 | 167 | Use functions like `args%get_option_logical(name)` to get option results. You can use both `short_name` and `long_name`. For `logical` data type, you can also use `args%has_option(name)` for short. 168 | 169 | ### argument 170 | 171 | Use functions like `args%get_argument_logical(name)` to get argument results. Named argument and position argument cannot have duplicate name. So you can use this function to get either named argument or position argument. 172 | 173 | ## Tips 174 | 175 | ### conflict 176 | 177 | Options cannot have same `short_name` or `long_name`, including normal options and short circuit options. Arguments also cannot have same `name`, including named arguments and position arguments. 178 | 179 | ### aggregate short name options 180 | In some linux command line programs, there are options I call them aggregate short name options. For example 181 | ```bash 182 | ls -lah 183 | ``` 184 | It set three logical options `-l`, `-a`, `-h` at the same time. This package also support this feature. Remind that only `logical` type options are supported to be set in this way. 185 | 186 | > That's why options' `short_name` only contians single character. 187 | 188 | ### custom help option 189 | 190 | You can add default help option with `args%add_help_option`, it's `short_name` and `long_name` are `-?` and `--help`. If you dislike the names, you can add custom help option like this 191 | ```fortran 192 | call args%add_sc_option("-h", "--help", "show this help message", print_help) 193 | contains 194 | subroutine print_help 195 | call args%print_help() 196 | end subroutine 197 | ``` 198 | 199 | > Using `-?` is to save character space for other options' `short_name`. Not every one like it. Luckily it is simple to define your custom help option. 200 | 201 | ### multi-line help message 202 | Some times, help message may be very long. You can use `\n` to as line break marker. Of course, Fortran does not have escape characters. I just use some character split technique to realize this feature. 203 | 204 | ### print argparser 205 | 206 | You can print the argparser into INI file format. If the second dummy argument is set to `.true.`, then print help message as comments. 207 | ```fortran 208 | call args%print_as_ini(stdout, .true.) 209 | ``` 210 | 211 | ### `print_uasge` && `set_program_name` 212 | If you give none command line argument and if it needs at least one argument, the program will call `print_usage` and exit. It is just the first line of `print_help`. `set_program_name` only affects program name in `print_usage`, if you does not set it, it will use `argv[0]`. 213 | 214 | ## Reference 215 | 216 | This package works like my c++ package [argparse](https://github.com/0382/util/tree/main/cpp/argparse). They are imspired by c++ package [cmdline](https://github.com/tanakh/cmdline) and python's standard library package [argparse](https://docs.python.org/3/library/argparse.html). -------------------------------------------------------------------------------- /README_zh.md: -------------------------------------------------------------------------------- 1 | # argparse-f 2 | 3 | 现代Fortran的命令行参数解析器，使用了面向对象特性。 4 | 5 | ## 示例 6 | ```fortran 7 | program test 8 | use iso_fortran_env, only: stdout => output_unit 9 | use argparse 10 | implicit none 11 | character(len=10), parameter :: program_name = "qcalc" 12 | type(argparser) :: args 13 | args = argparser("A quantum physics calculation program.") 14 | call args%set_program_name(program_name) 15 | call args%add_help_option() 16 | call args%add_sc_option("-v", "--version", "show version info", show_version_info) 17 | call args%add_option_logical("-o", "--openmp", "use openmp or not") ! logical option has no default 18 | call args%add_option_logical("-m", "--mpi", "use mpi or not") 19 | call args%add_option_integer("-t", "--thread", "thread number,\nit is valid only if openmp is set", 1) 20 | call args%add_option_integer("-p", "--process", "process number,\nit is valid only if mpi is set", 1) 21 | call args%add_option_string("", "--chemical", "chemical formula", "H2O") ! short name can be empty 22 | call args%add_named_argument_string("input", "initialize file") 23 | call args%add_named_argument_string("output", "output file") 24 | call args%parse() 25 | 26 | if (args%has_option("--openmp")) then 27 | print '(A,I2,A)', "openmp is used, and we use ", args%get_option_integer("-t"), " threads" 28 | end if 29 | if (args%has_option("--mpi")) then 30 | print '(A,I2,A)', "mpi is used, and we use ", args%get_option_integer("-p"), " processes" 31 | end if 32 | print '(A,A)', "the calculated chemical is ", trim(args%get_option_string("--chemical")) 33 | print '(A,A)', "the input file is ", trim(args%get_argument_string("input")) 34 | print '(A,A)', "the output file is ", trim(args%get_argument_string("output")) 35 | 36 | ! you can also print the cached `args` into INI file 37 | ! print '(/,A)', "All of the options and arguments are shown below" 38 | ! call args%print_as_ini(stdout, .true.) 39 | contains 40 | subroutine show_version_info 41 | print "(A)", trim(program_name)//" version 0.1.0" 42 | end subroutine show_version_info 43 | end program test 44 | ``` 45 | 将其编译成`qclac`，使用方式如下 46 | ```bash 47 | > qclac -? 48 | usage: qcalc [options] [=input] [=output] 49 | 50 | A quantum physics calculation program. 51 | 52 | options: 53 | -?, --help show this help message 54 | -v, --version show version info 55 | -o, --openmp use openmp or not 56 | -m, --mpi use mpi or not 57 | -t, --thread (integer [=1]) thread number, 58 | it is valid only if openmp is set 59 | -p, --process (integer [=1]) process number, 60 | it is valid only if mpi is set 61 | --chemical (string [=H2O]) chemical formula 62 | 63 | named arguments: 64 | input (string) initialize file 65 | output (string) output file 66 | > qclac -om -t 16 input=input.txt output=out.bin 67 | openmp is used, and we use 16 threads 68 | mpi is used, and we use 1 processes 69 | the calculated chemical is H2O 70 | the input file is input.txt 71 | the output file is out.bin 72 | ``` 73 | 74 | ## 使用 75 | 76 | 最简单的方法是复制`src/argparse-f.f90`文件到你的项目中。推荐使用[fpm](https://fpm.fortran-lang.org/en/index.html) 77 | ```toml 78 | [dependencies] 79 | argparse-f = { git="https://github.com/0382/argparse-f.git" } 80 | ``` 81 | 82 | 此外，`argparse-f`也支持[Meson](https://mesonbuild.com/)构建系统。 83 | 84 | ## 解析规则 85 | 86 | 在我的库里面，命令行参数分为两大类（可选的选项，和必选的参数），每类又分为两种，总共四种命令行参数。 87 | 88 | ### `option`（选项） 89 | 90 | 选项，从语义上来说是可选的。它分成两种：一般选项和短路选项。 91 | 92 | #### 一般选项 93 | 94 | 用如下方式添加一般选项： 95 | ```fortran 96 | call args%add_option_integer("-t", "--thread", "thread number", 1) 97 | ``` 98 | 99 | 其中第一个参数是短选项名，是可以为空字符串的，如果非空，则必须是一个'-'后接**单个**字符；第二个是长选项名，不能为空字符串，必须以"--"开头。第三个是帮助信息，最后一个是该选项的默认值。 100 | 101 | 当前版本一般选项仅支持五种数据类型：`logical, integer, real, real(kind=8), character(len=*)` （添加`real(8)`的方法是`add_option_double`，添加`character(len=*)`的方法是`add_option_string`）。 102 | 103 | 除了bool型的option，其余的option添加时都要给定默认的值。 104 | 对于bool型，不需要默认值，检查到命令行参数有这个选项，就是true否则为false。例如 105 | ```bash 106 | ls -l 107 | ``` 108 | 此时-l选项为true。而其他类型选项需要在其后面加上参数，比如 109 | ```bash 110 | greet --name Alice --age 24 111 | ``` 112 | 于是`--name`选项的值为`"Alice"`，`--age`选项的值为`24`。 113 | 114 | #### 短路选项 115 | 116 | 短路选项（short circuit option）按照如下方式添加 117 | ```fortran 118 | call args%add_sc_option("-v", "--version", "show version info", show_version_info) 119 | contains 120 | subroutine show_version_info 121 | print "(A)", trim(program_name)//" version 0.1.0" 122 | end subroutine show_version_info 123 | ``` 124 | 125 | 短路选项仅支持bool类型，添加该选项时需要给定一个回调函数，必须是无参数的`subroutine`。短路选项是最先搜索解析一种命令行参数。比如 126 | ```bash 127 | git --help 128 | gcc -v 129 | ``` 130 | 只要命令行参数包含了这类参数，则调用回调函数，并立即（正常）退出程序。 131 | 132 | ### `argument`（参数） 133 | 134 | 参数，和选项相反是必须提供的。如果某个参数没有提供，则程序会报错并退出。参数分为位置参数和命名参数两种 135 | 136 | 当前版本参数仅支持四种数据类型：`integer, real, real(kind=8), character(len=*)`。不支持`logical`类型，实际上`logical`类型用选项是更合适的。 137 | 138 | #### 位置参数 139 | 140 | 按照位置获取的参数，例如 141 | ```bash 142 | ffplay video.mp4 143 | ``` 144 | `video.mp4`就是一个位置参数。如果使用`ffplay`程序没有指定这个位置参数，那么程序就发生错误并退出。 145 | 146 | 按照如下方式添加位置参数 147 | ```fortran 148 | call args%add_argument_string("input", "initialize file") 149 | ``` 150 | 该函数的第一个哑元表示参数的名字，第二个表示帮助信息。 151 | 152 | #### 命名参数 153 | 154 | 这是为了解决我个人工作中遇到的情况而定义的。它的使用方式例如 155 | ```bash 156 | greet name=Alice age=24 157 | ``` 158 | 显然这样使用参数非常繁琐，不应该作为轻量级的命令行程序使用。但是可以放在一个较重的工程中，并且运行的时候是用脚本调用程序而不是直接在命令行使用。这个时候，使用命名参数可以让你的脚本更具可读性。 159 | 160 | 使用如下方式添加命名参数 161 | Add named argument like this: 162 | ```fortran 163 | call args%add_named_argument_string("input", "initialize file") 164 | ``` 165 | 166 | 解析命令行参数时，先解析命名参数，剩下的自动按照顺序赋值给位置参数。命名参数不必按照设置的顺序指定。 167 | 168 | ## 获取结果 169 | 170 | ### 选项 171 | 172 | 使用类似`args%get_option_logical(name)`的方法获取结果选项的结果，这里的`name`既可以长名字也可以短名字。对于`logical`类型的选项，特别提供了`args%has_option(name)`函数。 173 | 174 | ### 参数 175 | 176 | 使用类似`args%get_argument_logical(name)`的方法获取结果参数的结果。命名参数和位置参数的名字不允许冲突，所以获取的时候可以不用区分，就没有`get_named_argument_xxx`版本的函数了。 177 | 178 | ## 杂项 179 | 180 | ### 冲突 181 | 182 | 短路选项和一般选项的名字不允许冲突。命名参数和位置参数的名字也不允许冲突。 183 | 184 | 这是为了实现linux一些基本命令行工具类似的效果。比如 185 | ``` 186 | ls -lah 187 | ``` 188 | 同时指定了`-l`, `-a`和`-h`选项。只有`logical`类型的选项才能够这样指定。 189 | 190 | > 这也是为什么选项的短名字仅允许一个字符。 191 | 192 | ### 自定义帮助选项 193 | 194 | 使用`args%add_help_option()`可以添加默认的帮助选项，它使用的名字是`-?`和`--help`。如果你不喜欢这个名字，可以添加自定义的帮助选项 195 | ```fortran 196 | call args%add_sc_option("-h", "--help", "show this help message", print_help) 197 | contains 198 | subroutine print_help 199 | call args%print_help() 200 | end subroutine 201 | ``` 202 | 203 | > 默认使用`-?`而不是`-h`是为了给其他的选项留出选择空间。 204 | 205 | ### 多行的帮助信息 206 | 207 | 有的时候我们的帮助信息很长，如果写在一行但是控制台的宽度不够造成换行会很难看。你可以在帮助信息里面加上`\n`作为换行标识。当然Fortran是没有转义字符的，不过这不重要。这个包会根据`\n`自动添加换行和空格使得帮助信息更好看。 208 | 209 | ### 打印获取的结果 210 | 211 | 你可以将`argparser`获取的结果打印为INI文件格式 212 | ```fortran 213 | call args%print_as_ini(stdout, .true.) 214 | ``` 215 | 这个函数的第二个参数表示是否打印注释，如果为`.true.`那么会把帮助信息打印为注释。 216 | 217 | ### `print_uasge`和`set_program_name` 218 | 如果你运行程序不带任何命令行参数同时程序应该需要argument，那么`argparser`会调用`print_usage`并退出。`print_usage`实际上就是`print_help`的第一行信息，算是一个简短的帮助信息。`set_program_name`仅仅影响`print_usage`时显示的程序名字，如果不调用这个函数，那么会使用`argv[0]`。 219 | 220 | ## 参考 221 | 222 | 这个包和我自己写的c++包[argparse](https://github.com/0382/util/tree/main/cpp/argparse)工作方式是类似的。这两个包都受到了c++包[cmdline](https://github.com/tanakh/cmdline)以及python标准库的[argparse](https://docs.python.org/3/library/argparse.html)模块的启发。 -------------------------------------------------------------------------------- /fpm.toml: -------------------------------------------------------------------------------- 1 | name = "argparse-f" 2 | version = "0.1.0" 3 | license = "MIT" 4 | author = "0382" 5 | maintainer = "18322825326@163.com" 6 | copyright = "Copyright 2023, 0382" 7 | [build] 8 | auto-executables = true 9 | auto-tests = true 10 | auto-examples = true 11 | [install] 12 | library = false 13 | -------------------------------------------------------------------------------- /meson.build: -------------------------------------------------------------------------------- 1 | project( 2 | 'argparse-f', 3 | 'fortran', 4 | version : '0.1.0', 5 | license : 'MIT', 6 | default_options : [ 7 | 'buildtype=debugoptimized', 8 | 'fortran_std=f2018' 9 | ] 10 | ) 11 | 12 | argparse_f_src = files( 13 | 'src/argparse-f.f90' 14 | ) 15 | 16 | argparse_f_lib = static_library( 17 | meson.project_name(), 18 | sources : argparse_f_src, 19 | install : true, 20 | ) 21 | 22 | argparse_f_inc = argparse_f_lib.private_dir_include() 23 | argparse_f_dep = declare_dependency( 24 | link_with : argparse_f_lib, 25 | include_directories : argparse_f_inc, 26 | ) 27 | 28 | test( 29 | 'argparse_f_check', 30 | executable( 31 | 'argparse_f_check', 32 | 'test/check.f90', 33 | dependencies : argparse_f_dep, 34 | ), 35 | ) 36 | -------------------------------------------------------------------------------- /src/argparse-f.f90: -------------------------------------------------------------------------------- 1 | ! MIT License 2 | 3 | ! Copyright (c) 2023 0382 and argparse-f's contributors 4 | 5 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 6 | ! of this software and associated documentation files (the "Software"), to deal 7 | ! in the Software without restriction, including without limitation the rights 8 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | ! copies of the Software, and to permit persons to whom the Software is 10 | ! furnished to do so, subject to the following conditions: 11 | 12 | ! The above copyright notice and this permission notice shall be included in all 13 | ! copies or substantial portions of the Software. 14 | 15 | ! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | ! SOFTWARE. 22 | 23 | module argparse 24 | implicit none 25 | private 26 | integer, parameter :: type_string_len = 16 27 | integer, parameter :: short_name_len = 2 28 | integer, parameter :: long_name_len = 32 29 | integer, parameter :: argument_len = 32 30 | integer, parameter :: help_len = 1024 31 | integer, parameter :: value_len = 1024 32 | 33 | integer, parameter :: description_len = 1024 34 | integer, parameter :: program_name_len = 1024 35 | integer, parameter :: null_index_value = -1 36 | 37 | abstract interface 38 | subroutine sc_option_callback 39 | end subroutine sc_option_callback 40 | end interface 41 | !> Hack for Intel Fortran 42 | procedure(sc_option_callback), pointer :: dummy_print_help_wrapper => dummy_print_help 43 | 44 | type short_circuit_option 45 | character(len=short_name_len) :: short_name 46 | character(len=long_name_len) :: long_name 47 | character(len=help_len) :: help 48 | procedure(sc_option_callback), pointer, nopass :: callback 49 | end type short_circuit_option 50 | 51 | type option 52 | character(len=short_name_len) :: short_name 53 | character(len=long_name_len) :: long_name 54 | character(len=help_len) :: help 55 | character(len=type_string_len) :: value_type 56 | character(len=value_len) :: value 57 | end type option 58 | 59 | type argument 60 | character(len=argument_len) :: name 61 | character(len=help_len) :: help 62 | character(len=type_string_len) :: value_type 63 | character(len=value_len) :: value 64 | end type argument 65 | 66 | public :: argparser 67 | type :: argparser 68 | character(len=description_len) :: description 69 | character(len=program_name_len) :: program_name 70 | integer :: sc_option_size ! 手动管理一个类似 c++ std::vector 的动态数组 71 | type(short_circuit_option), dimension(:), allocatable :: sc_options 72 | integer :: option_size 73 | type(option), dimension(:), allocatable :: options 74 | integer :: named_argument_size 75 | type(argument), dimension(:), allocatable :: named_arguments 76 | integer :: argument_size 77 | type(argument), dimension(:), allocatable :: arguments 78 | integer, dimension(0:127) :: short_name_index = null_index_value 79 | contains 80 | final :: deallocate_argparser 81 | procedure :: parse => argp_parse 82 | procedure :: print_usage => argp_print_usage 83 | procedure :: print_help => argp_print_help 84 | procedure :: set_program_name => argp_set_program_name 85 | procedure :: add_sc_option => argp_add_sc_option 86 | procedure :: add_help_option => argp_add_help_option 87 | procedure :: add_option_logical => argp_add_option_logical 88 | procedure :: add_option_integer => argp_add_option_integer 89 | procedure :: add_option_real => argp_add_option_real 90 | procedure :: add_option_double => argp_add_option_double 91 | procedure :: add_option_string => argp_add_option_string 92 | procedure :: add_named_argument_integer => argp_add_named_argument_integer 93 | procedure :: add_named_argument_real => argp_add_named_argument_real 94 | procedure :: add_named_argument_double => argp_add_named_argument_double 95 | procedure :: add_named_argument_string => argp_add_named_argument_string 96 | procedure :: add_argument_integer => argp_add_argument_integer 97 | procedure :: add_argument_real => argp_add_argument_real 98 | procedure :: add_argument_double => argp_add_argument_double 99 | procedure :: add_argument_string => argp_add_argument_string 100 | procedure :: print_as_ini => argp_print_as_ini 101 | procedure :: has_option => argp_has_option 102 | procedure :: get_option_logical => argp_get_option_logical 103 | procedure :: get_option_integer => argp_get_option_integer 104 | procedure :: get_option_real => argp_get_option_real 105 | procedure :: get_option_double => argp_get_option_double 106 | procedure :: get_option_string => argp_get_option_string 107 | procedure :: get_argument_integer => argp_get_argument_integer 108 | procedure :: get_argument_real => argp_get_argument_real 109 | procedure :: get_argument_double => argp_get_argument_double 110 | procedure :: get_argument_string => argp_get_argument_string 111 | end type argparser 112 | 113 | interface argparser 114 | procedure :: make_argparser 115 | end interface 116 | 117 | contains 118 | 119 | pure function make_argparser(description) result(this) 120 | character(len=*), intent(in) :: description 121 | type(argparser) :: this 122 | this%description = description 123 | this%program_name = '' 124 | this%sc_option_size = 0 125 | this%option_size = 0 126 | this%named_argument_size = 0 127 | this%argument_size = 0 128 | ! 主要是为了后面不用判断是否 `allocated` 129 | allocate (this%sc_options(1)) 130 | allocate (this%options(1)) 131 | allocate (this%named_arguments(1)) 132 | allocate (this%arguments(1)) 133 | end function make_argparser 134 | 135 | pure subroutine deallocate_argparser(this) 136 | type(argparser), intent(inout) :: this 137 | if (allocated(this%sc_options)) deallocate (this%sc_options) 138 | if (allocated(this%options)) deallocate (this%options) 139 | if (allocated(this%named_arguments)) deallocate (this%named_arguments) 140 | if (allocated(this%arguments)) deallocate (this%arguments) 141 | end subroutine 142 | 143 | subroutine argp_parse(this) 144 | class(argparser), intent(inout) :: this 145 | integer :: i, j, idx, argc, status 146 | character(len=value_len), dimension(:), allocatable :: tokens 147 | character(len=value_len) :: tok 148 | integer :: token_parsed_num 149 | argc = command_argument_count() 150 | allocate (tokens(argc)) 151 | token_parsed_num = 0 152 | ! if not set program name, use argv[0] 153 | if (this%program_name == "") then 154 | call get_command_argument(0, this%program_name, status=status) 155 | if (status == -1) then 156 | print "(A)", "WARNING: you get a truncated program name" 157 | end if 158 | end if 159 | if (argc == 0 .and. (this%argument_size /= 0 .or. this%named_argument_size /= 0)) then 160 | call this%print_usage() 161 | stop 162 | end if 163 | do i = 1, argc 164 | call get_command_argument(i, tokens(i), status) 165 | if (status == -1) then 166 | print '(A)', "WARNING: the command argument, '"//trim(tokens(i))//"' is truncated, you'd better limit it in 1024 characters" 167 | end if 168 | end do 169 | ! parse short circuit options 170 | do i = 1, this%sc_option_size 171 | do j = 1, argc 172 | tok = tokens(j) 173 | if (tok == this%sc_options(i)%short_name .or. tok == this%sc_options(i)%long_name) then 174 | if (associated(this%sc_options(i)%callback, dummy_print_help_wrapper)) then 175 | call this%print_help() 176 | else 177 | call this%sc_options(i)%callback() 178 | end if 179 | stop 180 | end if 181 | end do 182 | end do 183 | ! parse options 184 | do i = 1, this%option_size 185 | token_parsed_num = 0 186 | do j = 1, argc 187 | tok = tokens(j) 188 | if (tok == this%options(i)%short_name .or. tok == this%options(i)%long_name) then 189 | if (this%options(i)%value_type == "logical") then 190 | this%options(i)%value = 'T' 191 | token_parsed_num = 1 192 | exit 193 | else 194 | if (j == argc) then 195 | call argp_parse_error(this, & 196 | &"option '"//trim(this%options(i)%long_name)//"' requires a "//trim(this%options(i)%value_type)//" value") 197 | end if 198 | this%options(i)%value = tokens(j + 1) 199 | call argp_try_parse_option(this, this%options(i)) 200 | token_parsed_num = 2 201 | exit 202 | end if 203 | end if 204 | end do 205 | if (token_parsed_num /= 0) then 206 | tokens(j:argc - token_parsed_num) = tokens(j + token_parsed_num:argc) 207 | argc = argc - token_parsed_num 208 | end if 209 | end do 210 | ! try parse aggregate short name options 211 | j = 1 212 | do while (j <= argc) 213 | tok = tokens(j) 214 | j = j + 1 215 | if (tok(1:1) /= '-') cycle 216 | if (len_trim(tok) <= 2) cycle 217 | tok(1:value_len - 1) = tok(2:value_len) 218 | do i = 1, len_trim(tok) 219 | idx = this%short_name_index(ichar(tok(i:i))) 220 | if (idx == null_index_value) then 221 | call argp_parse_error(this, "unrecognized short name option '-"//tok(i:i)//"' in -"//trim(tok)) 222 | end if 223 | ! short circuit option 224 | if (idx <= this%sc_option_size) then 225 | if (this%sc_options(idx)%short_name(2:2) == tok(i:i)) then 226 | if (associated(this%sc_options(idx)%callback, dummy_print_help_wrapper)) then 227 | call this%print_help() 228 | else 229 | call this%sc_options(idx)%callback() 230 | end if 231 | stop 232 | end if 233 | end if 234 | ! normal option 235 | if (idx <= this%option_size) then 236 | if (this%options(idx)%short_name(2:2) == tok(i:i)) then 237 | if (this%options(idx)%value_type == "logical") then 238 | this%options(idx)%value = 'T' 239 | else 240 | call argp_parse_error(this, & 241 | &trim(this%options(idx)%value_type)//" option '-"//tok(i:i)//"' cannot be in aggregate argument") 242 | end if 243 | else 244 | call argp_parse_error(this, "unrecognized short name option '"//tok(i:i)//"' in -"//trim(tok)) 245 | end if 246 | end if 247 | end do 248 | tokens(j - 1:argc - 1) = tokens(j:argc) 249 | argc = argc - 1 250 | end do 251 | ! parse named argument 252 | if (argc < this%named_argument_size) then 253 | call argp_parse_error(this, "not enough named_arguments") 254 | end if 255 | do i = 1, this%named_argument_size 256 | token_parsed_num = 0 257 | do j = 1, argc 258 | tok = tokens(j) 259 | if (try_parse_named_argument(tok, this%named_arguments(i))) then 260 | token_parsed_num = 1 261 | call argp_try_parse_argumrnt(this, this%named_arguments(i)) 262 | exit 263 | end if 264 | end do 265 | if (token_parsed_num /= 0) then 266 | tokens(j:argc - token_parsed_num) = tokens(j + token_parsed_num:argc) 267 | argc = argc - token_parsed_num 268 | end if 269 | end do 270 | ! start parse position argument 271 | if (argc /= this%argument_size) then 272 | call this%print_help() 273 | print '(A)', repeat('-', 80) 274 | print '(A,I0,A,I0)', "position argument number missmatching, give ", argc, ", but need ", this%argument_size 275 | if (argc /= 0) then 276 | write (*, '("unparsed arguments:")', advance='no') 277 | do i = 1, argc 278 | write (*, '(" ",A)', advance='no') trim(tokens(i)) 279 | end do 280 | print * 281 | end if 282 | stop 283 | end if 284 | do i = 1, this%argument_size 285 | this%arguments(i)%value = tokens(i) 286 | call argp_try_parse_argumrnt(this, this%arguments(i)) 287 | end do 288 | deallocate (tokens) 289 | end subroutine argp_parse 290 | 291 | logical function try_parse_named_argument(line, arg) result(ans) 292 | character(len=*), intent(in) :: line 293 | type(argument), intent(inout) :: arg 294 | character(len=argument_len) :: name 295 | integer :: i, line_size 296 | line_size = len_trim(line) 297 | do i = 1, line_size 298 | if (line(i:i) == '=') exit 299 | end do 300 | if (i == line_size .and. line(i:i) /= '=') then 301 | ans = .false. 302 | else 303 | name = line(1:i - 1) 304 | if (name /= arg%name) then 305 | ans = .false. 306 | else 307 | arg%value(1:line_size - i) = line(i + 1:line_size) 308 | ans = .true. 309 | end if 310 | end if 311 | end function try_parse_named_argument 312 | 313 | subroutine argp_set_program_name(this, program_name) 314 | class(argparser), intent(inout) :: this 315 | character(len=*), intent(in) :: program_name 316 | if (len_trim(program_name) > program_name_len) then 317 | print '(A,A,A)', "WARNING: program name: '", program_name, "' is too long" 318 | end if 319 | this%program_name = program_name 320 | end subroutine argp_set_program_name 321 | 322 | subroutine argp_print_usage(this) 323 | class(argparser), intent(in) :: this 324 | integer :: i 325 | write (*, '("usage: ",A," [options]")', advance='no') trim(this%program_name) 326 | do i = 1, this%named_argument_size 327 | write (*, '(" [=",A,"]")', advance='no') trim(this%named_arguments(i)%name) 328 | end do 329 | do i = 1, this%argument_size 330 | write (*, '(" [",A,"]")', advance='no') trim(this%arguments(i)%name) 331 | end do 332 | print *, "" 333 | end subroutine argp_print_usage 334 | 335 | subroutine argp_print_help(this) 336 | class(argparser), intent(in) :: this 337 | integer :: i, j, length, max_name_length, printed_length 338 | character(len=32) :: help_fmt 339 | character(len=help_len), dimension(:), allocatable :: help_split 340 | 341 | call this%print_usage() 342 | print *, "" 343 | call split(this%description, "\n", help_split) 344 | do i = 1, size(help_split) 345 | print '(A)', trim(help_split(i)) 346 | end do 347 | deallocate (help_split) 348 | print '(/,A)', "options:" 349 | 350 | ! calculate the longest option name 351 | max_name_length = 0 352 | do i = 1, this%sc_option_size 353 | length = len_trim(this%sc_options(i)%long_name) 354 | if (this%sc_options(i)%short_name /= "") then 355 | length = length + 4 356 | end if 357 | max_name_length = max(length, max_name_length) 358 | end do 359 | do i = 1, this%option_size 360 | length = len_trim(this%options(i)%long_name) 361 | if (this%options(i)%short_name /= "") then 362 | length = length + 4 363 | end if 364 | max_name_length = max(length, max_name_length) 365 | end do 366 | max_name_length = max(max_name_length, 25) 367 | 368 | ! print options 369 | do i = 1, this%sc_option_size 370 | write (*, '(A2)', advance='no') " " 371 | printed_length = 0 372 | if (this%sc_options(i)%short_name /= "") then 373 | write (*, '(A,", ")', advance='no') trim(this%sc_options(i)%short_name) 374 | printed_length = 4 375 | end if 376 | write (*, '(A)', advance='no') trim(this%sc_options(i)%long_name) 377 | printed_length = printed_length + len_trim(this%sc_options(i)%long_name) 378 | write (unit=help_fmt, fmt='("(",I0,"X,A)")') max_name_length - printed_length 379 | write (*, help_fmt, advance='no') '' 380 | call split(this%sc_options(i)%help, "\n", help_split) 381 | print '(A)', trim(help_split(1)) 382 | write (unit=help_fmt, fmt='("(",I0,"X,A)")') max_name_length + 2 383 | do j = 2, size(help_split, 1) 384 | print help_fmt, trim(help_split(j)) 385 | end do 386 | deallocate (help_split) 387 | end do 388 | do i = 1, this%option_size 389 | write (*, '(A2)', advance='no') " " 390 | printed_length = 0 391 | if (this%options(i)%short_name /= "") then 392 | write (*, '(A,", ")', advance='no') trim(this%options(i)%short_name) 393 | printed_length = 4 394 | end if 395 | write (*, '(A)', advance='no') trim(this%options(i)%long_name) 396 | printed_length = printed_length + len_trim(this%options(i)%long_name) 397 | write (unit=help_fmt, fmt='("(",I0,"X,A)")') max_name_length - printed_length 398 | write (*, help_fmt, advance='no') '' 399 | call split(this%options(i)%help, "\n", help_split) 400 | if (this%options(i)%value_type == "logical") then 401 | print '(A)', trim(help_split(1)) 402 | else 403 | print '("(",A," [=",A,"]) ",A)', trim(this%options(i)%value_type), trim(this%options(i)%value), trim(help_split(1)) 404 | end if 405 | write (unit=help_fmt, fmt='("(",I0,"X,A)")') max_name_length + 2 406 | do j = 2, size(help_split, 1) 407 | print help_fmt, trim(help_split(j)) 408 | end do 409 | deallocate (help_split) 410 | end do 411 | 412 | if (this%named_argument_size > 0) then 413 | print '(/,A)', "named arguments:" 414 | max_name_length = 0 415 | do i = 1, this%named_argument_size 416 | max_name_length = max(max_name_length, len_trim(this%named_arguments(i)%name)) 417 | end do 418 | max_name_length = max(max_name_length, 25) 419 | do i = 1, this%named_argument_size 420 | write (*, '(2X,A)', advance='no') trim(this%named_arguments(i)%name) 421 | printed_length = len_trim(this%named_arguments(i)%name) 422 | write (unit=help_fmt, fmt='("(",I0,"X,""("",A,"") "")")') max_name_length - printed_length 423 | ! print '(A)', help_fmt 424 | write (*, help_fmt, advance='no') trim(this%named_arguments(i)%value_type) 425 | call split(this%named_arguments(i)%help, "\n", help_split) 426 | print '(A)', trim(help_split(1)) 427 | write (unit=help_fmt, fmt='("(",I0,"X,A)")') max_name_length + 2 428 | do j = 2, size(help_split, 1) 429 | print help_fmt, trim(help_split(j)) 430 | end do 431 | deallocate (help_split) 432 | end do 433 | end if 434 | 435 | if (this%argument_size > 0) then 436 | print '(/,A)', "Position arguments:" 437 | max_name_length = 0 438 | do i = 1, this%argument_size 439 | max_name_length = max(max_name_length, len_trim(this%arguments(i)%name)) 440 | end do 441 | max_name_length = max(max_name_length, 25) 442 | do i = 1, this%argument_size 443 | write (*, '(2X,A)', advance='no') trim(this%arguments(i)%name) 444 | printed_length = len_trim(this%arguments(i)%name) 445 | write (unit=help_fmt, fmt='("(",I0,"X,""("",A,"") "")")') max_name_length - printed_length 446 | write (*, help_fmt, advance='no') trim(this%arguments(i)%value_type) 447 | call split(this%arguments(i)%help, "\n", help_split) 448 | print '(A)', trim(help_split(1)) 449 | write (unit=help_fmt, fmt='("(",I0,"X,A)")') max_name_length + 2 450 | do j = 2, size(help_split, 1) 451 | print help_fmt, trim(help_split(j)) 452 | end do 453 | deallocate (help_split) 454 | end do 455 | end if 456 | end subroutine argp_print_help 457 | 458 | subroutine argp_print_as_ini(this, unit, comment) 459 | use iso_fortran_env 460 | class(argparser), intent(in) :: this 461 | integer, optional, intent(in) :: unit 462 | logical, optional, intent(in) :: comment 463 | integer :: print_unit, i, j, str_len 464 | logical :: print_comment 465 | character(len=8) :: logical_str 466 | character(len=help_len), dimension(:), allocatable :: help_split 467 | print_unit = output_unit 468 | if (present(unit)) then 469 | print_unit = unit 470 | end if 471 | print_comment = .false. 472 | if (present(comment)) then 473 | print_comment = comment 474 | end if 475 | if (this%option_size > 0) then 476 | write (unit=print_unit, fmt='(A)') "[options]" 477 | end if 478 | do i = 1, this%option_size 479 | if (print_comment) then 480 | call split(this%options(i)%help, "\n", help_split) 481 | do j = 1, size(help_split, 1) 482 | write (unit=print_unit, fmt='("# ",A)') trim(help_split(j)) 483 | end do 484 | deallocate (help_split) 485 | end if 486 | str_len = len_trim(this%options(i)%long_name) 487 | if (this%options(i)%value_type == "logical") then 488 | ! for common INI file 489 | if (this%options(i)%value == 'T') then 490 | logical_str = "true" 491 | else 492 | logical_str = "false" 493 | end if 494 | write (unit=print_unit, fmt='(A," = ",A)') this%options(i)%long_name(3:str_len), trim(logical_str) 495 | else 496 | write (unit=print_unit, fmt='(A," = ",A)') this%options(i)%long_name(3:str_len), trim(this%options(i)%value) 497 | end if 498 | end do 499 | if (this%named_argument_size > 0) then 500 | write (unit=print_unit, fmt='(A)') "[named_arguments]" 501 | end if 502 | do i = 1, this%named_argument_size 503 | if (print_comment) then 504 | call split(this%named_arguments(i)%help, "\n", help_split) 505 | do j = 1, size(help_split, 1) 506 | write (unit=print_unit, fmt='("# ",A)') trim(help_split(j)) 507 | end do 508 | deallocate (help_split) 509 | end if 510 | write (unit=print_unit, fmt='(A," = ",A)') trim(this%named_arguments(i)%name), trim(this%named_arguments(i)%value) 511 | end do 512 | if (this%argument_size > 0) then 513 | write (unit=print_unit, fmt='(A)') "[arguments]" 514 | end if 515 | do i = 1, this%argument_size 516 | if (print_comment) then 517 | call split(this%arguments(i)%help, "\n", help_split) 518 | do j = 1, size(help_split, 1) 519 | write (unit=print_unit, fmt='("# ",A)') trim(help_split(j)) 520 | end do 521 | deallocate (help_split) 522 | end if 523 | write (unit=print_unit, fmt='(A," = ",A)') trim(this%arguments(i)%name), trim(this%arguments(i)%value) 524 | end do 525 | end subroutine 526 | 527 | subroutine argp_add_sc_option(this, short_name, long_name, help, callback) 528 | class(argparser), intent(inout) :: this 529 | character(len=*), intent(in) :: short_name, long_name, help 530 | procedure(sc_option_callback) :: callback 531 | integer :: t_sc_size, idx 532 | type(short_circuit_option), dimension(:), allocatable :: t_sc_opts 533 | ! long name must not be empty 534 | call argp_check_long_name(this, long_name) 535 | ! allow short name to be empty 536 | if (short_name /= "") then 537 | call argp_check_short_name(this, short_name) 538 | idx = ichar(short_name(2:2)) 539 | this%short_name_index(idx) = this%sc_option_size + 1 540 | end if 541 | ! 手动管理变长数组 542 | t_sc_size = size(this%sc_options, 1) 543 | if (t_sc_size == this%sc_option_size) then 544 | allocate (t_sc_opts(t_sc_size)) 545 | t_sc_opts(1:t_sc_size) = this%sc_options 546 | deallocate (this%sc_options) 547 | allocate (this%sc_options(2*t_sc_size)) 548 | this%sc_options(1:t_sc_size) = t_sc_opts 549 | deallocate (t_sc_opts) 550 | end if 551 | this%sc_option_size = this%sc_option_size + 1 552 | idx = this%sc_option_size 553 | this%sc_options(idx)%short_name = short_name 554 | this%sc_options(idx)%long_name = long_name 555 | this%sc_options(idx)%help = help 556 | this%sc_options(idx)%callback => callback 557 | end subroutine argp_add_sc_option 558 | 559 | subroutine dummy_print_help() 560 | end subroutine dummy_print_help 561 | 562 | subroutine argp_add_help_option(this) 563 | class(argparser), intent(inout) :: this 564 | type(argparser), save :: temp 565 | temp = this 566 | call this%add_sc_option("-?", "--help", "show this help message", dummy_print_help) 567 | !! this cannot work, use `dummp_print_help` to compromise 568 | ! contains 569 | ! subroutine local_print_help 570 | ! call temp%print_help() 571 | ! end subroutine local_print_help 572 | end subroutine argp_add_help_option 573 | 574 | pure subroutine argp_try_add_option(this, short_name, long_name, help) 575 | class(argparser), intent(inout) :: this 576 | character(len=*), intent(in) :: short_name, long_name, help 577 | integer :: t_opt_size, idx 578 | type(option), dimension(:), allocatable :: t_opts 579 | call argp_check_long_name(this, long_name) 580 | if (short_name /= "") then 581 | call argp_check_short_name(this, short_name) 582 | idx = ichar(short_name(2:2)) 583 | this%short_name_index(idx) = this%option_size + 1 584 | end if 585 | ! 手动管理变长数组 586 | t_opt_size = size(this%options, 1) 587 | if (t_opt_size == this%option_size) then 588 | allocate (t_opts(t_opt_size)) 589 | t_opts(1:t_opt_size) = this%options 590 | deallocate (this%options) 591 | allocate (this%options(2*t_opt_size)) 592 | this%options(1:t_opt_size) = t_opts 593 | deallocate (t_opts) 594 | end if 595 | this%option_size = this%option_size + 1 596 | idx = this%option_size 597 | this%options(idx)%short_name = short_name 598 | this%options(idx)%long_name = long_name 599 | this%options(idx)%help = help 600 | end subroutine argp_try_add_option 601 | 602 | pure subroutine argp_add_option_logical(this, short_name, long_name, help) 603 | class(argparser), intent(inout) :: this 604 | character(len=*), intent(in) :: short_name, long_name, help 605 | integer :: idx 606 | call argp_try_add_option(this, short_name, long_name, help) 607 | idx = this%option_size 608 | this%options(idx)%value_type = "logical" 609 | this%options(idx)%value = "F" 610 | end subroutine argp_add_option_logical 611 | 612 | pure subroutine argp_add_option_integer(this, short_name, long_name, help, default) 613 | class(argparser), intent(inout) :: this 614 | character(len=*), intent(in) :: short_name, long_name, help 615 | integer, intent(in) :: default 616 | integer :: idx 617 | character(len=value_len) :: value_buffer 618 | call argp_try_add_option(this, short_name, long_name, help) 619 | idx = this%option_size 620 | this%options(idx)%value_type = "integer" 621 | write (unit=value_buffer, fmt=*) default 622 | this%options(idx)%value = adjustl(value_buffer) 623 | end subroutine argp_add_option_integer 624 | 625 | pure subroutine argp_add_option_real(this, short_name, long_name, help, default) 626 | class(argparser), intent(inout) :: this 627 | character(len=*), intent(in) :: short_name, long_name, help 628 | real, intent(in) :: default 629 | integer :: idx 630 | character(len=value_len) :: value_buffer 631 | call argp_try_add_option(this, short_name, long_name, help) 632 | idx = this%option_size 633 | this%options(idx)%value_type = "real" 634 | write (unit=value_buffer, fmt=*) default 635 | this%options(idx)%value = adjustl(value_buffer) 636 | end subroutine argp_add_option_real 637 | 638 | pure subroutine argp_add_option_double(this, short_name, long_name, help, default) 639 | class(argparser), intent(inout) :: this 640 | character(len=*), intent(in) :: short_name, long_name, help 641 | real(kind=8), intent(in) :: default 642 | integer :: idx 643 | character(len=value_len) :: value_buffer 644 | call argp_try_add_option(this, short_name, long_name, help) 645 | idx = this%option_size 646 | this%options(idx)%value_type = "double" 647 | write (unit=value_buffer, fmt=*) default 648 | this%options(idx)%value = adjustl(value_buffer) 649 | end subroutine argp_add_option_double 650 | 651 | pure subroutine argp_add_option_string(this, short_name, long_name, help, default) 652 | class(argparser), intent(inout) :: this 653 | character(len=*), intent(in) :: short_name, long_name, help 654 | character(len=*), intent(in) :: default 655 | integer :: idx 656 | character(len=value_len) :: value_buffer 657 | call argp_try_add_option(this, short_name, long_name, help) 658 | idx = this%option_size 659 | this%options(idx)%value_type = "string" 660 | write (unit=value_buffer, fmt=*) default 661 | this%options(idx)%value = adjustl(value_buffer) 662 | end subroutine argp_add_option_string 663 | 664 | pure subroutine argp_try_add_argument(this, name, help) 665 | class(argparser), intent(inout) :: this 666 | character(len=*), intent(in) :: name, help 667 | integer :: t_arg_size, idx 668 | type(argument), dimension(:), allocatable :: t_args 669 | call argp_check_argument_name(this, name) 670 | ! 手动管理变长数组 671 | t_arg_size = size(this%arguments, 1) 672 | if (t_arg_size == this%argument_size) then 673 | allocate (t_args(t_arg_size)) 674 | t_args(:) = this%arguments 675 | deallocate (this%arguments) 676 | allocate (this%arguments(2*t_arg_size)) 677 | this%arguments(1:t_arg_size) = t_args 678 | deallocate (t_args) 679 | end if 680 | this%argument_size = this%argument_size + 1 681 | idx = this%argument_size 682 | this%arguments(idx)%name = name 683 | this%arguments(idx)%help = help 684 | this%arguments(idx)%value = "" 685 | end subroutine argp_try_add_argument 686 | 687 | pure subroutine argp_try_add_named_argument(this, name, help) 688 | class(argparser), intent(inout) :: this 689 | character(len=*), intent(in) :: name, help 690 | integer :: t_arg_size, idx 691 | type(argument), dimension(:), allocatable :: t_args 692 | call argp_check_argument_name(this, name) 693 | ! 手动管理变长数组 694 | t_arg_size = size(this%named_arguments, 1) 695 | if (t_arg_size == this%named_argument_size) then 696 | allocate (t_args(t_arg_size)) 697 | t_args(:) = this%named_arguments 698 | deallocate (this%named_arguments) 699 | allocate (this%named_arguments(2*t_arg_size)) 700 | this%named_arguments(1:t_arg_size) = t_args 701 | deallocate (t_args) 702 | end if 703 | this%named_argument_size = this%named_argument_size + 1 704 | idx = this%named_argument_size 705 | this%named_arguments(idx)%name = name 706 | this%named_arguments(idx)%help = help 707 | this%named_arguments(idx)%value = "" 708 | end subroutine argp_try_add_named_argument 709 | 710 | pure subroutine argp_add_argument_integer(this, name, help) 711 | class(argparser), intent(inout) :: this 712 | character(len=*), intent(in) :: name, help 713 | integer :: idx 714 | call argp_try_add_argument(this, name, help) 715 | idx = this%argument_size 716 | this%arguments(idx)%value_type = "integer" 717 | end subroutine argp_add_argument_integer 718 | 719 | pure subroutine argp_add_argument_real(this, name, help) 720 | class(argparser), intent(inout) :: this 721 | character(len=*), intent(in) :: name, help 722 | integer :: idx 723 | call argp_try_add_argument(this, name, help) 724 | idx = this%argument_size 725 | this%arguments(idx)%value_type = "real" 726 | end subroutine argp_add_argument_real 727 | 728 | pure subroutine argp_add_argument_double(this, name, help) 729 | class(argparser), intent(inout) :: this 730 | character(len=*), intent(in) :: name, help 731 | integer :: idx 732 | call argp_try_add_argument(this, name, help) 733 | idx = this%argument_size 734 | this%arguments(idx)%value_type = "double" 735 | end subroutine argp_add_argument_double 736 | 737 | pure subroutine argp_add_argument_string(this, name, help) 738 | class(argparser), intent(inout) :: this 739 | character(len=*), intent(in) :: name, help 740 | integer :: idx 741 | call argp_try_add_argument(this, name, help) 742 | idx = this%argument_size 743 | this%arguments(idx)%value_type = "string" 744 | end subroutine argp_add_argument_string 745 | 746 | pure subroutine argp_add_named_argument_integer(this, name, help) 747 | class(argparser), intent(inout) :: this 748 | character(len=*), intent(in) :: name, help 749 | integer :: idx 750 | call argp_try_add_named_argument(this, name, help) 751 | idx = this%named_argument_size 752 | this%named_arguments(idx)%value_type = "integer" 753 | end subroutine argp_add_named_argument_integer 754 | 755 | pure subroutine argp_add_named_argument_real(this, name, help) 756 | class(argparser), intent(inout) :: this 757 | character(len=*), intent(in) :: name, help 758 | integer :: idx 759 | call argp_try_add_named_argument(this, name, help) 760 | idx = this%named_argument_size 761 | this%named_arguments(idx)%value_type = "real" 762 | end subroutine argp_add_named_argument_real 763 | 764 | pure subroutine argp_add_named_argument_double(this, name, help) 765 | class(argparser), intent(inout) :: this 766 | character(len=*), intent(in) :: name, help 767 | integer :: idx 768 | call argp_try_add_named_argument(this, name, help) 769 | idx = this%named_argument_size 770 | this%named_arguments(idx)%value_type = "double" 771 | end subroutine argp_add_named_argument_double 772 | 773 | pure subroutine argp_add_named_argument_string(this, name, help) 774 | class(argparser), intent(inout) :: this 775 | character(len=*), intent(in) :: name, help 776 | integer :: idx 777 | call argp_try_add_named_argument(this, name, help) 778 | idx = this%named_argument_size 779 | this%named_arguments(idx)%value_type = "string" 780 | end subroutine argp_add_named_argument_string 781 | 782 | pure integer function argp_find_option(this, name) result(ans) 783 | class(argparser), intent(in) :: this 784 | character(len=*), intent(in) :: name 785 | integer :: i 786 | do i = 1, this%option_size 787 | if (name == this%options(i)%short_name .or. name == this%options(i)%long_name) then 788 | ans = i 789 | return 790 | end if 791 | end do 792 | error stop "(get error) option not found: "//trim(name) 793 | end function argp_find_option 794 | 795 | subroutine argp_try_parse_option(this, opt) 796 | class(argparser), intent(inout) :: this 797 | type(option), intent(inout) :: opt 798 | integer :: state, iret 799 | real :: rret 800 | real(kind=8) :: dret 801 | state = 0 802 | if (opt%value_type == "integer") then 803 | read (unit=opt%value, fmt=*, iostat=state) iret 804 | else if (opt%value_type == "real") then 805 | read (unit=opt%value, fmt=*, iostat=state) rret 806 | else if (opt%value_type == "double") then 807 | read (unit=opt%value, fmt=*, iostat=state) dret 808 | end if 809 | if (state /= 0) then 810 | call argp_parse_error(this, & 811 | &"option '"//trim(opt%long_name)//"' need a "//trim(opt%value_type)//" value, but got '"//trim(opt%value)//"'") 812 | end if 813 | end subroutine argp_try_parse_option 814 | 815 | pure subroutine argp_check_option_type(this, idx, type) 816 | class(argparser), intent(in) :: this 817 | integer, intent(in) :: idx 818 | character(len=*), intent(in) :: type 819 | if (this%options(idx)%value_type /= type) then 820 | error stop "(get error) option '"//trim(this%options(idx)%long_name)//"' is set as " & 821 | //trim(this%options(idx)%value_type)//", you try to get as "//trim(type) 822 | end if 823 | end subroutine argp_check_option_type 824 | 825 | pure logical function argp_get_option_logical(this, name) result(ans) 826 | class(argparser), intent(in) :: this 827 | character(len=*), intent(in) :: name 828 | integer :: i 829 | i = argp_find_option(this, name) 830 | call argp_check_option_type(this, i, "logical") 831 | read (unit=this%options(i)%value, fmt=*) ans 832 | end function argp_get_option_logical 833 | 834 | pure logical function argp_has_option(this, name) result(ans) 835 | class(argparser), intent(in) :: this 836 | character(len=*), intent(in) :: name 837 | ans = argp_get_option_logical(this, name) 838 | end function argp_has_option 839 | 840 | pure integer function argp_get_option_integer(this, name) result(ans) 841 | class(argparser), intent(in) :: this 842 | character(len=*), intent(in) :: name 843 | integer :: i 844 | i = argp_find_option(this, name) 845 | call argp_check_option_type(this, i, "integer") 846 | read (unit=this%options(i)%value, fmt=*) ans 847 | end function argp_get_option_integer 848 | 849 | pure real function argp_get_option_real(this, name) result(ans) 850 | class(argparser), intent(in) :: this 851 | character(len=*), intent(in) :: name 852 | integer :: i 853 | i = argp_find_option(this, name) 854 | call argp_check_option_type(this, i, "real") 855 | read (unit=this%options(i)%value, fmt=*) ans 856 | end function argp_get_option_real 857 | 858 | pure real(kind=8) function argp_get_option_double(this, name) result(ans) 859 | class(argparser), intent(in) :: this 860 | character(len=*), intent(in) :: name 861 | integer :: i 862 | i = argp_find_option(this, name) 863 | call argp_check_option_type(this, i, "double") 864 | read (unit=this%options(i)%value, fmt=*) ans 865 | end function argp_get_option_double 866 | 867 | pure function argp_get_option_string(this, name) result(ans) 868 | class(argparser), intent(in) :: this 869 | character(len=*), intent(in) :: name 870 | character(len=value_len) :: ans 871 | integer :: i 872 | i = argp_find_option(this, name) 873 | call argp_check_option_type(this, i, "string") 874 | ans = this%options(i)%value 875 | end function argp_get_option_string 876 | 877 | pure integer function argp_find_argument(this, name) result(ans) 878 | class(argparser), intent(in) :: this 879 | character(len=*), intent(in) :: name 880 | integer :: i 881 | do i = 1, this%named_argument_size 882 | if (name == this%named_arguments(i)%name) then 883 | ans = i 884 | return 885 | end if 886 | end do 887 | do i = 1, this%argument_size 888 | if (name == this%arguments(i)%name) then 889 | ans = -i 890 | return 891 | end if 892 | end do 893 | error stop "(get error) argument not found: "//trim(name) 894 | end function argp_find_argument 895 | 896 | subroutine argp_try_parse_argumrnt(this, arg) 897 | class(argparser), intent(inout) :: this 898 | type(argument), intent(inout) :: arg 899 | integer :: state, iret 900 | real :: rret 901 | real(kind=8) :: dret 902 | state = 0 903 | if (arg%value_type == "integer") then 904 | read (unit=arg%value, fmt=*, iostat=state) iret 905 | else if (arg%value_type == "real") then 906 | read (unit=arg%value, fmt=*, iostat=state) rret 907 | else if (arg%value_type == "double") then 908 | read (unit=arg%value, fmt=*, iostat=state) dret 909 | end if 910 | if (state /= 0) then 911 | call argp_parse_error(this, & 912 | &"argument '"//trim(arg%name)//"' need a "//trim(arg%value_type)//" value, but got '"//trim(arg%value)//"'") 913 | end if 914 | end subroutine argp_try_parse_argumrnt 915 | 916 | pure subroutine argp_check_argument_type(this, idx, type) 917 | class(argparser), intent(in) :: this 918 | integer, intent(in) :: idx 919 | character(len=*), intent(in) :: type 920 | character(len=type_string_len) :: arg_type 921 | character(len=argument_len) :: name 922 | if (idx > 0) then 923 | arg_type = this%named_arguments(idx)%value_type 924 | name = this%named_arguments(idx)%name 925 | else 926 | arg_type = this%arguments(-idx)%value_type 927 | name = this%arguments(-idx)%name 928 | end if 929 | if (arg_type /= type) then 930 | error stop "(get error) argument '"//trim(name)//"' is set as "//trim(arg_type)//", you try to get as "//trim(type) 931 | end if 932 | end subroutine argp_check_argument_type 933 | 934 | pure integer function argp_get_argument_integer(this, name) result(ans) 935 | class(argparser), intent(in) :: this 936 | character(len=*), intent(in) :: name 937 | integer :: i 938 | i = argp_find_argument(this, name) 939 | call argp_check_argument_type(this, i, "integer") 940 | if (i > 0) then 941 | read (unit=this%named_arguments(i)%value, fmt=*) ans 942 | else 943 | read (unit=this%arguments(-i)%value, fmt=*) ans 944 | end if 945 | end function argp_get_argument_integer 946 | 947 | pure real function argp_get_argument_real(this, name) result(ans) 948 | class(argparser), intent(in) :: this 949 | character(len=*), intent(in) :: name 950 | integer :: i 951 | i = argp_find_argument(this, name) 952 | call argp_check_argument_type(this, i, "real") 953 | if (i > 0) then 954 | read (unit=this%named_arguments(i)%value, fmt=*) ans 955 | else 956 | read (unit=this%arguments(-i)%value, fmt=*) ans 957 | end if 958 | end function argp_get_argument_real 959 | 960 | pure real(kind=8) function argp_get_argument_double(this, name) result(ans) 961 | class(argparser), intent(in) :: this 962 | character(len=*), intent(in) :: name 963 | integer :: i 964 | i = argp_find_argument(this, name) 965 | call argp_check_argument_type(this, i, "double") 966 | if (i > 0) then 967 | read (unit=this%named_arguments(i)%value, fmt=*) ans 968 | else 969 | read (unit=this%arguments(-i)%value, fmt=*) ans 970 | end if 971 | end function argp_get_argument_double 972 | 973 | pure function argp_get_argument_string(this, name) result(ans) 974 | class(argparser), intent(in) :: this 975 | character(len=*), intent(in) :: name 976 | character(len=value_len) :: ans 977 | integer :: i 978 | i = argp_find_argument(this, name) 979 | call argp_check_argument_type(this, i, "string") 980 | if (i > 0) then 981 | ans = this%named_arguments(i)%value 982 | else 983 | ans = this%arguments(-i)%value 984 | end if 985 | end function argp_get_argument_string 986 | 987 | pure subroutine argp_check_short_name(this, name) 988 | class(argparser), intent(in) :: this 989 | character(len=*), intent(in) :: name 990 | integer :: name_size, char_pos 991 | name_size = len(name) 992 | if (name_size /= 2 .or. name(1:1) /= '-') then 993 | error stop "(build error) short option name must be `-` followed by single character" 994 | end if 995 | char_pos = ichar(name(2:2)) 996 | if (this%short_name_index(char_pos) /= null_index_value) then 997 | error stop "(build error) short option name "//trim(name)//" already exists" 998 | end if 999 | end subroutine argp_check_short_name 1000 | 1001 | pure subroutine argp_check_long_name(this, name) 1002 | class(argparser), intent(in) :: this 1003 | character(len=*), intent(in) :: name 1004 | integer :: i 1005 | if (name == "") then 1006 | error stop "(build error) long option name cannot be empty" 1007 | end if 1008 | if (name(1:2) /= "--") then 1009 | error stop "(build error) long option name must starts with `--`" 1010 | end if 1011 | do i = 1, this%sc_option_size 1012 | if (name == trim(this%sc_options(i)%long_name)) then 1013 | error stop "(build error) long option name "//trim(name)//" already exists" 1014 | end if 1015 | end do 1016 | do i = 1, this%option_size 1017 | if (name == trim(this%options(i)%long_name)) then 1018 | error stop "(build error) long option name "//trim(name)//" already exists" 1019 | end if 1020 | end do 1021 | end subroutine argp_check_long_name 1022 | 1023 | pure subroutine argp_check_argument_name(this, name) 1024 | class(argparser), intent(in) :: this 1025 | character(len=*), intent(in) :: name 1026 | integer :: i 1027 | if (name == "") then 1028 | error stop "(build error) argument name cannot be empty" 1029 | end if 1030 | do i = 1, this%argument_size 1031 | if (name == trim(this%arguments(i)%name)) then 1032 | error stop "(build error) argument name "//trim(name)//" already exists" 1033 | end if 1034 | end do 1035 | do i = 1, this%named_argument_size 1036 | if (name == trim(this%named_arguments(i)%name)) then 1037 | error stop "(build error) argument name "//trim(name)//" already exists" 1038 | end if 1039 | end do 1040 | end subroutine argp_check_argument_name 1041 | 1042 | subroutine argp_parse_error(this, message) 1043 | class(argparser), intent(in) :: this 1044 | character(len=*), intent(in) :: message 1045 | call this%print_help() 1046 | print '(A)', repeat("-", 80) 1047 | print '("Error: ", A)', trim(message) 1048 | stop 1049 | end subroutine argp_parse_error 1050 | 1051 | pure subroutine split(line, sep, result) 1052 | character(len=*), intent(in) :: line 1053 | character(len=*), intent(in) :: sep 1054 | character(len=*), dimension(:), allocatable, intent(out) :: result 1055 | integer :: i, di, start, line_size, sep_size, res_count 1056 | line_size = len_trim(line) 1057 | sep_size = len_trim(sep) 1058 | res_count = 1 1059 | i = index(line(1:line_size), sep) 1060 | di = i 1061 | do while (di /= 0) 1062 | res_count = res_count + 1 1063 | di = index(line(i + sep_size:line_size), sep) 1064 | i = i + sep_size + di - 1 1065 | end do 1066 | allocate (result(res_count)) 1067 | res_count = 1 1068 | i = index(line(1:line_size), sep) 1069 | di = i 1070 | start = 1 1071 | do while (di /= 0) 1072 | result(res_count) = line(start:i - 1) 1073 | res_count = res_count + 1 1074 | start = i + sep_size 1075 | di = index(line(start:line_size), sep) 1076 | i = start + di - 1 1077 | end do 1078 | result(res_count) = line(start:line_size) 1079 | end subroutine 1080 | end module argparse 1081 | -------------------------------------------------------------------------------- /test/check.f90: -------------------------------------------------------------------------------- 1 | program check 2 | use iso_fortran_env, only: stdout => output_unit 3 | use argparse 4 | implicit none 5 | character(len=10), parameter :: program_name = "qcalc" 6 | type(argparser) :: args 7 | args = argparser("A quantum physics calculation program.") 8 | call args%set_program_name(program_name) 9 | call args%add_help_option() 10 | ! call args%add_sc_option("-h", "--help", "show this help message", print_help) 11 | call args%add_sc_option("-v", "--version", "show version info", show_version_info) 12 | call args%add_option_logical("-o", "--openmp", "use openmp or not") ! logical option has no default 13 | call args%add_option_logical("-m", "--mpi", "use mpi or not") 14 | call args%add_option_integer("-t", "--thread", "thread number,\nit is valid only if openmp is set", 1) 15 | call args%add_option_integer("-p", "--process", "process number,\nit is valid only if mpi is set", 1) 16 | call args%add_option_string("", "--chemical", "chemical formula", "H2O") ! short name can be empty 17 | call args%add_named_argument_string("input", "initialize file") 18 | call args%add_named_argument_string("output", "output file") 19 | call args%parse() 20 | 21 | if (args%has_option("--openmp")) then 22 | print '(A,I0,A)', "openmp is used, and we use ", args%get_option_integer("-t"), " threads" 23 | end if 24 | if (args%has_option("--mpi")) then 25 | print '(A,I0,A)', "mpi is used, and we use ", args%get_option_integer("-p"), " processes" 26 | end if 27 | print '(A,A)', "the calculated chemical is ", trim(args%get_option_string("--chemical")) 28 | print '(A,A)', "the input file is ", trim(args%get_argument_string("input")) 29 | print '(A,A)', "the output file is ", trim(args%get_argument_string("output")) 30 | 31 | ! you can also print the cached `args` into INI file 32 | print '(/,A)', "All of the options and arguments are shown below" 33 | call args%print_as_ini(stdout, .true.) 34 | contains 35 | subroutine show_version_info 36 | print "(A)", trim(program_name)//" version 0.1.0" 37 | end subroutine show_version_info 38 | subroutine print_help 39 | call args%print_help() 40 | end subroutine 41 | end program check 42 | --------------------------------------------------------------------------------